BEGIN {

chdir('t') if -d 't';

@INC = '.';

push @INC, '../lib';

require Config; import Config;

if ($Config{'extensions'} !~ m{\bFilter/Util/Call\b}) {

print "1..0 # Skip: Filter::Util::Call was not built\n";

exit 0;

}

require 'lib/filter-util.pl';

}

use strict;

use warnings;

use vars qw($Inc $Perl);

print "1..32\n" ;

$Perl = "$Perl -w" ;

use Cwd ;

my $here = getcwd ;

my $filename = "call.tst" ;

my $filename2 = "call2.tst" ;

my $filenamebin = "call.bin" ;

my $module = "MyTest" ;

my $module2 = "MyTest2" ;

my $module3 = "MyTest3" ;

my $module4 = "MyTest4" ;

my $module5 = "MyTest5" ;

my $module6 = "MyTest6" ;

my $nested = "nested" ;

my $block = "block" ;

my $redir = $^O eq 'MacOS' ? "" : "2>&1";

# Test error cases

##################

# no filter function in module

###############################

writeFile("${module}.pm", <<EOM) ;

package ${module} ;

use Filter::Util::Call ;

sub import { filter_add(bless []) }

1 ;

EOM

my $a = `$Perl "-I." $Inc -e "use ${module} ;" $redir` ;

ok(1, (($? >>8) != 0 or (($^O eq 'MSWin32' || $^O eq 'MacOS' || $^O eq 'NetWare' || $^O eq 'mpeix') && $? != 0))) ;

