view release on metacpan or  search on metacpan

lib/Array/Stream/Transactional/Matcher/Value.pm  view on Meta::CPAN

  my ($self, $stream) = @_;
  my $compare = $stream->current;
  return $compare > $self->[0] if($compare =~ $number && $self->[1]);
  return $compare gt $self->[0];
}

package Array::Stream::Transactional::Matcher::Value::lt;
our @ISA = qw(Array::Stream::Transactional::Matcher::Value);

sub match {
  my ($self, $stream) = @_;
  my $compare = $stream->current;
  return $compare < $self->[0] if($compare =~ $number && $self->[1]);
  return $compare lt $self->[0];
}

package Array::Stream::Transactional::Matcher::Value::ge;
our @ISA = qw(Array::Stream::Transactional::Matcher::Value);

sub match {
  my ($self, $stream) = @_;
  my $compare = $stream->current;
  return $compare >= $self->[0] if($compare =~ $number && $self->[1]);
  return $compare ge $self->[0];
}

package Array::Stream::Transactional::Matcher::Value::le;
our @ISA = qw(Array::Stream::Transactional::Matcher::Value);

sub match {
  my ($self, $stream) = @_;
  my $compare = $stream->current;
  return $compare <= $self->[0] if($compare =~ $number && $self->[1]);
  return $compare le $self->[0];
}

package Array::Stream::Transactional::Matcher::Value::isa;
our @ISA = qw(Array::Stream::Transactional::Matcher::Value);

sub match {
  my ($self, $stream) = @_;
  my $compare = $stream->current;
  return 0 unless(ref $compare);
  return UNIVERSAL::isa($compare, $self->[0]);
}

1;
__END__
=head1 NAME

Array::Stream::Transactional::Matcher::Value - Rules implementing value checks

=head1 DESCRIPTION

Array::Stream::Transactional::Matcher::Value implements the standard comparision operators eq, ne, gt, lt, ge, le and isa.

=head1 RULES

=head2 Array::Stream::Transactional::Matcher::Value::eq

Does B<==> if it looks like a number, otherwise it does an B<eq>

=over 4

=item new ( $VALUE )

Creates a new EQ rule where the value must be equal to the value of $VALUE.

=back

=head2 Array::Stream::Transactional::Matcher::Value::ne

Does B<!=> if it looks like a number, otherwise it does an B<ne>

=over 4

=item new ( $VALUE )

Creates a new NE rule where the value must not be equal to the value of $VALUE.

=back

=head2 Array::Stream::Transactional::Matcher::Value::gt

Does B<E<gt>> if it looks like a number, otherwise it does an B<gt>

=over 4

=item new ( $VALUE )

Creates a new GT rule where the value must be greater than the value of $VALUE.

=back

=head2 Array::Stream::Transactional::Matcher::Value::lt

Does B<E<lt>> if it looks like a number, otherwise it does an B<lt>

=over 4

=item new ( $VALUE )

Creates a new LT rule where the value must be less than the value of $VALUE.

=back

=head2 Array::Stream::Transactional::Matcher::Value::ge

Does B<E<gt>=> if it looks like a number, otherwise it does an B<le>

=over 4

=item new ( $VALUE )

Creates a new GE rule where the value must be greater than or equal to the value of $VALUE.

=back

=head2 Array::Stream::Transactional::Matcher::Value::le

Does B<E<lt>=> if it looks like a number, otherwise it does an B<le>

=over 4

=item new ( $VALUE )

Creates a new LE rule where the value must be less than or equal tothe value of $VALUE.

=back

=head2 Array::Stream::Transactional::Matcher::Value::isa

Checks if the value is an object and of a specific class or one of its subclasses.

=over 4

=item new ( $VALUE )

Creates a new ISA rule where the value must be an object and belongs to the class specified in $VALUE or one of its subclasses.

=back

=head1 EXPORT

None by default.

=head1 AUTHOR

Claes Jacobsson, E<lt>claesjac@cpan.orgE<gt>

=head1 COPYRIGHT

Copyright 2004 by Claes Jacobsson

This library is free software; you can redistribute it and/or modify it 
under the same license terms as Perl itself.

=cut