The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/perl
#
use strict ;
use Test::More;

use App::Framework ;

# VERSION
our $VERSION = '2.01' ;

my $DEBUG=0;
my $VERBOSE=0;

	my $stdout="" ;
	my $stderr="" ;

	diag( "Testing args (open handles)" );

	# 0 = arg name
	# 1 = arg value (filename/dirname)
	# 2 = check for opened
	# 3 = check output file
	# 4 = output file append
	# 5 = input file
	my @args = (
	#    0          1                   	2  3  4  5
		['src1',	't/args/file.txt',		1, 0, 0, 1],
		['src2',	't/args/dir',			0, 0, 0, 0],
		['src3',	't/args/exists.txt',	1, 0, 0, 1],
		['out1',	't/args/outfile',		1, 1, 0, 0],
		['out2',	't/args/outdir',		0, 0, 0, 0],
		['out3',	't/args/outfile2',		1, 1, 1, 0],
	) ;	
	
	my $open_checks = 0 ;
	foreach my $arg_aref (@args)
	{
		$open_checks++ if $arg_aref->[2] ;
	}
	
	my $infile = 0 ;
	my %contents ;
	foreach my $arg_aref (@args)
	{
		if ($arg_aref->[5])
		{
			$infile++ ;
			$contents{$arg_aref->[0]} = getfile($arg_aref->[1]) ;
		}
	}
	
	my $outfile = 0 ;
	foreach my $arg_aref (@args)
	{
		if ($arg_aref->[3])
		{
			my $file = $arg_aref->[1] ;
			unlink $file if -f $file ;			
			$outfile++ ;
			
			# create some contents
			open my $fh, ">$file" ; 
			print $fh $contents{'src1'} ;
			close $fh ;
		}
	}

	
	plan tests => 2 + ((2 + (scalar(@args) * 2)) * 2 * 2) + (2 * $open_checks) + 2+2 + (1 * $outfile) + (1 * $infile) + $outfile + 1 ;

	@ARGV = () ;
	foreach my $arg_aref (@args)
	{
		push @ARGV, $arg_aref->[1] ;
	}
	App::Framework->new()->go() ;

	


#=================================================================================
# SUBROUTINES EXECUTED BY APP
#=================================================================================

#----------------------------------------------------------------------
# Main execution
#
sub app
{
	my ($app, $opts_href, $args_href) = @_ ;

$app->prt_data("Args: passed hash=", $args_href) ;
	
	# Check args
	my @arglist = $app->feature('Args')->arg_list() ;
	my %arghash = $app->feature('Args')->arg_hash() ;

	my @arglist2 = $app->args() ;

$app->prt_data("Args: list=", \@arglist, "hash=", \%arghash) ;

	is_deeply($args_href, \%arghash, "HASH compare") ;
	is_deeply(\@arglist, \@arglist2, "ARRAY compare") ;

	# test retrived args
	arg_test("arg_list", \@arglist, \%arghash) ;
	arg_test("args", \@arglist2, \%arghash) ;
	
	arg_test("arg_list", \@arglist, $args_href) ;
	arg_test("args", \@arglist2, $args_href) ;


	## Opened file handle
	foreach my $arg_aref (@args)
	{
		if ($arg_aref->[2])
		{
			my $arg = $arg_aref->[0] ;
			ok(exists($args_href->{"${arg}_fh"}), "FH $arg exists") ;
			ok($args_href->{"${arg}_fh"}, "FH $arg not null") ;
		}
	}
	
	## Array should have STDIN open
	ok(exists($args_href->{"array_fh"}), "FH array exists") ;
	ok($args_href->{"array_fh"}, "FH array not null") ;
	is(ref($args_href->{"array_fh"}), 'ARRAY', "FH array is an array ref") ;

	my @a = $app->args() ;
	my $aref = pop @a ;
	ok(scalar(@$aref)==1, "Last arg array length is 1") ;
	is($aref->[0], 'STDIN', "Last arg array value is STDIN") ;
		
	
	## Created file
	foreach my $arg_aref (@args)
	{
		if ($arg_aref->[3])
		{
			my $file = $arg_aref->[1] ;
			ok(-f $file, "File $file exists") ;
		}
	}
	
	## Input files
	foreach my $arg_aref (@args)
	{
		if ($arg_aref->[5])
		{
			my $arg = $arg_aref->[0] ;
			my $expected = $contents{$arg} ;
			my $data = getfh($args_href->{"${arg}_fh"}) ;
			is($data, $expected, "File $arg read contents match") ;
		}
	}
	
	## Output files
	my $new_content = $contents{'src3'} ;
	foreach my $arg_aref (@args)
	{
		if ($arg_aref->[3])
		{
			my $arg = $arg_aref->[0] ;
			my $fh = $args_href->{"${arg}_fh"} ;
			print $fh $new_content ;
		}
	}
	
}


#----------------------------------------------------------------------
sub app_end
{
	## Check written files
	foreach my $arg_aref (@args)
	{
		if ($arg_aref->[3])
		{
			my $expected = "" ;
			my $md = "write" ;
			if ($arg_aref->[4])
			{
				## appended to original
				$expected = $contents{'src1'} ;
				$md = "append" ;
			}
			$expected .= $contents{'src3'} ;
			my $got = getfile($arg_aref->[1]) ;
			is($got, $expected, "Compare output fh $md contents") ;
			
			unlink $arg_aref->[1] ;
		}
	}
}


#=================================================================================
# SUBROUTINES
#=================================================================================

#----------------------------------------------------------------------
sub getfh
{
	my ($fh) = @_ ;
	local $/ = undef ;
	my $data = <$fh> ;
	return $data ;
}

#----------------------------------------------------------------------
sub getfile
{
	my ($file) = @_ ;
	open my $fh, "<$file" ;
	my $data = getfh($fh) ;
	close $fh ;
	return $data ;
}

#----------------------------------------------------------------------
sub arg_test
{
	my ($src, $arglist_aref, $arghash_href) = @_ ;
		
	## Test for correct number of args
	# HASH should have N more, where N=number of open files
	is(scalar(@$arglist_aref), scalar(@args)+1, "$src: Number of args (array)") ;
	is(scalar(keys %$arghash_href), scalar(@args)+$open_checks+2, "$src: Number of args (hash)") ;

	## test each
	foreach my $arg_aref (@args)
	{
		my $arg = $arg_aref->[0] ;
		my $expected = $arg_aref->[1] ;
		ok(exists($arghash_href->{$arg}), "$src: Arg $arg exists") ;
		is($arghash_href->{$arg}, $expected, "$src: Arg $arg") ;
	}
}



#=================================================================================
# SETUP
#=================================================================================
__DATA__

[SUMMARY]

Tests named args handling

[ARGS]

* src1=f	Input file
* src2=d	Input directory
* src3=if	Existing
* out1=>f	Output file
* out2=>d	Output directory
* out3=>>f	Output file append
* array=<f*	All other args are input files


[DESCRIPTION]

B<$name> does some stuff.