File Coverage

blib/lib/Venus/Role/Digestable.pm
Criterion Covered Total %
statement 28 29 96.5
branch 1 2 50.0
condition 2 2 100.0
subroutine 11 11 100.0
pod 5 7 71.4
total 47 51 92.1


line stmt bran cond sub pod time code
1             package Venus::Role::Digestable;
2              
3 96     96   1679 use 5.014;
  96         345  
4              
5 96     96   538 use strict;
  96         224  
  96         2035  
6 96     96   463 use warnings;
  96         249  
  96         3028  
7              
8 96     96   592 use Venus::Role 'fault';
  96         244  
  96         666  
9              
10             # AUDITS
11              
12             sub AUDIT {
13 97     97 0 258 my ($self, $from) = @_;
14              
15 97 50       533 if (!$from->does('Venus::Role::Dumpable')) {
16 0         0 fault "${self} requires ${from} to consume Venus::Role::Dumpable";
17             }
18              
19 97         299 return $self;
20             }
21              
22             # METHODS
23              
24             sub digester {
25 360     360 1 781 my ($self, $algorithm, $method, @args) = @_;
26              
27 360         1198 my $result = $self->dump($method, @args);
28              
29 360         5738 require Digest;
30              
31 360   100     6877 my $digest = Digest->new(uc($algorithm || 'sha-1'));
32              
33 360         18894 return $digest->add($result);
34             }
35              
36             sub digest {
37 349     349 1 831 my ($self, $algorithm, $method, @args) = @_;
38              
39 349         1123 return $self->hexdigest($algorithm, $method, @args);
40             }
41              
42             sub b64digest {
43 3     3 1 11 my ($self, $algorithm, $method, @args) = @_;
44              
45 3         9 return $self->digester($algorithm, $method, @args)->b64digest;
46             }
47              
48             sub bindigest {
49 3     3 1 10 my ($self, $algorithm, $method, @args) = @_;
50              
51 3         9 return $self->digester($algorithm, $method, @args)->digest;
52             }
53              
54             sub hexdigest {
55 352     352 1 759 my ($self, $algorithm, $method, @args) = @_;
56              
57 352         1021 return $self->digester($algorithm, $method, @args)->hexdigest;
58             }
59              
60             # EXPORTS
61              
62             sub EXPORT {
63 97     97 0 440 ['digester', 'digest', 'b64digest', 'bindigest', 'hexdigest']
64             }
65              
66             1;
67              
68              
69              
70             =head1 NAME
71              
72             Venus::Role::Digestable - Digestable Role
73              
74             =cut
75              
76             =head1 ABSTRACT
77              
78             Digestable Role for Perl 5
79              
80             =cut
81              
82             =head1 SYNOPSIS
83              
84             package Example;
85              
86             use Venus::Class;
87              
88             attr 'data';
89              
90             with 'Venus::Role::Dumpable';
91             with 'Venus::Role::Digestable';
92              
93             sub execute {
94             my ($self, @args) = @_;
95              
96             return [$self->data, @args];
97             }
98              
99             package main;
100              
101             my $example = Example->new(data => 123);
102              
103             # $example->digest;
104              
105             # "a6c3d9ae59f31690eddbdd15271e856a6b6f15d5"
106              
107             =cut
108              
109             =head1 DESCRIPTION
110              
111             This package modifies the consuming package and provides methods for producing
112             message digests from a dump of the object or the return value of a dispatched
113             method call. All algorithms supported by L are supported, e.g.
114             C, C, C, C, C, C,
115             C, etc.
116              
117             =cut
118              
119             =head1 METHODS
120              
121             This package provides the following methods:
122              
123             =cut
124              
125             =head2 b64digest
126              
127             b64digest(string $algo, string $method, any @args) (string)
128              
129             The b64digest method returns a base64 formatted digest of the object or return
130             value of a dispatched method call. The algorithm defaults to C. This
131             method supports dispatching, i.e. providing a method name and arguments whose
132             return value will be acted on by this method.
133              
134             I>
135              
136             =over 4
137              
138             =item b64digest example 1
139              
140             package main;
141              
142             my $example = Example->new(data => 123);
143              
144             my $b64digest = $example->b64digest;
145              
146             # "/PFIeIRxSIuCLPcrbWypwXVUpMY"
147              
148             =back
149              
150             =over 4
151              
152             =item b64digest example 2
153              
154             package main;
155              
156             my $example = Example->new(data => 123);
157              
158             my $b64digest = $example->b64digest('sha-1', 'execute');
159              
160             # "T+raai5I0suKC3VpiZ8bqt0WXE0"
161              
162             =back
163              
164             =over 4
165              
166             =item b64digest example 3
167              
168             package main;
169              
170             my $example = Example->new(data => 123);
171              
172             my $b64digest = $example->b64digest('sha-1', 'execute', '456');
173              
174             # "5Vf077AO11mZZfaQknfOtzfhzPc"
175              
176             =back
177              
178             =cut
179              
180             =head2 bindigest
181              
182             bindigest(string $algo, string $method, any @args) (string)
183              
184             The bindigest method returns a binary formatted digest of the object or return
185             value of a dispatched method call. The algorithm defaults to C. This
186             method supports dispatching, i.e. providing a method name and arguments whose
187             return value will be acted on by this method.
188              
189             I>
190              
191             =over 4
192              
193             =item bindigest example 1
194              
195             package main;
196              
197             my $example = Example->new(data => 123);
198              
199             my $bindigest = $example->bindigest;
200              
201             # pack("H*","fcf148788471488b822cf72b6d6ca9c17554a4c6")
202              
203             =back
204              
205             =over 4
206              
207             =item bindigest example 2
208              
209             package main;
210              
211             my $example = Example->new(data => 123);
212              
213             my $bindigest = $example->bindigest('sha-1', 'execute');
214              
215             # pack("H*","4feada6a2e48d2cb8a0b7569899f1baadd165c4d")
216              
217             =back
218              
219             =over 4
220              
221             =item bindigest example 3
222              
223             package main;
224              
225             my $example = Example->new(data => 123);
226              
227             my $bindigest = $example->bindigest('sha-1', 'execute', '456');
228              
229             # pack("H*","e557f4efb00ed7599965f6909277ceb737e1ccf7")
230              
231             =back
232              
233             =cut
234              
235             =head2 digest
236              
237             digest(string $algo, string $method, any @args) (string)
238              
239             The digest method returns a hexadecimal formatted digest of a dump of the
240             object or return value of a dispatched method call. The algorithm defaults to
241             C. This method supports dispatching, i.e. providing a method name and
242             arguments whose return value will be acted on by this method.
243              
244             I>
245              
246             =over 4
247              
248             =item digest example 1
249              
250             package main;
251              
252             my $example = Example->new(data => 123);
253              
254             my $digest = $example->digest;
255              
256             # "fcf148788471488b822cf72b6d6ca9c17554a4c6"
257              
258             =back
259              
260             =over 4
261              
262             =item digest example 2
263              
264             package main;
265              
266             my $example = Example->new(data => 123);
267              
268             my $digest = $example->digest('sha-1', 'execute');
269              
270             # "4feada6a2e48d2cb8a0b7569899f1baadd165c4d"
271              
272             =back
273              
274             =over 4
275              
276             =item digest example 3
277              
278             package main;
279              
280             my $example = Example->new(data => 123);
281              
282             my $digest = $example->digest('sha-1', 'execute', '456');
283              
284             # "e557f4efb00ed7599965f6909277ceb737e1ccf7"
285              
286             =back
287              
288             =cut
289              
290             =head2 digester
291              
292             digester(string $algo, string $method, any @args) (string)
293              
294             The digester method returns a L object with a dump of the object or
295             return value of a dispatched method call as the message. The algorithm defaults
296             to C. This method supports dispatching, i.e. providing a method name and
297             arguments whose return value will be acted on by this method.
298              
299             I>
300              
301             =over 4
302              
303             =item digester example 1
304              
305             package main;
306              
307             my $example = Example->new(data => 123);
308              
309             my $digester = $example->digester;
310              
311             # bless(..., "Digest::SHA")
312              
313             =back
314              
315             =over 4
316              
317             =item digester example 2
318              
319             package main;
320              
321             my $example = Example->new(data => 123);
322              
323             my $digester = $example->digester('md5');
324              
325             # bless(..., "Digest::MD5")
326              
327             =back
328              
329             =cut
330              
331             =head2 hexdigest
332              
333             hexdigest(string $algo, string $method, any @args) (string)
334              
335             The hexdigest method returns a ... formatted digest of the object or return
336             value of a dispatched method call. The algorithm defaults to C. This
337             method supports dispatching, i.e. providing a method name and arguments whose
338             return value will be acted on by this method.
339              
340             I>
341              
342             =over 4
343              
344             =item hexdigest example 1
345              
346             package main;
347              
348             my $example = Example->new(data => 123);
349              
350             my $hexdigest = $example->hexdigest;
351              
352             # "fcf148788471488b822cf72b6d6ca9c17554a4c6"
353              
354             =back
355              
356             =over 4
357              
358             =item hexdigest example 2
359              
360             package main;
361              
362             my $example = Example->new(data => 123);
363              
364             my $hexdigest = $example->hexdigest('sha-1', 'execute');
365              
366             # "4feada6a2e48d2cb8a0b7569899f1baadd165c4d"
367              
368             =back
369              
370             =over 4
371              
372             =item hexdigest example 3
373              
374             package main;
375              
376             my $example = Example->new(data => 123);
377              
378             my $hexdigest = $example->hexdigest('sha-1', 'execute', '456');
379              
380             # "e557f4efb00ed7599965f6909277ceb737e1ccf7"
381              
382             =back
383              
384             =cut
385              
386             =head1 AUTHORS
387              
388             Awncorp, C
389              
390             =cut
391              
392             =head1 LICENSE
393              
394             Copyright (C) 2000, Awncorp, C.
395              
396             This program is free software, you can redistribute it and/or modify it under
397             the terms of the Apache license version 2.0.
398              
399             =cut