diff options
Diffstat (limited to 'Build/source/libs/curl/tests/getpart.pm')
-rw-r--r-- | Build/source/libs/curl/tests/getpart.pm | 203 |
1 files changed, 203 insertions, 0 deletions
diff --git a/Build/source/libs/curl/tests/getpart.pm b/Build/source/libs/curl/tests/getpart.pm new file mode 100644 index 00000000000..d288000882f --- /dev/null +++ b/Build/source/libs/curl/tests/getpart.pm @@ -0,0 +1,203 @@ + +#use strict; + +my @xml; + +my $warning=0; +my $trace=0; + +sub getpartattr { + my ($section, $part)=@_; + + my %hash; + my $inside=0; + + # print "Section: $section, part: $part\n"; + + for(@xml) { + # print "$inside: $_"; + if(!$inside && ($_ =~ /^ *\<$section/)) { + $inside++; + } + elsif((1 ==$inside) && ($_ =~ /^ *\<$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! + 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=".array1"; + my $file2=".array2"; + + open(TEMP, ">$file1"); + for(@$firstref) { + print TEMP $_; + } + close(TEMP); + + open(TEMP, ">$file2"); + for(@$secondref) { + print TEMP $_; + } + close(TEMP); + + my @out = `diff $file1 $file2`; + + unlink $file1, $file2; + return @out; +} + + +1; |