File Coverage

lib/Badger/Codec/Chain.pm
Criterion Covered Total %
statement 42 42 100.0
branch 6 12 50.0
condition 1 3 33.3
subroutine 9 9 100.0
pod 6 6 100.0
total 64 72 88.8


line stmt bran cond sub pod time code
1             #========================================================================
2             #
3             # Badger::Codec::Chain
4             #
5             # DESCRIPTION
6             # Codec for encoding/decoding data via a chain of other codecs.
7             #
8             # AUTHOR
9             # Andy Wardley
10             #
11             #========================================================================
12              
13             package Badger::Codec::Chain;
14              
15 15     15   98 use Badger::Codecs;
  15         37  
  15         1307  
16             use Badger::Class
17 15         178 version => 0.01,
18             debug => 0,
19             base => 'Badger::Codec',
20             constants => 'ARRAY',
21             constant => {
22             CODECS => 'Badger::Codecs',
23             CHAIN => __PACKAGE__,
24             CHAINED => qr/\s*\+\s*/,
25             },
26             exports => {
27             any => 'CHAIN CHAINED'
28 15     15   788 };
  15         33  
29              
30              
31             sub new {
32 4     4 1 6 my $class = shift;
33 4 50       29 my $chain = @_ == 1 ? shift : [ @_ ];
34              
35             # single argument can be a text string or array ref
36             # each argument in an array can be a codec ref or codec name/chain
37             # all codec names must be upgraded to codec objects
38 4 50       14 $chain = [ $chain ] unless ref $chain eq ARRAY;
39 4 50       10 $chain = [ map { ref $_ ? $_ : split(CHAINED, $_) } @$chain ];
  4         41  
40 4 50       12 $chain = [ map { ref $_ ? $_ : CODECS->codec($_) } @$chain ];
  8         36  
41            
42 4 50       13 $class->debug("chaining codecs: ", join(' + ', @$chain), "\n") if $DEBUG;
43              
44 4         18 bless {
45             chain => $chain,
46             }, $class;
47             }
48              
49             sub encode {
50 3     3 1 14 my $self = shift;
51 3         6 my $data = shift;
52 3         4 foreach my $codec (@{ $self->{ chain } }) {
  3         14  
53 6         118 $data = $codec->encode($data);
54             }
55 3         13 return $data;
56             }
57              
58             sub decode {
59 3     3 1 9 my $self = shift;
60 3         3 my $data = shift;
61 3         5 foreach my $codec (reverse @{ $self->{ chain } }) {
  3         8  
62 6         14 $data = $codec->decode($data);
63             }
64 3         58 return $data;
65             }
66              
67             sub encoder {
68 2     2 1 4 my $self = shift;
69             return $self->coder(
70 4         12 map { $_->encoder }
71 2         4 @{ $self->{ chain } }
  2         10  
72             );
73             }
74              
75             sub decoder {
76 2     2 1 5 my $self = shift;
77             return $self->coder(
78 4         9 reverse map { $_->decoder }
79 2         4 @{ $self->{ chain } }
  2         4  
80             );
81             }
82              
83             sub coder {
84 4     4 1 5 my $self = shift;
85 4 50 33     29 my $coders = @_ && ref $_[0] eq ARRAY ? shift : [@_];
86             return sub {
87 4     4   11 my $data = shift;
88 4         8 foreach my $coder (@$coders) {
89 8         71 $data = $coder->($data);
90             }
91 4         43 return $data;
92             }
93 4         29 }
94              
95             1;
96              
97             __END__