1 #*************************************************************************** 2 # _ _ ____ _ 3 # Project ___| | | | _ \| | 4 # / __| | | | |_) | | 5 # | (__| |_| | _ <| |___ 6 # \___|\___/|_| \_\_____| 7 # 8 # Copyright (C) 1998 - 2012, Daniel Stenberg, <daniel (at] 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 https://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 25 my @xml; 26 27 my $warning=0; 28 my $trace=0; 29 30 sub 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 37 sub 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 77 sub 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(($inside >= 1) && ($_ =~ /^ *\<$part[ \>]/)) { 92 if($inside > 1) { 93 push @this, $_; 94 } 95 elsif($_ =~ /$part [^>]*base64=/) { 96 # attempt to detect our base64 encoded part 97 $base64=1; 98 } 99 $inside++; 100 } 101 elsif(($inside >= 2) && ($_ =~ /^ *\<\/$part[ \>]/)) { 102 if($inside > 2) { 103 push @this, $_; 104 } 105 $inside--; 106 } 107 elsif(($inside >= 1) && ($_ =~ /^ *\<\/$section/)) { 108 if($trace && @this) { 109 print STDERR "*** getpart.pm: $section/$part returned data!\n"; 110 } 111 if($warning && !@this) { 112 print STDERR "*** getpart.pm: $section/$part returned empty!\n"; 113 } 114 if($base64) { 115 # decode the whole array before returning it! 116 for(@this) { 117 my $decoded = decode_base64($_); 118 $_ = $decoded; 119 } 120 } 121 return @this; 122 } 123 elsif($inside >= 2) { 124 push @this, $_; 125 } 126 } 127 if($trace && @this) { 128 # section/part has data but end of section not detected, 129 # end of file implies end of section. 130 print STDERR "*** getpart.pm: $section/$part returned data!\n"; 131 } 132 if($warning && !@this) { 133 # section/part does not exist or has no data without an end of 134 # section; end of file implies end of section. 135 print STDERR "*** getpart.pm: $section/$part returned empty!\n"; 136 } 137 return @this; 138 } 139 140 sub partexists { 141 my ($section, $part)=@_; 142 143 my $inside = 0; 144 145 for(@xml) { 146 if(!$inside && ($_ =~ /^ *\<$section/)) { 147 $inside++; 148 } 149 elsif((1 == $inside) && ($_ =~ /^ *\<$part[ \>]/)) { 150 return 1; # exists 151 } 152 elsif((1 == $inside) && ($_ =~ /^ *\<\/$section/)) { 153 return 0; # does not exist 154 } 155 } 156 return 0; # does not exist 157 } 158 159 # Return entire document as list of lines 160 sub getall { 161 return @xml; 162 } 163 164 sub loadtest { 165 my ($file)=@_; 166 167 undef @xml; 168 169 if(open(XML, "<$file")) { 170 binmode XML; # for crapage systems, use binary 171 while(<XML>) { 172 push @xml, $_; 173 } 174 close(XML); 175 } 176 else { 177 # failure 178 if($warning) { 179 print STDERR "file $file wouldn't open!\n"; 180 } 181 return 1; 182 } 183 return 0; 184 } 185 186 # 187 # Strip off all lines that match the specified pattern and return 188 # the new array. 189 # 190 191 sub striparray { 192 my ($pattern, $arrayref) = @_; 193 194 my @array; 195 196 for(@$arrayref) { 197 if($_ !~ /$pattern/) { 198 push @array, $_; 199 } 200 } 201 return @array; 202 } 203 204 # 205 # pass array *REFERENCES* ! 206 # 207 sub compareparts { 208 my ($firstref, $secondref)=@_; 209 210 my $first = join("", @$firstref); 211 my $second = join("", @$secondref); 212 213 # we cannot compare arrays index per index since with the base64 chunks, 214 # they may not be "evenly" distributed 215 216 # NOTE: this no longer strips off carriage returns from the arrays. Is that 217 # really necessary? It ruins the testing of newlines. I believe it was once 218 # added to enable tests on win32. 219 220 if($first ne $second) { 221 return 1; 222 } 223 224 return 0; 225 } 226 227 # 228 # Write a given array to the specified file 229 # 230 sub writearray { 231 my ($filename, $arrayref)=@_; 232 233 open(TEMP, ">$filename"); 234 binmode(TEMP,":raw"); # cygwin fix by Kevin Roth 235 for(@$arrayref) { 236 print TEMP $_; 237 } 238 close(TEMP); 239 } 240 241 # 242 # Load a specified file and return it as an array 243 # 244 sub loadarray { 245 my ($filename)=@_; 246 my @array; 247 248 open(TEMP, "<$filename"); 249 while(<TEMP>) { 250 push @array, $_; 251 } 252 close(TEMP); 253 return @array; 254 } 255 256 # Given two array references, this function will store them in two temporary 257 # files, run 'diff' on them, store the result and return the diff output! 258 259 sub showdiff { 260 my ($logdir, $firstref, $secondref)=@_; 261 262 my $file1="$logdir/check-generated"; 263 my $file2="$logdir/check-expected"; 264 265 open(TEMP, ">$file1"); 266 for(@$firstref) { 267 my $l = $_; 268 $l =~ s/\r/[CR]/g; 269 $l =~ s/\n/[LF]/g; 270 print TEMP $l; 271 print TEMP "\n"; 272 } 273 close(TEMP); 274 275 open(TEMP, ">$file2"); 276 for(@$secondref) { 277 my $l = $_; 278 $l =~ s/\r/[CR]/g; 279 $l =~ s/\n/[LF]/g; 280 print TEMP $l; 281 print TEMP "\n"; 282 } 283 close(TEMP); 284 my @out = `diff -u $file2 $file1 2>/dev/null`; 285 286 if(!$out[0]) { 287 @out = `diff -c $file2 $file1 2>/dev/null`; 288 } 289 290 return @out; 291 } 292 293 294 1; 295
