libpoe-perl 2:1.3670-2 / usr / share / perl5 / POE / Filter / Line.pm

package POE::Filter::Line;

use strict;
use POE::Filter;

use vars qw($VERSION @ISA);
$VERSION = '1.367'; # NOTE - Should be #.### (three decimal places)
@ISA = qw(POE::Filter);

use Carp qw(carp croak);

sub DEBUG () { 0 }

sub FRAMING_BUFFER   () { 0 }
sub INPUT_REGEXP     () { 1 }
sub OUTPUT_LITERAL   () { 2 }
sub AUTODETECT_STATE () { 3 }
sub MAX_LENGTH       () { 4 }
sub MAX_BUFFER       () { 5 }
sub FIRST_UNUSED     () { 6 }  # First unused $self offset.

sub AUTO_STATE_DONE   () { 0x00 }
sub AUTO_STATE_FIRST  () { 0x01 }
sub AUTO_STATE_SECOND () { 0x02 }

use base 'Exporter';
our @EXPORT_OK = qw( FIRST_UNUSED );

#------------------------------------------------------------------------------

sub new {
  my $type = shift;

  croak "$type requires an even number of parameters" if @_ and @_ & 1;
  my %params = @_;

  croak "$type cannot have both Regexp and Literal line endings" if (
    defined $params{Regexp} and defined $params{Literal}
  );

  my ($input_regexp, $output_literal);
  my $autodetect = AUTO_STATE_DONE;

  # Literal newline for both incoming and outgoing.  Every other known
  # parameter conflicts with this one.
  if (defined $params{Literal}) {
    croak "A defined Literal must have a nonzero length"
      unless defined($params{Literal}) and length($params{Literal});
    $input_regexp   = quotemeta $params{Literal};
    $output_literal = $params{Literal};
    if (
      exists $params{InputLiteral} or # undef means something
      defined $params{InputRegexp} or
      defined $params{OutputLiteral}
    ) {
      croak "$type cannot have Literal with any other parameter";
    }
  }

  # Input and output are specified separately, then.
  else {

    # Input can be either a literal or a regexp.  The regexp may be
    # compiled or not; we don't rightly care at this point.
    if (exists $params{InputLiteral}) {
      $input_regexp = $params{InputLiteral};

      # InputLiteral is defined.  Turn it into a regexp and be done.
      # Otherwise we will autodetect it.
      if (defined($input_regexp) and length($input_regexp)) {
        $input_regexp = quotemeta $input_regexp;
      }
      else {
        $autodetect   = AUTO_STATE_FIRST;
        $input_regexp = '';
      }

      croak "$type cannot have both InputLiteral and InputRegexp"
        if defined $params{InputRegexp};
    }
    elsif (defined $params{InputRegexp}) {
      $input_regexp = $params{InputRegexp};
      croak "$type cannot have both InputLiteral and InputRegexp"
        if defined $params{InputLiteral};
    }
    else {
      $input_regexp = "(\\x0D\\x0A?|\\x0A\\x0D?)";
    }

    if (defined $params{OutputLiteral}) {
      $output_literal = $params{OutputLiteral};
    }
    else {
      $output_literal = "\x0D\x0A";
    }
  }

  my $max_buffer = $type->__param_max( MaxBuffer => 512*1024*1024, \%params );
  my $max_length = $type->__param_max( MaxLength => 64*1024*1024, \%params );
  croak "MaxBuffer is not large enough for MaxLength blocks"
        unless $max_buffer >= $max_length;

  delete @params{qw(Literal InputLiteral OutputLiteral InputRegexp MaxLength MaxBuffer)};
  carp("$type ignores unknown parameters: ", join(', ', sort keys %params))
    if scalar keys %params;

  my $self = bless [
    '',              # FRAMING_BUFFER
    $input_regexp,   # INPUT_REGEXP
    $output_literal, # OUTPUT_LITERAL
    $autodetect,     # AUTODETECT_STATE
    $max_length,     # MAX_LENGTH
    $max_buffer      # MAX_BUFFER
  ], $type;

  DEBUG and warn join ':', @$self;

  $self;
}


#------------------------------------------------------------------------------
# get() is inherited from POE::Filter.

#------------------------------------------------------------------------------
# 2001-07-27 RCC: Add get_one_start() and get_one() to correct filter
# changing and make input flow control possible.

