File Coverage

blib/lib/POE/Filter/BigBrother.pm

Criterion	Covered	Total	%
statement	38	41	92.6
branch	7	10	70.0
condition	8	12	66.6
subroutine	9	10	90.0
pod	5	5	100.0
total	67	78	85.9

# -*- encoding: utf-8; mode: cperl -*-

# $Id: BigBrother.pm yblusseau $

package POE::Filter::BigBrother;

use strict;
use warnings;
use POE::Filter;

use vars qw($VERSION @ISA);
$VERSION   = '0.13';
@ISA = qw(POE::Filter);

sub DEBUG () 	 { 0 }

sub BUFFER ()    { 0 }
sub COMBO_MSG () { 1 }

use constant {
    LF      => "\x0A",
    CR      => "\x0D",
};

#------------------------------------------------------------------------------
sub new {
  my $type = shift;

  my $self = bless [
    '',           # BUFFER
	0 ,			  # COMBO_MSG
  ], $type;

  $self;
}


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

#------------------------------------------------------------------------------
# 2001-07-27 RCC: The get_one() variant of get() allows Wheel::Xyz to
# retrieve one filtered block at a time.  This is necessary for filter
# changing and proper input flow control.

sub get_one_start {
  my ($self, $stream) = @_;
  $self->[BUFFER] .= join '', @$stream;

  DEBUG and warn $self->[BUFFER];

  # Is it a combo message?
  if (index($self->[BUFFER], "combo".CR) == 0 or
      index($self->[BUFFER], "combo".LF) == 0) {
      # suppress the "combo" keyword and the first new-line character
      substr($self->[BUFFER], 0, 6, "");

      # suppress a potential second new-line character
      my $first = substr($self->[BUFFER], 0, 1);
      substr($self->[BUFFER], 0, 1, "") if $first eq CR or $first eq LF;

      $self->[COMBO_MSG] = 1; # The message is a combo message
  }
}

sub get_one {
  my $self = shift;
  return [] unless defined $self->[BUFFER] and length $self->[BUFFER];

  # Split the Combo message
  if ($self->[COMBO_MSG] and $self->[BUFFER] =~ /(?:(?:\x0D\x0A?){2}|(?:\x0A\x0D?){2})status/) {
      my ($msg, $rest) = split /(?:(?:\x0D\x0A?){2}|(?:\x0A\x0D?){2})status/, $self->[BUFFER], 2;

      $self->[BUFFER] = "status$rest"; # Next message
      return [ $msg ]; # First message
  }
  else {
	  my $block = $self->[BUFFER];
	  $self->[BUFFER] = ''; # Clear the buffer
	  $block =~ s/\0+$//;   # Remove NULL characters from the end
	  return [ $block ];	# Return the data
  }
}

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

sub put {
	my ($self, $chunks) = @_;
	[ @$chunks ];
}

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

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

1; # End of POE::Filter::BigBrother
__END__