File Coverage

blib/lib/POE/Filter/Stackable.pm

Criterion	Covered	Total	%
statement	84	87	96.5
branch	15	24	62.5
condition	4	9	44.4
subroutine	17	17	100.0
pod	12	12	100.0
total	132	149	88.5

# 2001/01/25 [e-mail]

# This implements a filter stack, which turns ReadWrite into something
# very, very interesting.

# 2001-07-26 RCC: I have no idea how to make this support get_one, so
# I'm not going to right now.

package POE::Filter::Stackable;

use strict;
use POE::Filter;

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

use Carp qw(croak);

sub FILTERS () { 0 }

sub FIRST_UNUSED () { 1 }  # First unused $self offset.

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

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

sub new {
  my $type = shift;
  croak "$type must be given an even number of parameters" if @_ & 1;
  my %params = @_;

  $params{Filters} = [ ] unless defined $params{Filters};
  # Sanity check the filters
  if ( ref $params{Filters} eq 'ARRAY') {

    my $self = bless [
      $params{Filters}, # FILTERS
    ], $type;

    return $self;
  } else {
    croak "Filters is not an ARRAY reference!";
  }
}

sub clone {
  my $self = shift;
  my $clone = bless [
    [ ],    # FILTERS
  ], ref $self;
  foreach my $filter (@{$self->[FILTERS]}) {
    push (@{$clone->[FILTERS]}, $filter->clone());
  }
  $clone;
}

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

sub get_one_start {
  my ($self, $data) = @_;
  $self->[FILTERS]->[0]->get_one_start($data);
}

# RCC 2005-06-28: get_one() needs to strobe through all the filters
# regardless whether there's data to input to each.  This is because a
# later filter in the chain may produce multiple things from one piece
# of input.  If we stop even though there's no subsequent input, we
# may lose something.
#
# Keep looping through the filters we manage until get_one() returns a
# record, or until none of the filters exchange data.

sub get_one {
  my ($self) = @_;

  my $return = [ ];

  while (!@$return) {
    my $exchanged = 0;

    foreach my $filter (@{$self->[FILTERS]}) {

      # If we have something to input to the next filter, do that.
      if (@$return) {
        $filter->get_one_start($return);
        $exchanged++;
      }

      # Get what we can from the current filter.
      $return = $filter->get_one();
    }

    last unless $exchanged;
  }

  return $return;
}

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

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

sub put {
  my ($self, $data) = @_;
  foreach my $filter (reverse @{$self->[FILTERS]}) {
    $data = $filter->put($data);
    last unless @$data;
  }
  $data;
}

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

sub get_pending {
  my ($self) = @_;
  my $data;
  for (@{$self->[FILTERS]}) {
    $_->put($data) if $data && @{$data};
    $data = $_->get_pending;
  }
  $data || [];
}

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

sub filter_types {
   map { ref($_) } @{$_[0]->[FILTERS]};
}

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

sub filters {
  @{$_[0]->[FILTERS]};
}

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

sub shift {
  my ($self) = @_;
  my $filter = shift @{$self->[FILTERS]};
  my $pending = $filter->get_pending;
  $self->[FILTERS]->[0]->put( $pending ) if $pending;
  $filter;
}

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

sub unshift {
  my ($self, @filters) = @_;

  # Sanity check
  foreach my $elem ( @filters ) {
    if ( ! defined $elem or ! UNIVERSAL::isa( $elem, 'POE::Filter' ) ) {
      croak "Filter element is not a POE::Filter instance!";
    }
  }

  unshift(@{$self->[FILTERS]}, @filters);
}

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

sub push {
  my ($self, @filters) = @_;

  # Sanity check
  foreach my $elem ( @filters ) {
    if ( ! defined $elem or ! UNIVERSAL::isa( $elem, 'POE::Filter' ) ) {
      croak "Filter element is not a POE::Filter instance!";
    }
  }

  push(@{$self->[FILTERS]}, @filters);
}

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

sub pop {
  my ($self) = @_;
  my $filter = pop @{$self->[FILTERS]};
  my $pending = $filter->get_pending;
  $self->[FILTERS]->[-1]->put( $pending ) if $pending;
  $filter;
}

1;

__END__