sub get_one_start {
  my ($self, $stream) = @_;

  DEBUG and do {
    my $temp = join '', @$stream;
    $temp = unpack 'H*', $temp;
    warn "got some raw data: $temp\n";
  };

  $self->[FRAMING_BUFFER] .= join '', @$stream;
  die "Framing buffer exceeds the limit"
    if $self->[MAX_BUFFER] < length( $self->[FRAMING_BUFFER] );
}

# TODO There is a lot of code duplicated here.  What can be done?

sub get_one {
  my $self = shift;

  # Process as many newlines an we can find.
  LINE: while (1) {

    # Autodetect is done, or it never started.  Parse some buffer!
    unless ($self->[AUTODETECT_STATE]) {
      DEBUG and warn unpack 'H*', $self->[INPUT_REGEXP];
      last LINE
        unless $self->[FRAMING_BUFFER] =~ s/^(.*?)$self->[INPUT_REGEXP]//s;
      DEBUG and warn "got line: <<", unpack('H*', $1), ">>\n";
      my $line = $1;
      die "Next line exceeds maximum line length"
            if length( $line ) > $self->[MAX_LENGTH];

      return [ $line ];
    }

    # Waiting for the first line ending.  Look for a generic newline.
    if ($self->[AUTODETECT_STATE] & AUTO_STATE_FIRST) {
      last LINE
        unless $self->[FRAMING_BUFFER] =~ s/^(.*?)(\x0D\x0A?|\x0A\x0D?)//;

      my $line = $1;

      # The newline can be complete under two conditions.  First: If
      # it's two characters.  Second: If there's more data in the
      # framing buffer.  Loop around in case there are more lines.
      if ( (length($2) == 2) or
           (length $self->[FRAMING_BUFFER])
         ) {
        DEBUG and warn "detected complete newline after line: <<$1>>\n";
        $self->[INPUT_REGEXP] = $2;
        $self->[AUTODETECT_STATE] = AUTO_STATE_DONE;
      }

      # The regexp has matched a potential partial newline.  Save it,
      # and move to the next state.  There is no more data in the
      # framing buffer, so we're done.
      else {
        DEBUG and warn "detected suspicious newline after line: <<$1>>\n";
        $self->[INPUT_REGEXP] = $2;
        $self->[AUTODETECT_STATE] = AUTO_STATE_SECOND;
      }
      die "Next line exceeds maximum line length"
            if length( $line ) > $self->[MAX_LENGTH];

      return [ $line ];
    }

    # Waiting for the second line beginning.  Bail out if we don't
    # have anything in the framing buffer.
    if ($self->[AUTODETECT_STATE] & AUTO_STATE_SECOND) {
      return [ ] unless length $self->[FRAMING_BUFFER];

      # Test the first character to see if it completes the previous
      # potentially partial newline.
      if (
        substr($self->[FRAMING_BUFFER], 0, 1) eq
        ( $self->[INPUT_REGEXP] eq "\x0D" ? "\x0A" : "\x0D" )
      ) {

        # Combine the first character with the previous newline, and
        # discard the newline from the buffer.  This is two statements
        # for backward compatibility.
        DEBUG and warn "completed newline after line: <<$1>>\n";
        $self->[INPUT_REGEXP] .= substr($self->[FRAMING_BUFFER], 0, 1);
        substr($self->[FRAMING_BUFFER], 0, 1) = '';
      }
      elsif (DEBUG) {
        warn "decided prior suspicious newline is okay\n";
      }

      # Regardless, whatever is in INPUT_REGEXP is now a complete
      # newline.  End autodetection, post-process the found newline,
      # and loop to see if there are other lines in the buffer.
      $self->[INPUT_REGEXP] = $self->[INPUT_REGEXP];
      $self->[AUTODETECT_STATE] = AUTO_STATE_DONE;
      next LINE;
    }

    die "consistency error: AUTODETECT_STATE = $self->[AUTODETECT_STATE]";
  }

  return [ ];
}

#------------------------------------------------------------------------------
# New behavior.  First translate system newlines ("\n") into whichever
# newlines are supposed to be sent.  Second, add a trailing newline if
# one doesn't already exist.  Since the referenced output list is
# supposed to contain one line per element, we also do a split and
# join.  Bleah. ... why isn't the code doing what the comment says?

sub put {
  my ($self, $lines) = @_;

  my @raw;
  foreach (@$lines) {
    push @raw, $_ . $self->[OUTPUT_LITERAL];
  }

  \@raw;
}

#------------------------------------------------------------------------------

sub get_pending {
  my $self = shift;
  return [ $self->[FRAMING_BUFFER] ] if length $self->[FRAMING_BUFFER];
  return undef;
}

