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