1#*************************************************************************** 2# _ _ ____ _ 3# Project ___| | | | _ \| | 4# / __| | | | |_) | | 5# | (__| |_| | _ <| |___ 6# \___|\___/|_| \_\_____| 7# 8# Copyright (C) 1998 - 2011, Daniel Stenberg, <daniel@haxx.se>, et al. 9# 10# This software is licensed as described in the file COPYING, which 11# you should have received as part of this distribution. The terms 12# are also available at http://curl.haxx.se/docs/copyright.html. 13# 14# You may opt to use, copy, modify, merge, publish, distribute and/or sell 15# copies of the Software, and permit persons to whom the Software is 16# furnished to do so, under the terms of the COPYING file. 17# 18# This software is distributed on an "AS IS" basis, WITHOUT WARRANTY OF ANY 19# KIND, either express or implied. 20# 21########################################################################### 22 23#use strict; 24 25my @xml; 26 27my $warning=0; 28my $trace=0; 29 30sub decode_base64 { 31 tr:A-Za-z0-9+/::cd; # remove non-base64 chars 32 tr:A-Za-z0-9+/: -_:; # convert to uuencoded format 33 my $len = pack("c", 32 + 0.75*length); # compute length byte 34 return unpack("u", $len . $_); # uudecode and print 35} 36 37sub getpartattr { 38 # if $part is undefined (ie only one argument) then 39 # return the attributes of the section 40 41 my ($section, $part)=@_; 42 43 my %hash; 44 my $inside=0; 45 46 # print "Section: $section, part: $part\n"; 47 48 for(@xml) { 49 # print "$inside: $_"; 50 if(!$inside && ($_ =~ /^ *\<$section/)) { 51 $inside++; 52 } 53 if((1 ==$inside) && ( ($_ =~ /^ *\<$part([^>]*)/) || 54 !(defined($part)) ) 55 ) { 56 $inside++; 57 my $attr=$1; 58 59 while($attr =~ s/ *([^=]*)= *(\"([^\"]*)\"|([^\"> ]*))//) { 60 my ($var, $cont)=($1, $2); 61 $cont =~ s/^\"(.*)\"$/$1/; 62 $hash{$var}=$cont; 63 } 64 last; 65 } 66 # detect end of section when part wasn't found 67 elsif((1 ==$inside) && ($_ =~ /^ *\<\/$section\>/)) { 68 last; 69 } 70 elsif((2 ==$inside) && ($_ =~ /^ *\<\/$part/)) { 71 $inside--; 72 } 73 } 74 return %hash; 75} 76 77sub getpart { 78 my ($section, $part)=@_; 79 80 my @this; 81 my $inside=0; 82 my $base64=0; 83 84 # print "Section: $section, part: $part\n"; 85 86 for(@xml) { 87 # print "$inside: $_"; 88 if(!$inside && ($_ =~ /^ *\<$section/)) { 89 $inside++; 90 } 91 elsif((1 ==$inside) && ($_ =~ /^ *\<$part[ \>]/)) { 92 if($_ =~ /$part [^>]*base64=/) { 93 # attempt to detect base64 encoded parts 94 $base64=1; 95 } 96 $inside++; 97 } 98 elsif((2 ==$inside) && ($_ =~ /^ *\<\/$part/)) { 99 $inside--; 100 } 101 elsif((1==$inside) && ($_ =~ /^ *\<\/$section/)) { 102 if($trace) { 103 print STDERR "*** getpart.pm: $section/$part returned data!\n"; 104 } 105 if(!@this && $warning) { 106 print STDERR "*** getpart.pm: $section/$part returned empty!\n"; 107 } 108 if($base64) { 109 # decode the whole array before returning it! 110 for(@this) { 111 my $decoded = decode_base64($_); 112 $_ = $decoded; 113 } 114 } 115 return @this; 116 } 117 elsif(2==$inside) { 118 push @this, $_; 119 } 120 } 121 if($warning) { 122 print STDERR "*** getpart.pm: $section/$part returned empty!\n"; 123 } 124 return @this; #empty! 125} 126 127sub loadtest { 128 my ($file)=@_; 129 130 undef @xml; 131 132 if(open(XML, "<$file")) { 133 binmode XML; # for crapage systems, use binary 134 while(<XML>) { 135 push @xml, $_; 136 } 137 close(XML); 138 } 139 else { 140 # failure 141 if($warning) { 142 print STDERR "file $file wouldn't open!\n"; 143 } 144 return 1; 145 } 146 return 0; 147} 148 149# 150# Strip off all lines that match the specified pattern and return 151# the new array. 152# 153 154sub striparray { 155 my ($pattern, $arrayref) = @_; 156 157 my @array; 158 159 for(@$arrayref) { 160 if($_ !~ /$pattern/) { 161 push @array, $_; 162 } 163 } 164 return @array; 165} 166 167# 168# pass array *REFERENCES* ! 169# 170sub compareparts { 171 my ($firstref, $secondref)=@_; 172 173 my $first = join("", @$firstref); 174 my $second = join("", @$secondref); 175 176 # we cannot compare arrays index per index since with the base64 chunks, 177 # they may not be "evenly" distributed 178 179 # NOTE: this no longer strips off carriage returns from the arrays. Is that 180 # really necessary? It ruins the testing of newlines. I believe it was once 181 # added to enable tests on win32. 182 183 if($first ne $second) { 184 return 1; 185 } 186 187 return 0; 188} 189 190# 191# Write a given array to the specified file 192# 193sub writearray { 194 my ($filename, $arrayref)=@_; 195 196 open(TEMP, ">$filename"); 197 binmode(TEMP,":raw"); # cygwin fix by Kevin Roth 198 for(@$arrayref) { 199 print TEMP $_; 200 } 201 close(TEMP); 202} 203 204# 205# Load a specified file an return it as an array 206# 207sub loadarray { 208 my ($filename)=@_; 209 my @array; 210 211 open(TEMP, "<$filename"); 212 while(<TEMP>) { 213 push @array, $_; 214 } 215 close(TEMP); 216 return @array; 217} 218 219# Given two array references, this function will store them in two temporary 220# files, run 'diff' on them, store the result and return the diff output! 221 222sub showdiff { 223 my ($logdir, $firstref, $secondref)=@_; 224 225 my $file1="$logdir/check-generated"; 226 my $file2="$logdir/check-expected"; 227 228 open(TEMP, ">$file1"); 229 for(@$firstref) { 230 print TEMP $_; 231 } 232 close(TEMP); 233 234 open(TEMP, ">$file2"); 235 for(@$secondref) { 236 print TEMP $_; 237 } 238 close(TEMP); 239 my @out = `diff -u $file2 $file1 2>/dev/null`; 240 241 if(!$out[0]) { 242 @out = `diff -c $file2 $file1 2>/dev/null`; 243 } 244 245 return @out; 246} 247 248 2491; 250