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
|
package HTTP::Proxy::BodyFilter::lines;
$HTTP::Proxy::BodyFilter::lines::VERSION = '0.304';
use strict;
use Carp;
use HTTP::Proxy::BodyFilter;
use vars qw( @ISA );
@ISA = qw( HTTP::Proxy::BodyFilter );
sub init {
my $self = shift;
croak "slurp mode is not supported. Use HTTP::Proxy::BodyFilter::store."
if @_ && not defined $_[0];
my $eol = @_ ? $_[0] : "\n"; # FIXME shouldn't this be $/?
if ( ref $eol eq 'SCALAR' ) {
local $^W;
croak qq'"$$eol" is not numeric' if $$eol ne ( 0 + $$eol );
croak "Records of size 0 are not supported" if $$eol == 0;
}
$self->{eol} = $eol;
}
sub filter {
my ( $self, $dataref, $message, $protocol, $buffer ) = @_;
return if not defined $buffer; # last "lines"
my $eol = $self->{eol};
if ( $eol eq "" ) { # paragraph mode
# if $$dataref ends with \n\n, we cannot know if there are
# more white lines at the beginning of the next chunk of data
$$dataref =~ /^(.*\n\n)([^\n].*)/sg;
( $$dataref, $$buffer) = defined $1 ? ($1, $2) : ("", $$dataref);
}
elsif ( ref $eol eq 'SCALAR' ) { # record mode
my $idx = length($$dataref) - length($$dataref) % $$eol;
$$buffer = substr( $$dataref, $idx );
$$dataref = substr( $$dataref, 0, $idx );
}
else {
my $idx = rindex( $$dataref, $eol );
if ( $idx == -1 ) {
$$buffer = $$dataref; # keep everything for later
$$dataref = '';
}
else {
$idx += length($eol);
$$buffer = substr( $$dataref, $idx );
$$dataref = substr( $$dataref, 0, $idx );
}
}
}
sub will_modify { 0 }
1;
__END__
=head1 NAME
HTTP::Proxy::BodyFilter::lines - A filter that outputs only complete lines
=head1 SYNOPSIS
use HTTP::Proxy::BodyFilter::lines;
use MyFilter; # this filter only works on complete lines
my $filter = MyFilter->new();
# stack both filters so that they'll handle text/* responses
$proxy->push_filter(
mime => 'text/*',
response => HTTP::Proxy::BodyFilter::lines->new,
response => $filter
);
# I want my lines to end with '!'
# This is equivalent to $/ = '!' in a normal Perl program
my $lines = HTTP::Proxy::BodyFilter::lines->new('!');
=head1 DESCRIPTION
The L<HTTP::Proxy::BodyFilter::lines> filter makes sure that the next filter
in the filter chain will only receive complete lines. The "chunks"
of data received by the following filters with either end with C<\n>
or will be the last piece of data for the current HTTP message body.
You can change the idea the filter has of what is a line by passing to
its constructor the string it should understand as line ending. C<\n>
is the default value.
my $filter = HTTP::Proxy::BodyFilter::lines->new( $sep );
This is similar to modifying C<$/> in a Perl program. In fact, this
filter has a behaviour so similar to modifying $/ that it also knows
about "paragraph mode" and "record mode".
Note that the "slurp" mode is not supported. Please use
L<HTTP::Proxy::BodyFilter::complete> to enable the generic store and forward
filter mechanism.
=head1 METHODS
This filter defines the following methods, which are automatically called:
=over 4
=item init()
Initialise the filter with the EOL information.
=item filter()
Keeps unfinished lines for later.
=item will_modify()
This method returns a I<false> value, thus indicating to the system
that it will not modify data passing through.
=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-2015, Philippe Bruhat.
=head1 LICENSE
This module is free software; you can redistribute it or modify it under
the same terms as Perl itself.
=cut
1;
|
