#!/usr/bin/perl use strict; $^W = 1; my $counter = 0; # takes a true/false value as first arg, prints "[not] ok ..." followed # by the second arg sub ok { $counter++; print ''.($_[0] ? 'ok ' : 'not ok ').$counter."\t$_[1]\n"; return $_[0]; } sub is { ok($_[0] eq $_[1], $_[2]) || print "# got: [$_[0]]\n# exp: [$_[1]]\n"; } # compares first two args deeply, prints "[not] ok ..." followed by third arg # NB *only* handles scalars, hashes and arrays sub is_deeply { my($msg, @args) = reverse(@_); ok(_is_deeply(@args), $msg); } sub _is_deeply { my @args = @_; return 0 unless(ref($args[0]) eq ref($args[1])); if(ref($args[0]) eq '') { return ($args[0] eq $args[1]); } elsif(ref($args[0]) eq 'ARRAY') { return _is_deeply_arrays(@args); } elsif(ref($args[0]) eq 'HASH') { return _is_deeply_hashes(@args); } else { return 0 } } sub _is_deeply_arrays { return 0 if(@{$_[0]} != @{$_[1]}); # different sizes foreach my $i (0 .. $#{$_[0]}) { return 0 if(!_is_deeply($_[0]->[$i], $_[1]->[$i])); } return 1; } sub _is_deeply_hashes { my %arg1 = %{$_[0]}; my %arg2 = %{$_[1]}; return 0 if((keys %arg1) != (keys %arg2)); # different sizes return 0 if(!_is_deeply_arrays( # different keys [sort keys %arg1], [sort keys %arg2] )); return 0 if(!_is_deeply_arrays( # different values [@arg1{sort keys %arg1}], [@arg2{sort keys %arg1}] )); return 1; }; # strips the 'attrib' key out of any hashes in a structure sub strip_attribs { return unless(ref($_[0])); if(ref($_[0]) eq 'ARRAY') { foreach (@{$_[0]}) { strip_attribs($_) } } elsif(ref($_[0]) eq 'HASH') { delete $_[0]->{attrib}; if($_[0]->{type} eq 'e') { foreach (@{$_[0]->{content}}) { strip_attribs($_) } } } } 1;