1package HTTP::Proxy::BodyFilter::simple;
2
3use strict;
4use Carp;
5use HTTP::Proxy::BodyFilter;
6use vars qw( @ISA );
7@ISA = qw( HTTP::Proxy::BodyFilter );
8
9my $methods = join '|', qw( begin filter end will_modify );
10$methods = qr/^(?:$methods)$/;
11
12sub init {
13    my $self = shift;
14
15    croak "Constructor called without argument" unless @_;
16
17    $self->{_will_modify} = 1;
18
19    if ( @_ == 1 ) {
20        croak "Single parameter must be a CODE reference"
21          unless ref $_[0] eq 'CODE';
22        $self->{_filter} = $_[0];
23    }
24    else {
25        $self->{_filter} = sub { };    # default
26        while (@_) {
27            my ( $name, $code ) = splice @_, 0, 2;
28
29            # basic error checking
30            croak "Parameter to $name must be a CODE reference"
31              if $name ne 'will_modify' && ref $code ne 'CODE';
32            croak "Unkown method $name"
33              unless $name =~ $methods;
34
35            $self->{"_$name"} = $code;
36        }
37    }
38}
39
40# transparently call the actual methods
41sub begin       { goto &{ $_[0]{_begin} }; }
42sub filter      { goto &{ $_[0]{_filter} }; }
43sub end         { goto &{ $_[0]{_end} }; }
44
45sub will_modify { return $_[0]{_will_modify} }
46
47sub can {
48    my ( $self, $method ) = @_;
49    return $method =~ $methods
50      ? $self->{"_$method"}
51      : UNIVERSAL::can( $self, $method );
52}
53
541;
55
56__END__
57
58=head1 NAME
59
60HTTP::Proxy::BodyFilter::simple - A class for creating simple filters
61
62=head1 SYNOPSIS
63
64    use HTTP::Proxy::BodyFilter::simple;
65
66    # a simple s/// filter
67    my $filter = HTTP::Proxy::BodyFilter::simple->new(
68        sub { ${ $_[1] } =~ s/foo/bar/g; }
69    );
70    $proxy->push_filter( response => $filter );
71
72=head1 DESCRIPTION
73
74L<HTTP::Proxy::BodyFilter::simple> can create BodyFilter without going
75through the hassle of creating a full-fledged class. Simply pass
76a code reference to the C<filter()> method of your filter to the constructor,
77and you'll get the adequate filter.
78
79=head2 Constructor calling convention
80
81The constructor can be called in several ways, which are shown in the
82synopsis:
83
84=over 4
85
86=item single code reference
87
88The code reference must conform to the standard filter() signature:
89
90    sub filter {
91        my ( $self, $dataref, $message, $protocol, $buffer ) = @_;
92        ...
93    }
94
95It is assumed to be the code for the C<filter()> method.
96See L<HTTP::Proxy::BodyFilter> for more details about the C<filter()> method.
97
98=item name/coderef pairs
99
100The name is the name of the method (C<filter>, C<begin>, C<end>)
101and the coderef is the method itself.
102
103See L<HTTP::Proxy::BodyFilter> for the methods signatures.
104
105=back
106
107=head1 METHODS
108
109This filter "factory" defines the standard L<HTTP::Proxy::BodyFilter>
110methods, but those are only, erm, "proxies" to the actual CODE references
111passed to the constructor. These "proxy" methods are:
112
113=over 4
114
115=item filter()
116
117=item begin()
118
119=item end()
120
121=back
122
123Two other methods are actually L<HTTP::Proxy::BodyFilter::simple> methods,
124and are called automatically:
125
126=over 4
127
128=item init()
129
130Initalise the filter instance with the code references passed to the
131constructor.
132
133=item can()
134
135Return the actual code reference that will be run, and not the "proxy"
136methods. If called with any other name than C<begin>, C<end> and
137C<filter>, calls C<UNIVERSAL::can()> instead.
138
139=back
140
141There is also a method that returns a boolean value:
142
143=over 4
144
145=item will_modify()
146
147The C<will_modify()> method returns a scalar value (boolean) indicating
148if the filter may modify the body data. The default method returns a
149true value, so you only need to set this value when you are I<absolutely
150certain> that the filter will not modify data (or at least not modify
151its final length).
152
153Here's a simple example:
154
155    $filter = HTTP::Proxy::BodyFilter::simple->new(
156        filter => sub { ${ $_[1] } =~ s/foo/bar/g; },
157        will_modify => 0,    # "foo" is the same length as "bar"
158    );
159
160=back
161
162=head1 SEE ALSO
163
164L<HTTP::Proxy>, L<HTTP::Proxy::BodyFilter>.
165
166=head1 AUTHOR
167
168Philippe "BooK" Bruhat, E<lt>book@cpan.orgE<gt>.
169
170=head1 COPYRIGHT
171
172Copyright 2003-2013, Philippe Bruhat.
173
174=head1 LICENSE
175
176This module is free software; you can redistribute it or modify it under
177the same terms as Perl itself.
178
179=cut
180
181