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