#!/usr/bin/perl # Test of Net::IMP::Cascade combined with Net::IMP::Pattern use strict; use warnings; use Net::IMP::Cascade; use Net::IMP::Pattern; use Net::IMP::Debug; use Data::Dumper; use Test::More; $DEBUG=0; # enable for extensiv debugging # if you want to run only selected tests add test numbers to cmdline my %only = map { $_ =>1 } @ARGV; my @tests = ( { mod => [ [ qr/fuck/,4,'replace','i' ], ], in => 'xx shfuckt xx', out => 'xx shit xx', }, { mod => [ [ qr/shit/,4,'replace','foo' ], ], in => 'xx shit xx', out => 'xx foo xx', }, { mod => [ [ qr/fuck/,4,'replace','shit' ], [ qr/shit/,4,'replace','foo' ], ], in => 'xx fuck xx', out => 'xx foo xx', }, { in => 'xx shfuckit xx', out => 'xx shfooit xx', }, { mod => [ [ qr/fuck/,4,'replace','i' ], [ qr/shit/,4,'replace','foo' ], ], in => 'xx shfuckt xx', out => 'xx foo xx', }, { mod => [ [ qr/shit/,4,'replace','foo' ], ], in => [ 'xx sh', 'i','t xx' ], out => 'xx foo xx', }, { mod => [ [ qr/fuck/,4,'replace','i' ], [ qr/shit/,4,'replace','foo' ], ], in => 'xx shfuckt fuck shitxx', out => 'xx foo i fooxx', }, { mod => [ [ qr/shit/,4,'replace','foobar' ], [ qr/foobar /,7,'replace','bingo' ], ], in => 'xx shit i shitxx', out => 'xx bingoi foobarxx', }, { mod => [ [ qr/fuck/,4,'replace','i' ], [ qr/shit/,4,'replace','foobar' ], [ qr/foobar/,6,'replace','bingo' ], ], in => 'xx shfuckt fuck shitxx', out => 'xx bingo i bingoxx', } ); plan tests => @tests - keys(%only); my (%test,$out); TEST: for(my $i=0;$i<@tests;$i++) { %test = ( %test,%{$tests[$i]} ); # redefine parts of previous next if %only && ! $only{$i}; my @m; for (@{ $test{mod} }) { my %config = ( rx => $_->[0], rxlen => $_->[1], action => $_->[2], actdata => $_->[3] ); if ( my @err = Net::IMP::Pattern->validate_cfg(%config) ) { fail("config[$i] not valid"); diag( "@err"); next TEST; } push @m, Net::IMP::Pattern->new_factory(%config); } my $analyzer = Net::IMP::Cascade->new_factory( parts => \@m ); my $filter = myFilter->new( $analyzer->new_analyzer ); $out = ''; my $in = $test{in}; diag("===================== [Test#$i] ========================") if $DEBUG; eval { $filter->in(0,$_) for (ref($in) ? @$in:$in); $filter->in(0,''); }; if ($@) { fail("cascade pattern test[$i] got exception"); diag(Dumper({ err => $@, real_out => $out, %test })); } elsif ( $test{out} ne $out ) { fail("cascade pattern test[$i] output not expected"); diag(Dumper({ real_out => $out, %test })); } else { pass("cascade pattern test[$i]"); } } package myFilter; use base 'Net::IMP::Filter'; sub out { my ($self,$dir,$data) = @_; $out .= $data; }