my @xml;
my $warning=0;
my $trace=0;
sub decode_base64 {
tr:A-Za-z0-9+/::cd; tr:A-Za-z0-9+/: -_:; my $len = pack("c", 32 + 0.75*length); return unpack("u", $len . $_); }
sub getpartattr {
my ($section, $part)=@_;
my %hash;
my $inside=0;
for(@xml) {
if(!$inside && ($_ =~ /^ *\<$section/)) {
$inside++;
}
if((1 ==$inside) && ( ($_ =~ /^ *\<$part([^>]*)/) ||
!(defined($part)) )
) {
$inside++;
my $attr=$1;
while($attr =~ s/ *([^=]*)= *(\"([^\"]*)\"|([^\> ]*))//) {
my ($var, $cont)=($1, $2);
$cont =~ s/^\"(.*)\"$/$1/;
$hash{$var}=$cont;
}
last;
}
elsif((1 ==$inside) && ($_ =~ /^ *\<\/$section\>/)) {
last;
}
elsif((2 ==$inside) && ($_ =~ /^ *\<\/$part/)) {
$inside--;
}
}
return %hash;
}
sub getpart {
my ($section, $part)=@_;
my @this;
my $inside=0;
my $base64=0;
for(@xml) {
if(!$inside && ($_ =~ /^ *\<$section/)) {
$inside++;
}
elsif(($inside >= 1) && ($_ =~ /^ *\<$part[ \>]/)) {
if($inside > 1) {
push @this, $_;
}
elsif($_ =~ /$part [^>]*base64=/) {
$base64=1;
}
$inside++;
}
elsif(($inside >= 2) && ($_ =~ /^ *\<\/$part[ \>]/)) {
if($inside > 2) {
push @this, $_;
}
$inside--;
}
elsif(($inside >= 1) && ($_ =~ /^ *\<\/$section/)) {
if($trace && @this) {
print STDERR "*** getpart.pm: $section/$part returned data!\n";
}
if($warning && !@this) {
print STDERR "*** getpart.pm: $section/$part returned empty!\n";
}
if($base64) {
for(@this) {
my $decoded = decode_base64($_);
$_ = $decoded;
}
}
return @this;
}
elsif($inside >= 2) {
push @this, $_;
}
}
if($trace && @this) {
print STDERR "*** getpart.pm: $section/$part returned data!\n";
}
if($warning && !@this) {
print STDERR "*** getpart.pm: $section/$part returned empty!\n";
}
return @this;
}
sub partexists {
my ($section, $part)=@_;
my $inside = 0;
for(@xml) {
if(!$inside && ($_ =~ /^ *\<$section/)) {
$inside++;
}
elsif((1 == $inside) && ($_ =~ /^ *\<$part[ \>]/)) {
return 1; }
elsif((1 == $inside) && ($_ =~ /^ *\<\/$section/)) {
return 0; }
}
return 0; }
sub getall {
return @xml;
}
sub loadtest {
my ($file)=@_;
undef @xml;
if(open(XML, "<$file")) {
binmode XML; while(<XML>) {
push @xml, $_;
}
close(XML);
}
else {
if($warning) {
print STDERR "file $file wouldn't open!\n";
}
return 1;
}
return 0;
}
sub striparray {
my ($pattern, $arrayref) = @_;
my @array;
for(@$arrayref) {
if($_ !~ /$pattern/) {
push @array, $_;
}
}
return @array;
}
sub compareparts {
my ($firstref, $secondref)=@_;
my $first = join("", @$firstref);
my $second = join("", @$secondref);
if($first ne $second) {
return 1;
}
return 0;
}
sub writearray {
my ($filename, $arrayref)=@_;
open(TEMP, ">$filename");
binmode(TEMP,":raw"); for(@$arrayref) {
print TEMP $_;
}
close(TEMP);
}
sub loadarray {
my ($filename)=@_;
my @array;
open(TEMP, "<$filename");
while(<TEMP>) {
push @array, $_;
}
close(TEMP);
return @array;
}
sub showdiff {
my ($logdir, $firstref, $secondref)=@_;
my $file1="$logdir/check-generated";
my $file2="$logdir/check-expected";
open(TEMP, ">$file1");
for(@$firstref) {
print TEMP $_;
}
close(TEMP);
open(TEMP, ">$file2");
for(@$secondref) {
print TEMP $_;
}
close(TEMP);
my @out = `diff -u $file2 $file1 2>/dev/null`;
if(!$out[0]) {
@out = `diff -c $file2 $file1 2>/dev/null`;
}
return @out;
}
1;