ok(2, $a =~ /^Can't locate object method "filter" via package "MyTest"/) ;

# no reference parameter in filter_add

######################################

writeFile("${module}.pm", <<EOM) ;

package ${module} ;

use Filter::Util::Call ;

sub import { filter_add() }

1 ;

EOM

$a = `$Perl "-I." $Inc -e "use ${module} ;" $redir` ;

ok(3, (($? >>8) != 0 or (($^O eq 'MSWin32' || $^O eq 'MacOS' || $^O eq 'NetWare' || $^O eq 'mpeix') && $? != 0))) ;

#ok(4, $a =~ /^usage: filter_add\(ref\) at ${module}.pm/) ;

ok(4, $a =~ /^Not enough arguments for Filter::Util::Call::filter_add/) ;

# non-error cases

#################

# a simple filter, using a closure

#################

writeFile("${module}.pm", <<EOM, <<'EOM') ;

package ${module} ;

EOM

use Filter::Util::Call ;

sub import {

filter_add(

sub {

my ($status) ;

if (($status = filter_read()) > 0) {

s/ABC/DEF/g

}

$status ;

} ) ;

}

1 ;

EOM

writeFile($filename, <<EOM, <<'EOM') ;

use $module ;

EOM

use Cwd ;

$here = getcwd ;

print "I am $here\n" ;

print "some letters ABC\n" ;

$y = "ABCDEF" ;

print <<EOF ;

Alphabetti Spagetti ($y)

EOF

EOM

$a = `$Perl "-I." $Inc $filename $redir` ;

ok(5, ($? >>8) == 0) ;

ok(6, $a eq <<EOM) ;

I am $here

some letters DEF

Alphabetti Spagetti (DEFDEF)

EOM

# a simple filter, not using a closure

#################

writeFile("${module}.pm", <<EOM, <<'EOM') ;

package ${module} ;

EOM

use Filter::Util::Call ;

sub import { filter_add(bless []) }

sub filter

{

my ($self) = @_ ;

my ($status) ;

if (($status = filter_read()) > 0) {

s/ABC/DEF/g

}

$status ;

}

1 ;

EOM

writeFile($filename, <<EOM, <<'EOM') ;

use $module ;

EOM

use Cwd ;

$here = getcwd ;

print "I am $here\n" ;

print "some letters ABC\n" ;

$y = "ABCDEF" ;

print <<EOF ;

Alphabetti Spagetti ($y)

EOF

EOM

$a = `$Perl "-I." $Inc $filename $redir` ;

ok(7, ($? >>8) == 0) ;

ok(8, $a eq <<EOM) ;

I am $here

some letters DEF

Alphabetti Spagetti (DEFDEF)

EOM

# nested filters

################

writeFile("${module2}.pm", <<EOM, <<'EOM') ;

package ${module2} ;

use Filter::Util::Call ;

EOM

sub import { filter_add(bless []) }

sub filter

{

my ($self) = @_ ;

my ($status) ;

if (($status = filter_read()) > 0) {

s/XYZ/PQR/g

}

$status ;

}

1 ;

EOM

writeFile("${module3}.pm", <<EOM, <<'EOM') ;

package ${module3} ;

use Filter::Util::Call ;

EOM

sub import { filter_add(

sub

{

my ($status) ;

if (($status = filter_read()) > 0) {

s/Fred/Joe/g

}

$status ;

} ) ;

}

1 ;

EOM

writeFile("${module4}.pm", <<EOM) ;

package ${module4} ;

use $module5 ;

print "I'm feeling used!\n" ;

print "Fred Joe ABC DEF PQR XYZ\n" ;

print "See you Today\n" ;

1;

EOM

writeFile("${module5}.pm", <<EOM, <<'EOM') ;

package ${module5} ;

use Filter::Util::Call ;

EOM

sub import { filter_add(bless []) }

sub filter

{

my ($self) = @_ ;

my ($status) ;

if (($status = filter_read()) > 0) {

s/Today/Tomorrow/g

}

$status ;

}

1 ;

EOM

writeFile($filename, <<EOM, <<'EOM') ;

# two filters for this file

use $module ;

use $module2 ;

require "$nested" ;

use $module4 ;

EOM

print "some letters ABCXYZ\n" ;

$y = "ABCDEFXYZ" ;

print <<EOF ;

Fred likes Alphabetti Spagetti ($y)

EOF

EOM

writeFile($nested, <<EOM, <<'EOM') ;

use $module3 ;

EOM

print "This is another file XYZ\n" ;

print <<EOF ;

Where is Fred?

EOF

EOM

$a = `$Perl "-I." $Inc $filename $redir` ;

ok(9, ($? >>8) == 0) ;

ok(10, $a eq <<EOM) ;

I'm feeling used!

Fred Joe ABC DEF PQR XYZ

See you Tomorrow

This is another file XYZ

Where is Joe?

some letters DEFPQR

Fred likes Alphabetti Spagetti (DEFDEFPQR)

EOM

# using the module context (with a closure)

###########################################

writeFile("${module2}.pm", <<EOM, <<'EOM') ;

package ${module2} ;

use Filter::Util::Call ;

EOM

sub import

{

my ($type) = shift ;

my (@strings) = @_ ;

filter_add (

sub

{

my ($status) ;

my ($pattern) ;

if (($status = filter_read()) > 0) {

foreach $pattern (@strings)

{ s/$pattern/PQR/g }

}

$status ;

}

)

}

1 ;

EOM

writeFile($filename, <<EOM, <<'EOM') ;

use $module2 qw( XYZ KLM) ;

use $module2 qw( ABC NMO) ;

EOM

print "some letters ABCXYZ KLM NMO\n" ;

$y = "ABCDEFXYZKLMNMO" ;

print <<EOF ;

Alphabetti Spagetti ($y)

EOF

EOM

$a = `$Perl "-I." $Inc $filename $redir` ;

ok(11, ($? >>8) == 0) ;

ok(12, $a eq <<EOM) ;

some letters PQRPQR PQR PQR

Alphabetti Spagetti (PQRDEFPQRPQRPQR)

EOM

# using the module context (without a closure)

##############################################

writeFile("${module2}.pm", <<EOM, <<'EOM') ;

package ${module2} ;

use Filter::Util::Call ;

EOM

sub import

{

my ($type) = shift ;

my (@strings) = @_ ;

filter_add (bless [@strings])

}

sub filter

{

my ($self) = @_ ;

my ($status) ;

my ($pattern) ;

if (($status = filter_read()) > 0) {

foreach $pattern (@$self)

{ s/$pattern/PQR/g }

}

$status ;

}

1 ;

EOM

writeFile($filename, <<EOM, <<'EOM') ;

use $module2 qw( XYZ KLM) ;

use $module2 qw( ABC NMO) ;

EOM

print "some letters ABCXYZ KLM NMO\n" ;

$y = "ABCDEFXYZKLMNMO" ;

print <<EOF ;

Alphabetti Spagetti ($y)

EOF

EOM

$a = `$Perl "-I." $Inc $filename $redir` ;

ok(13, ($? >>8) == 0) ;

ok(14, $a eq <<EOM) ;

some letters PQRPQR PQR PQR

Alphabetti Spagetti (PQRDEFPQRPQRPQR)

EOM

# multi line test

#################

writeFile("${module2}.pm", <<EOM, <<'EOM') ;

package ${module2} ;

use Filter::Util::Call ;

EOM

sub import

{

my ($type) = shift ;

my (@strings) = @_ ;

filter_add(bless [])

}

sub filter

{

my ($self) = @_ ;

my ($status) ;

# read first line

if (($status = filter_read()) > 0) {

chop ;

s/\r$//;

# and now the second line (it will append)

$status = filter_read() ;

}

$status ;

}

1 ;

EOM

writeFile($filename, <<EOM, <<'EOM') ;

use $module2 ;

EOM

print "don't cut me

in half\n" ;

print

<<EOF ;

appen

ded

EO

F

EOM

$a = `$Perl "-I." $Inc $filename $redir` ;

ok(15, ($? >>8) == 0) ;

ok(16, $a eq <<EOM) ;

don't cut me in half

appended

EOM

# Block test

#############

writeFile("${block}.pm", <<EOM, <<'EOM') ;

package ${block} ;

use Filter::Util::Call ;

EOM

sub import

{

my ($type) = shift ;

my (@strings) = @_ ;

filter_add (bless [@strings] )

}

sub filter

{

my ($self) = @_ ;

my ($status) ;

my ($pattern) ;

filter_read(20) ;

}

1 ;

EOM

my $string = <<'EOM' ;

print "hello mum\n" ;

$x = 'me ' x 3 ;

print "Who wants it?\n$x\n" ;

EOM

writeFile($filename, <<EOM, $string ) ;

use $block ;

EOM

$a = `$Perl "-I." $Inc $filename $redir` ;

ok(17, ($? >>8) == 0) ;

ok(18, $a eq <<EOM) ;

hello mum

Who wants it?

me me me

EOM

# use in the filter

####################

writeFile("${block}.pm", <<EOM, <<'EOM') ;

package ${block} ;

use Filter::Util::Call ;

EOM

use Cwd ;

sub import

{

my ($type) = shift ;

my (@strings) = @_ ;

filter_add(bless [@strings] )

}

sub filter

{

my ($self) = @_ ;

my ($status) ;

my ($here) = quotemeta getcwd ;

if (($status = filter_read()) > 0) {

s/DIR/$here/g

}

$status ;

}

1 ;

EOM

writeFile($filename, <<EOM, <<'EOM') ;

use $block ;

EOM

print "We are in DIR\n" ;

EOM

$a = `$Perl "-I." $Inc $filename $redir` ;

ok(19, ($? >>8) == 0) ;

ok(20, $a eq <<EOM) ;

We are in $here

EOM

# filter_del

#############

writeFile("${block}.pm", <<EOM, <<'EOM') ;

package ${block} ;

use Filter::Util::Call ;

EOM

sub import

{

my ($type) = shift ;

my ($count) = @_ ;

filter_add(bless \$count )

}

sub filter

{

my ($self) = @_ ;

my ($status) ;

s/HERE/THERE/g

if ($status = filter_read()) > 0 ;

-- $$self ;

filter_del() if $$self <= 0 ;

$status ;

}

1 ;

EOM

writeFile($filename, <<EOM, <<'EOM') ;

use $block (3) ;

EOM

print "

HERE I am

I am HERE

HERE today gone tomorrow\n" ;

EOM

$a = `$Perl "-I." $Inc $filename $redir` ;

ok(21, ($? >>8) == 0) ;

ok(22, $a eq <<EOM) ;

THERE I am

I am THERE

HERE today gone tomorrow

EOM

# filter_read_exact

####################

writeFile("${block}.pm", <<EOM, <<'EOM') ;

package ${block} ;

use Filter::Util::Call ;

EOM

sub import

{

my ($type) = shift ;

filter_add(bless [] )

}

sub filter

{

my ($self) = @_ ;

my ($status) ;

if (($status = filter_read_exact(9)) > 0) {

s/HERE/THERE/g

}

$status ;

}

1 ;

EOM

writeFile($filenamebin, <<EOM, <<'EOM') ;

use $block ;

EOM

print "

HERE I am

I'm HERE

HERE today gone tomorrow\n" ;

EOM

$a = `$Perl "-I." $Inc $filenamebin $redir` ;

ok(23, ($? >>8) == 0) ;

ok(24, $a eq <<EOM) ;

HERE I am

I'm THERE

THERE today gone tomorrow

EOM

{

# Check __DATA__

####################

writeFile("${block}.pm", <<EOM, <<'EOM') ;

package ${block} ;

use Filter::Util::Call ;

EOM

sub import

{

my ($type) = shift ;

filter_add(bless [] )

}

sub filter

{

my ($self) = @_ ;

my ($status) ;

if (($status = filter_read()) > 0) {

s/HERE/THERE/g

}

$status ;

}

1 ;

EOM

writeFile($filename, <<EOM, <<'EOM') ;

use $block ;

EOM

print "HERE HERE\n";

@a = <DATA>;

print @a;

__DATA__

HERE I am

I'm HERE

HERE today gone tomorrow

EOM

$a = `$Perl "-I." $Inc $filename $redir` ;

ok(25, ($? >>8) == 0) ;

ok(26, $a eq <<EOM) ;

THERE THERE

HERE I am

I'm HERE

HERE today gone tomorrow

EOM

}

{

# Check __END__

####################

writeFile("${block}.pm", <<EOM, <<'EOM') ;

package ${block} ;

use Filter::Util::Call ;

EOM

sub import

{

my ($type) = shift ;

filter_add(bless [] )

}

sub filter

{

my ($self) = @_ ;

my ($status) ;

if (($status = filter_read()) > 0) {

s/HERE/THERE/g

}

$status ;

}

1 ;

EOM

writeFile($filename, <<EOM, <<'EOM') ;

use $block ;

EOM

print "HERE HERE\n";

@a = <DATA>;

print @a;

__END__

HERE I am

I'm HERE

HERE today gone tomorrow

EOM

$a = `$Perl "-I." $Inc $filename $redir` ;

ok(27, ($? >>8) == 0) ;

ok(28, $a eq <<EOM) ;

THERE THERE

HERE I am

I'm HERE

HERE today gone tomorrow

EOM

}

{

# no without use

# see Message-ID: <20021106212427.A15377@ttul.org>

####################

writeFile("${module6}.pm", <<EOM);

package ${module6} ;

#use Filter::Simple;

#FILTER {}

use Filter::Util::Call;

sub import { filter_add(sub{}) }

sub unimport { filter_del() }

1;

EOM

writeFile($filename2, <<EOM);

no ${module6} ;

print "ok";

EOM

my $str = $^O eq 'MacOS' ? "'ok'" : "q{ok}";

my $a = `$Perl "-I." $Inc -e "no ${module6}; print $str"`;

ok(29, ($? >>8) == 0);

chomp( $a ) if $^O eq 'VMS';

ok(30, $a eq 'ok');

$a = `$Perl "-I." $Inc $filename2`;

ok(31, ($? >>8) == 0);

chomp( $a ) if $^O eq 'VMS';

ok(32, $a eq 'ok');

}

END {

1 while unlink $filename ;

1 while unlink $filename2 ;

1 while unlink $filenamebin ;

1 while unlink "${module}.pm" ;

1 while unlink "${module2}.pm" ;

1 while unlink "${module3}.pm" ;

1 while unlink "${module4}.pm" ;

1 while unlink "${module5}.pm" ;

1 while unlink "${module6}.pm" ;

1 while unlink $nested ;

1 while unlink "${block}.pm" ;

}