1;

__END__

=head1 NAME

POE::Filter::Line - serialize and parse terminated records (lines)

=head1 SYNOPSIS

  #!perl

  use POE qw(Wheel::FollowTail Filter::Line);

  POE::Session->create(
    inline_states => {
      _start => sub {
        $_[HEAP]{tailor} = POE::Wheel::FollowTail->new(
          Filename => "/var/log/system.log",
          InputEvent => "got_log_line",
          Filter => POE::Filter::Line->new(),
        );
      },
      got_log_line => sub {
        print "Log: $_[ARG0]\n";
      }
    }
  );

  POE::Kernel->run();
  exit;

=head1 DESCRIPTION

POE::Filter::Line parses stream data into terminated records.  The
default parser interprets newlines as the record terminator, and the
default serializer appends network newlines (CR/LF, or "\x0D\x0A") to
outbound records.

Record terminators are removed from the data POE::Filter::Line
returns.

POE::Filter::Line supports a number of other ways to parse lines.
Constructor parameters may specify literal newlines, regular
expressions, or that the filter should detect newlines on its own.

=head1 PUBLIC FILTER METHODS

POE::Filter::Line's new() method has some interesting parameters.

=head2 new

new() accepts a list of named parameters.

In all cases, the data interpreted as the record terminator is
stripped from the data POE::Filter::Line returns.

C<InputLiteral> may be used to parse records that are terminated by
some literal string.  For example, POE::Filter::Line may be used to
parse and emit C-style lines, which are terminated with an ASCII NUL:

  my $c_line_filter = POE::Filter::Line->new(
    InputLiteral => chr(0),
    OutputLiteral => chr(0),
  );

C<OutputLiteral> allows a filter to put() records with a different
record terminator than it parses.  This can be useful in applications
that must translate record terminators.

C<Literal> is a shorthand for the common case where the input and
output literals are identical.  The previous example may be written
as:

  my $c_line_filter = POE::Filter::Line->new(
    Literal => chr(0),
  );

An application can also allow POE::Filter::Line to figure out which
newline to use.  This is done by specifying C<InputLiteral> to be
undef:

  my $whichever_line_filter = POE::Filter::Line->new(
    InputLiteral => undef,
    OutputLiteral => "\n",
  );

C<InputRegexp> may be used in place of C<InputLiteral> to recognize
line terminators based on a regular expression.  In this example,
input is terminated by two or more consecutive newlines.  On output,
the paragraph separator is "---" on a line by itself.

  my $paragraph_filter = POE::Filter::Line->new(
    InputRegexp => "([\x0D\x0A]{2,})",
    OutputLiteral => "\n---\n",
  );

C<MaxBuffer> sets the maximum amount of data that the filter will hold onto 
while trying to find a line ending.  Defaults to 512 MB.

C<MaxLength> sets the maximum length of a line.  Defaults to 64 MB.

If either the C<MaxLength> or C<MaxBuffer> constraint is exceeded,
C<POE::Filter::Line> will throw an exception.


=head1 PUBLIC FILTER METHODS

POE::Filter::Line has no additional public methods.

=head1 SUBCLASSING

POE::Filter::Line exports the FIRST_UNUSED constant.  This points to
the first unused element in the $self array reference.  Subclasses
should store their own data beginning here, and they should export
their own FIRST_UNUSED constants to help future subclassers.

=head1 SEE ALSO

Please see L<POE::Filter> for documentation regarding the base
interface.

The SEE ALSO section in L<POE> contains a table of contents covering
the entire POE distribution.

=head1 BUGS

The default input newline parser is a regexp that has an unfortunate
race condition.  First the regular expression:

  /(\x0D\x0A?|\x0A\x0D?)/

While it quickly recognizes most forms of newline, it can sometimes
detect an extra blank line.  This happens when a two-byte newline
character is broken between two reads.  Consider this situation:

  some stream dataCR
  LFother stream data

The regular expression will see the first CR without its corresponding
LF.  The filter will properly return "some stream data" as a line.
When the next packet arrives, the leading "LF" will be treated as the
terminator for a 0-byte line.  The filter will faithfully return this
empty line.

B<It is advised to specify literal newlines or use the autodetect
feature in applications where blank lines are significant.>

=head1 AUTHORS & COPYRIGHTS

Please see L<POE> for more information about authors and contributors.

=cut

# rocco // vim: ts=2 sw=2 expandtab
# TODO - Edit.