1package HTTP::Proxy::BodyFilter::lines; 2$HTTP::Proxy::BodyFilter::lines::VERSION = '0.304'; 3use strict; 4use Carp; 5use HTTP::Proxy::BodyFilter; 6use vars qw( @ISA ); 7@ISA = qw( HTTP::Proxy::BodyFilter ); 8 9sub init { 10 my $self = shift; 11 12 croak "slurp mode is not supported. Use HTTP::Proxy::BodyFilter::store." 13 if @_ && not defined $_[0]; 14 15 my $eol = @_ ? $_[0] : "\n"; # FIXME shouldn't this be $/? 16 if ( ref $eol eq 'SCALAR' ) { 17 local $^W; 18 croak qq'"$$eol" is not numeric' if $$eol ne ( 0 + $$eol ); 19 croak "Records of size 0 are not supported" if $$eol == 0; 20 } 21 $self->{eol} = $eol; 22} 23 24sub filter { 25 my ( $self, $dataref, $message, $protocol, $buffer ) = @_; 26 return if not defined $buffer; # last "lines" 27 28 my $eol = $self->{eol}; 29 if ( $eol eq "" ) { # paragraph mode 30 # if $$dataref ends with \n\n, we cannot know if there are 31 # more white lines at the beginning of the next chunk of data 32 $$dataref =~ /^(.*\n\n)([^\n].*)/sg; 33 ( $$dataref, $$buffer) = defined $1 ? ($1, $2) : ("", $$dataref); 34 } 35 elsif ( ref $eol eq 'SCALAR' ) { # record mode 36 my $idx = length($$dataref) - length($$dataref) % $$eol; 37 $$buffer = substr( $$dataref, $idx ); 38 $$dataref = substr( $$dataref, 0, $idx ); 39 } 40 else { 41 my $idx = rindex( $$dataref, $eol ); 42 if ( $idx == -1 ) { 43 $$buffer = $$dataref; # keep everything for later 44 $$dataref = ''; 45 } 46 else { 47 $idx += length($eol); 48 $$buffer = substr( $$dataref, $idx ); 49 $$dataref = substr( $$dataref, 0, $idx ); 50 } 51 } 52} 53 54sub will_modify { 0 } 55 561; 57 58__END__ 59 60=head1 NAME 61 62HTTP::Proxy::BodyFilter::lines - A filter that outputs only complete lines 63 64=head1 SYNOPSIS 65 66 use HTTP::Proxy::BodyFilter::lines; 67 use MyFilter; # this filter only works on complete lines 68 69 my $filter = MyFilter->new(); 70 71 # stack both filters so that they'll handle text/* responses 72 $proxy->push_filter( 73 mime => 'text/*', 74 response => HTTP::Proxy::BodyFilter::lines->new, 75 response => $filter 76 ); 77 78 # I want my lines to end with '!' 79 # This is equivalent to $/ = '!' in a normal Perl program 80 my $lines = HTTP::Proxy::BodyFilter::lines->new('!'); 81 82=head1 DESCRIPTION 83 84The L<HTTP::Proxy::BodyFilter::lines> filter makes sure that the next filter 85in the filter chain will only receive complete lines. The "chunks" 86of data received by the following filters with either end with C<\n> 87or will be the last piece of data for the current HTTP message body. 88 89You can change the idea the filter has of what is a line by passing to 90its constructor the string it should understand as line ending. C<\n> 91is the default value. 92 93 my $filter = HTTP::Proxy::BodyFilter::lines->new( $sep ); 94 95This is similar to modifying C<$/> in a Perl program. In fact, this 96filter has a behaviour so similar to modifying $/ that it also knows 97about "paragraph mode" and "record mode". 98 99Note that the "slurp" mode is not supported. Please use 100L<HTTP::Proxy::BodyFilter::complete> to enable the generic store and forward 101filter mechanism. 102 103=head1 METHODS 104 105This filter defines the following methods, which are automatically called: 106 107=over 4 108 109=item init() 110 111Initialise the filter with the EOL information. 112 113=item filter() 114 115Keeps unfinished lines for later. 116 117=item will_modify() 118 119This method returns a I<false> value, thus indicating to the system 120that it will not modify data passing through. 121 122=back 123 124=head1 SEE ALSO 125 126L<HTTP::Proxy>, L<HTTP::Proxy::BodyFilter>. 127 128=head1 AUTHOR 129 130Philippe "BooK" Bruhat, E<lt>book@cpan.orgE<gt>. 131 132=head1 COPYRIGHT 133 134Copyright 2003-2015, Philippe Bruhat. 135 136=head1 LICENSE 137 138This module is free software; you can redistribute it or modify it under 139the same terms as Perl itself. 140 141=cut 142 1431; 144