File Coverage

blib/lib/Array/Stream/Transactional/Matcher/Flow.pm

Criterion	Covered	Total	%
statement	53	53	100.0
branch	19	20	95.0
condition	4	6	66.6
subroutine	7	7	100.0
pod	1	1	100.0
total	84	87	96.5

# $Id: Flow.pm,v 1.14 2004/06/11 20:29:32 claes Exp $

use strict;

our $VERSION = "1.00";

package Array::Stream::Transactional::Matcher::Flow;
use Carp qw(croak confess);

our @ISA = qw(Array::Stream::Transactional::Matcher::Rule);

sub new {
  my ($class, @args) = @_;
  $class = ref $class || $class;

  croak "Can't instansiate abstract class Array::Stream::Transactional::Matcher::Flow" if($class eq "Array::Stream::Transactional::Matcher::Flow");

  my $self = bless [@args], $class;
  return $self;
}

package Array::Stream::Transactional::Matcher::Flow::sequence;
our @ISA = qw(Array::Stream::Transactional::Matcher::Flow);

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

  $stream->commit;

  my @rules = @$self;
  my $match = 0;
 TEST: while(defined (my $rule = shift @rules)) {
    $match = $rule->match($stream, @passthru);
    unless($match) {
      $stream->rollback;
      return 0;
    }
    last TEST unless(@rules);
    $stream->next if($match > 0);
  }

  $stream->regret;
  return $match;
}


package Array::Stream::Transactional::Matcher::Flow::repetition;
use Carp qw(croak);
our @ISA = qw(Array::Stream::Transactional::Matcher::Flow);

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

  $stream->commit;

  my ($rule, $min, $max) = @$self;

  # Take care of 0 as minmum
  unless($rule->match($stream, @passthru)) {
    $stream->rollback;
    if($min == 0) {
      return -1;
    }

    return 0;
  }

  my $match = 0;
  my $failure = 0;
  # Run while we have items in the stream
 TEST: while($stream->has_more) {
    if($rule->match($stream, @passthru)) {
      $match++;
      if(defined $max && $match == $max) {
	last TEST;
      }
      $stream->next;
    } else {
      $failure = 1;
      last TEST;
    }
  }

  if($match >= $min) {
    $stream->regret;
    return $failure ? -1 : 1;
  }

  # Report failure
  $stream->rollback;
  return 0;
}

package Array::Stream::Transactional::Matcher::Flow::optional;
our @ISA = qw(Array::Stream::Transactional::Matcher::Flow::repetition);

sub new {
  my $class = shift;
  my $self = $class->SUPER::new(@_, 0, 1);
  return $self;
}

1;
__END__