Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Fetching contributors…

Cannot retrieve contributors at this time

230 lines (189 sloc) 5.074 kb
#use strict;
my @xml;
my $warning=0;
my $trace=0;
sub decode_base64 {
tr:A-Za-z0-9+/::cd; # remove non-base64 chars
tr:A-Za-z0-9+/: -_:; # convert to uuencoded format
my $len = pack("c", 32 + 0.75*length); # compute length byte
return unpack("u", $len . $_); # uudecode and print
}
sub getpartattr {
# if $part is undefined (ie only one argument) then
# return the attributes of the section
my ($section, $part)=@_;
my %hash;
my $inside=0;
# print "Section: $section, part: $part\n";
for(@xml) {
# print "$inside: $_";
if(!$inside && ($_ =~ /^ *\<$section/)) {
$inside++;
}
if((1 ==$inside) && ( ($_ =~ /^ *\<$part([^>]*)/) ||
!(defined($part)) )
) {
$inside++;
my $attr=$1;
my @p=split("[\t]", $attr);
my $assign;
foreach $assign (@p) {
# $assign is a 'name="contents"' pair
if($assign =~ / *([^=]*)=\"([^\"]*)\"/) {
# *with* quotes
$hash{$1}=$2;
}
elsif($assign =~ / *([^=]*)=([^\"]*)/) {
# *without* quotes
$hash{$1}=$2;
}
}
last;
}
elsif((2 ==$inside) && ($_ =~ /^ *\<\/$part/)) {
$inside--;
}
}
return %hash;
}
sub getpart {
my ($section, $part)=@_;
my @this;
my $inside=0;
my $base64=0;
# print "Section: $section, part: $part\n";
for(@xml) {
# print "$inside: $_";
if(!$inside && ($_ =~ /^ *\<$section/)) {
$inside++;
}
elsif((1 ==$inside) && ($_ =~ /^ *\<$part[ \>]/)) {
if($_ =~ /$part .*base64=/) {
# attempt to detect base64 encoded parts
$base64=1;
}
$inside++;
}
elsif((2 ==$inside) && ($_ =~ /^ *\<\/$part/)) {
$inside--;
}
elsif((1==$inside) && ($_ =~ /^ *\<\/$section/)) {
if($trace) {
print STDERR "*** getpart.pm: $section/$part returned data!\n";
}
if(!@this && $warning) {
print STDERR "*** getpart.pm: $section/$part returned empty!\n";
}
if($base64) {
# decode the whole array before returning it!
for(@this) {
my $decoded = decode_base64($_);
$_ = $decoded;
}
}
return @this;
}
elsif(2==$inside) {
push @this, $_;
}
}
if($warning) {
print STDERR "*** getpart.pm: $section/$part returned empty!\n";
}
return @this; #empty!
}
sub loadtest {
my ($file)=@_;
undef @xml;
if(open(XML, "<$file")) {
binmode XML; # for crapage systems, use binary
while(<XML>) {
push @xml, $_;
}
close(XML);
}
else {
# failure
if($warning) {
print STDERR "file $file wouldn't open!\n";
}
return 1;
}
return 0;
}
#
# Strip off all lines that match the specified pattern and return
# the new array.
#
sub striparray {
my ($pattern, $arrayref) = @_;
my @array;
for(@$arrayref) {
if($_ !~ /$pattern/) {
push @array, $_;
}
}
return @array;
}
#
# pass array *REFERENCES* !
#
sub compareparts {
my ($firstref, $secondref)=@_;
my $first = join("", @$firstref);
my $second = join("", @$secondref);
# we cannot compare arrays index per index since with the base64 chunks,
# they may not be "evenly" distributed
# NOTE: this no longer strips off carriage returns from the arrays. Is that
# really necessary? It ruins the testing of newlines. I believe it was once
# added to enable tests on win32.
if($first ne $second) {
return 1;
}
return 0;
}
#
# Write a given array to the specified file
#
sub writearray {
my ($filename, $arrayref)=@_;
open(TEMP, ">$filename");
binmode(TEMP,":raw"); # cygwin fix by Kevin Roth
for(@$arrayref) {
print TEMP $_;
}
close(TEMP);
}
#
# Load a specified file an return it as an array
#
sub loadarray {
my ($filename)=@_;
my @array;
open(TEMP, "<$filename");
while(<TEMP>) {
push @array, $_;
}
close(TEMP);
return @array;
}
# Given two array references, this function will store them in two temporary
# files, run 'diff' on them, store the result and return the diff output!
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`;
return @out;
}
1;
Jump to Line
Something went wrong with that request. Please try again.