view release on metacpan or  search on metacpan

t/values.t  view on Meta::CPAN

use 5.006;
use Test::More qw( no_plan );

use strict;
use warnings;

my $script = "anvl";		# script we're testing

# as of 2011.06.29  flvl() from File::Value
#### start boilerplate for script name and temporary directory support

use Config;
$ENV{SHELL} = "/bin/sh";
my $td = "td_$script";		# temporary test directory named for script
# Depending on circs, use blib, but prepare to use lib as fallback.
my $blib = (-e "blib" || -e "../blib" ?	"-Mblib" : "-Ilib");
my $bin = ($blib eq "-Mblib" ?		# path to testable script
	"blib/script/" : "") . $script;
my $perl = $Config{perlpath};		# perl used in testing
my $cmd = "2>&1 $perl $blib " .		# command to run, capturing stderr
	(-e $bin ? $bin : "../$bin") . " ";	# exit status in $? >> 8

my ($rawstatus, $status);		# "shell status" version of "is"
sub shellst_is { my( $expected, $output, $label )=@_;
	$status = ($rawstatus = $?) >> 8;
	$status != $expected and	# if not what we thought, then we're
		print $output, "\n";	# likely interested in seeing output
	return is($status, $expected, $label);
}

use File::Path;
sub remake_td {		# make $td with possible cleanup
	-e $td			and remove_td();
	mkdir($td)		or die "$td: couldn't mkdir: $!";
}
sub remove_td {		# remove $td but make sure $td isn't set to "."
	! $td || $td eq "."	and die "bad dirname \$td=$td";
	eval { rmtree($td); };
	$@			and die "$td: couldn't remove: $@";
}

use File::Value ':all';

#### end boilerplate

use File::ANVL qw(:all);

{	# values tests

my $m = anvl_valsplit("foo", "dummy");
like $m, qr/array/, 'valsplit message about 2nd arg referencing an array';

my (@elems, @svals);
#print "before svals=", \@svals, "\n";
$m = anvl_valsplit("ab;cd;ef|foo;bar||;;zaf", \@svals);
#print "after svals=", \@svals, "\n";

is scalar(@svals), 4, 'anvl_valsplit into 4 subvalues';

is scalar(@{$svals[0]}), 3, '1st subvalue cardinality correct';

is scalar(@{$svals[1]}), 2, '2nd subvalue cardinality correct';

is scalar(@{$svals[2]}), 0, '3rd subvalue cardinality correct';

is scalar(@{$svals[3]}), 3, '4th subvalue cardinality correct';

my $r = "erc: Gibbon, Edward | "
	. "The Decline and Fall of the Roman Empire | 1781 | "
	. "http://www.ccel.org/g/gibbon/decline/";
$m = anvl_recarray($r, \@elems);
is scalar(@elems), 6, 'correct elem count for shortest record form';

#erc_anvl_expand_array
# anvl_recarray(        # split $record into array of linenum-name-value
#         $record,      # triples, first triple being <anvl, beta, "">
#         $r_elems,     # reference to returned array
#         $linenum,     # starting line number (default 1)
#         $opts );      # options/default, eg, comments/0, autoindent/1

$m = erc_anvl_expand_array(\@elems);
is $m, '', 'simple erc_anvl_expand_array returns no message';

is $elems[7], 'who', 'did expand first element';
#like $m, qr/who:/, 'simple anvl_erc_longer';

my $m2 = erc_anvl_expand_array(\@elems);
is $m2, $m, 'erc_anvl_expand_array idempotence test (re-run against result)';

$r .= "\nnote: that should be preserved\n";
$m = anvl_recarray($r, \@elems);
$m = erc_anvl_expand_array(\@elems);
is $elems[19], 'note', 'other metadata preserved in anvl_erc_longer';

my $relems = [1,1,1, '1:', 'erc', undef];
$m = erc_anvl_expand_array($relems);
is scalar(@$relems), 6, 'no change from erc_anvl_expand_array for empty erc';

$r = "name1;name2;name3|title;subtitle|date|where|vellum|because|a|b|c";
$m2 = anvl_valsplit($r, \@svals);

is scalar(@svals), 9, 'short form with 9 elements/subvalues';

is scalar(@{$svals[0]}), 3, '1st subvalue cardinality correct';

is scalar(@{$svals[1]}), 2, '2nd subvalue cardinality correct';

is scalar(@{$svals[2]}), 1, '3rd subvalue cardinality correct';

is scalar(@{$svals[3]}), 1, '4th subvalue cardinality correct';