File Coverage

lib/App/Muter/Chain.pm
Criterion Covered Total %
statement 36 37 97.3
branch 12 14 85.7
condition 7 11 63.6
subroutine 11 11 100.0
pod 3 3 100.0
total 69 76 90.7


line stmt bran cond sub pod time code
1             package App::Muter::Chain;
2             # ABSTRACT: main programmatic interface to muter
3             $App::Muter::Chain::VERSION = '0.002002';
4 4     4   30 use strict;
  4         9  
  4         140  
5 4     4   22 use warnings;
  4         9  
  4         104  
6              
7 4     4   21 use List::Util ();
  4         9  
  4         2751  
8              
9              
10             sub new {
11 16991     16991 1 38338 my ($class, $chain, $reverse) = @_;
12 16991   33     71379 $class = ref($class) || $class;
13 16991         35684 my $self = bless {}, $class;
14             $self->{chain} =
15 16991         44805 [$self->_instantiate($self->_parse_chain($chain, $reverse))];
16 16991         67488 return $self;
17             }
18              
19              
20             sub process {
21 53171     53171 1 98478 my ($self, $data) = @_;
22              
23 53171     98330   179719 return List::Util::reduce { $b->process($a) } $data, @{$self->{chain}};
  98330         237415  
  53171         215961  
24             }
25              
26              
27             sub final {
28 16991     16991 1 34842 my ($self, $data) = @_;
29              
30 16991     24742   54860 return List::Util::reduce { $b->final($a) } $data, @{$self->{chain}};
  24742         64995  
  16991         66785  
31             }
32              
33             sub _chain_entry {
34 24758     24758   47018 my ($item, $reverse) = @_;
35 24758 100       143222 if ($item =~ /^(-?)(\w+)(?:\(([^)]+)\))?$/) {
    50          
36             return {
37 24716 100 100     234739 name => $2,
    100          
38             method => (($1 xor $reverse) ? 'decode' : 'encode'),
39             args => ($3 ? [split /,/, $3] : []),
40             };
41             }
42             elsif ($item =~ /^(-?)(\w+),([^)]+)$/) {
43             return {
44 42 100 50     613 name => $2,
    50          
45             method => (($1 xor $reverse) ? 'decode' : 'encode'),
46             args => ($3 ? [split /,/, $3] : []),
47             };
48             }
49             else {
50 0         0 die "Chain entry $item is invalid";
51             }
52             }
53              
54             sub _parse_chain {
55 16999     16999   58635 my (undef, $chain, $reverse) = @_;
56 16999         57967 my @items = split /:/, $chain;
57 16999         41134 my @chain = map { _chain_entry($_, $reverse) } @items;
  24758         50402  
58 16999 100       66534 return $reverse ? reverse @chain : @chain;
59             }
60              
61             sub _instantiate {
62 16991     16991   38124 my (undef, @entries) = @_;
63 16991         79098 my $registry = App::Muter::Registry->instance;
64             return map {
65 16991         34914 my $class = $registry->info($_->{name})->{class};
  24742         73877  
66 24742         111064 $class->new($_->{args}, transform => $_->{method});
67             } @entries;
68             }
69              
70             1;
71              
72             __END__
73              
74             =pod
75              
76             =encoding UTF-8
77              
78             =head1 NAME
79              
80             App::Muter::Chain - main programmatic interface to muter
81              
82             =head1 VERSION
83              
84             version 0.002002
85              
86             =head1 SYNOPSIS
87              
88             App::Muter::Registry->instance->load_backends();
89             my $chain = App::Muter::Chain->new($chain);
90             while (<$fh>) {
91             print $chain->process($_);
92             }
93             print $chain->final('');
94              
95             =head1 DESCRIPTION
96              
97             This is the main programmatic (Perl) interface to muter. It takes an arbitrary
98             chain and processes data incrementally, in whatever size chunks it's given.
99              
100             =head1 METHODS
101              
102             =head2 $class->new($chain, [$reverse])
103              
104             Create a new chain object using the specified chain, which is identical to the
105             argument to muter's B<-c> option. If C<$reverse> is passed, reverse the chain,
106             as with muter's <-r> option.
107              
108             =head2 $self->process($data)
109              
110             Process a chunk of data. Chunks need not be all the same size. Returns the
111             transformed data, which may be longer or shorter than the input data.
112              
113             =head2 $self->final($data)
114              
115             Process the final chunk of data. If all the data has already been sent via the
116             I<process> method, simply pass an empty string.
117              
118             =head1 AUTHOR
119              
120             brian m. carlson <sandals@crustytoothpaste.net>
121              
122             =head1 COPYRIGHT AND LICENSE
123              
124             This software is Copyright (c) 2016–2017 by brian m. carlson.
125              
126             This is free software, licensed under:
127              
128             The MIT (X11) License
129              
130             =cut