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 74HTTP::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 HTTP::Proxy::BodyFilter.pm 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 HTTP::Proxy::BodyFilter for the methods signatures. 104 105=back 106 107=head1 METHODS 108 109This filter "factory" defines the standard 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 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 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-2006, 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