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.003000';
4 4     4   24 use strict;
  4         7  
  4         108  
5 4     4   20 use warnings;
  4         5  
  4         95  
6              
7 4     4   20 use List::Util ();
  4         10  
  4         2251  
8              
9              
10             sub new {
11 16757     16757 1 30318 my ($class, $chain, $reverse) = @_;
12 16757   33     59636 $class = ref($class) || $class;
13 16757         29452 my $self = bless {}, $class;
14             $self->{chain} =
15 16757         34239 [$self->_instantiate($self->_parse_chain($chain, $reverse))];
16 16757         55205 return $self;
17             }
18              
19              
20             sub process {
21 52308     52308 1 87049 my ($self, $data) = @_;
22              
23 52308     96604   140980 return List::Util::reduce { $b->process($a) } $data, @{$self->{chain}};
  96604         195727  
  52308         175053  
24             }
25              
26              
27             sub final {
28 16757     16757 1 29497 my ($self, $data) = @_;
29              
30 16757     24274   46022 return List::Util::reduce { $b->final($a) } $data, @{$self->{chain}};
  24274         56134  
  16757         53863  
31             }
32              
33             sub _chain_entry {
34 24290     24290   39918 my ($item, $reverse) = @_;
35 24290 100       126409 if ($item =~ /^(-?)(\w+)(?:\(([^)]+)\))?$/) {
    50          
36             return {
37 24248 100 100     196104 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     548 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 16765     16765   40364 my (undef, $chain, $reverse) = @_;
56 16765         45872 my @items = split /:/, $chain;
57 16765         32008 my @chain = map { _chain_entry($_, $reverse) } @items;
  24290         41575  
58 16765 100       54491 return $reverse ? reverse @chain : @chain;
59             }
60              
61             sub _instantiate {
62 16757     16757   33303 my (undef, @entries) = @_;
63 16757         62343 my $registry = App::Muter::Registry->instance;
64             return map {
65 16757         29819 my $class = $registry->info($_->{name})->{class};
  24274         61754  
66 24274         92856 $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.003000
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