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

209 lines (173 sloc) 4.272 kb
#use strict;
my @xml;
my $warning=0;
my $trace=0;
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;
# print "Section: $section, part: $part\n";
for(@xml) {
# print "$inside: $_";
if(!$inside && ($_ =~ /^ *\<$section/)) {
$inside++;
}
elsif((1 ==$inside) && ($_ =~ /^ *\<$part[ \>]/)) {
$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";
}
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;
open(XML, "<$file") ||
return 1; # failure!
binmode XML; # for crapage systems, use binary
while(<XML>) {
push @xml, $_;
}
close(XML);
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 $sizefirst=scalar(@$firstref);
my $sizesecond=scalar(@$secondref);
if($sizefirst != $sizesecond) {
return -1;
}
for(1 .. $sizefirst) {
my $index = $_ - 1;
if($firstref->[$index] ne $secondref->[$index]) {
(my $aa = $firstref->[$index]) =~ s/\r+\n$/\n/;
(my $bb = $secondref->[$index]) =~ s/\r+\n$/\n/;
if($aa ne $bb) {
return 1+$index;
}
}
}
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, remove the
# temp files and return the diff output!
#
sub showdiff {
my ($firstref, $secondref)=@_;
my $file1=".generated";
my $file2=".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`;
unlink $file1, $file2;
return @out;
}
1;
Jump to Line
Something went wrong with that request. Please try again.