Annotation of embedaddon/curl/tests/getpart.pm, revision 1.1
1.1 ! misho 1: #***************************************************************************
! 2: # _ _ ____ _
! 3: # Project ___| | | | _ \| |
! 4: # / __| | | | |_) | |
! 5: # | (__| |_| | _ <| |___
! 6: # \___|\___/|_| \_\_____|
! 7: #
! 8: # Copyright (C) 1998 - 2020, 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 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: my $xmlfile;
! 27:
! 28: my $warning=0;
! 29: my $trace=0;
! 30:
! 31: sub decode_base64 {
! 32: tr:A-Za-z0-9+/::cd; # remove non-base64 chars
! 33: tr:A-Za-z0-9+/: -_:; # convert to uuencoded format
! 34: my $len = pack("c", 32 + 0.75*length); # compute length byte
! 35: return unpack("u", $len . $_); # uudecode and print
! 36: }
! 37:
! 38: sub decode_hex {
! 39: my $s = $_;
! 40: # remove everything not hex
! 41: $s =~ s/[^A-Fa-f0-9]//g;
! 42: # encode everything
! 43: $s =~ s/([a-fA-F0-9][a-fA-F0-9])/chr(hex($1))/eg;
! 44: return $s;
! 45: }
! 46:
! 47: sub getpartattr {
! 48: # if $part is undefined (ie only one argument) then
! 49: # return the attributes of the section
! 50:
! 51: my ($section, $part)=@_;
! 52:
! 53: my %hash;
! 54: my $inside=0;
! 55:
! 56: # print "Section: $section, part: $part\n";
! 57:
! 58: for(@xml) {
! 59: # print "$inside: $_";
! 60: if(!$inside && ($_ =~ /^ *\<$section/)) {
! 61: $inside++;
! 62: }
! 63: if((1 ==$inside) && ( ($_ =~ /^ *\<$part([^>]*)/) ||
! 64: !(defined($part)) )
! 65: ) {
! 66: $inside++;
! 67: my $attr=$1;
! 68:
! 69: while($attr =~ s/ *([^=]*)= *(\"([^\"]*)\"|([^\> ]*))//) {
! 70: my ($var, $cont)=($1, $2);
! 71: $cont =~ s/^\"(.*)\"$/$1/;
! 72: $hash{$var}=$cont;
! 73: }
! 74: last;
! 75: }
! 76: # detect end of section when part wasn't found
! 77: elsif((1 ==$inside) && ($_ =~ /^ *\<\/$section\>/)) {
! 78: last;
! 79: }
! 80: elsif((2 ==$inside) && ($_ =~ /^ *\<\/$part/)) {
! 81: $inside--;
! 82: }
! 83: }
! 84: return %hash;
! 85: }
! 86:
! 87: sub getpart {
! 88: my ($section, $part)=@_;
! 89:
! 90: my @this;
! 91: my $inside=0;
! 92: my $base64=0;
! 93: my $hex=0;
! 94: my $line;
! 95:
! 96: for(@xml) {
! 97: $line++;
! 98: if(!$inside && ($_ =~ /^ *\<$section/)) {
! 99: $inside++;
! 100: }
! 101: elsif(($inside >= 1) && ($_ =~ /^ *\<$part[ \>]/)) {
! 102: if($inside > 1) {
! 103: push @this, $_;
! 104: }
! 105: elsif($_ =~ /$part [^>]*base64=/) {
! 106: # attempt to detect our base64 encoded part
! 107: $base64=1;
! 108: }
! 109: elsif($_ =~ /$part [^>]*hex=/) {
! 110: # attempt to detect a hex-encoded part
! 111: $hex=1;
! 112: }
! 113: $inside++;
! 114: }
! 115: elsif(($inside >= 2) && ($_ =~ /^ *\<\/$part[ \>]/)) {
! 116: if($inside > 2) {
! 117: push @this, $_;
! 118: }
! 119: $inside--;
! 120: }
! 121: elsif(($inside >= 1) && ($_ =~ /^ *\<\/$section/)) {
! 122: if($inside > 1) {
! 123: print STDERR "$xmlfile:$line:1: error: missing </$part> tag before </$section>\n";
! 124: @this = ("format error in $xmlfile");
! 125: }
! 126: if($trace && @this) {
! 127: print STDERR "*** getpart.pm: $section/$part returned data!\n";
! 128: }
! 129: if($warning && !@this) {
! 130: print STDERR "*** getpart.pm: $section/$part returned empty!\n";
! 131: }
! 132: if($base64) {
! 133: # decode the whole array before returning it!
! 134: for(@this) {
! 135: my $decoded = decode_base64($_);
! 136: $_ = $decoded;
! 137: }
! 138: }
! 139: elsif($hex) {
! 140: # decode the whole array before returning it!
! 141: for(@this) {
! 142: my $decoded = decode_hex($_);
! 143: $_ = $decoded;
! 144: }
! 145: }
! 146: return @this;
! 147: }
! 148: elsif($inside >= 2) {
! 149: push @this, $_;
! 150: }
! 151: }
! 152: if($trace && @this) {
! 153: # section/part has data but end of section not detected,
! 154: # end of file implies end of section.
! 155: print STDERR "*** getpart.pm: $section/$part returned data!\n";
! 156: }
! 157: if($warning && !@this) {
! 158: # section/part does not exist or has no data without an end of
! 159: # section; end of file implies end of section.
! 160: print STDERR "*** getpart.pm: $section/$part returned empty!\n";
! 161: }
! 162: return @this;
! 163: }
! 164:
! 165: sub partexists {
! 166: my ($section, $part)=@_;
! 167:
! 168: my $inside = 0;
! 169:
! 170: for(@xml) {
! 171: if(!$inside && ($_ =~ /^ *\<$section/)) {
! 172: $inside++;
! 173: }
! 174: elsif((1 == $inside) && ($_ =~ /^ *\<$part[ \>]/)) {
! 175: return 1; # exists
! 176: }
! 177: elsif((1 == $inside) && ($_ =~ /^ *\<\/$section/)) {
! 178: return 0; # does not exist
! 179: }
! 180: }
! 181: return 0; # does not exist
! 182: }
! 183:
! 184: # Return entire document as list of lines
! 185: sub getall {
! 186: return @xml;
! 187: }
! 188:
! 189: sub loadtest {
! 190: my ($file)=@_;
! 191:
! 192: undef @xml;
! 193: $xmlfile = $file;
! 194:
! 195: if(open(XML, "<$file")) {
! 196: binmode XML; # for crapage systems, use binary
! 197: while(<XML>) {
! 198: push @xml, $_;
! 199: }
! 200: close(XML);
! 201: }
! 202: else {
! 203: # failure
! 204: if($warning) {
! 205: print STDERR "file $file wouldn't open!\n";
! 206: }
! 207: return 1;
! 208: }
! 209: return 0;
! 210: }
! 211:
! 212: sub fulltest {
! 213: return @xml;
! 214: }
! 215:
! 216: # write the test to the given file
! 217: sub savetest {
! 218: my ($file)=@_;
! 219:
! 220: if(open(XML, ">$file")) {
! 221: binmode XML; # for crapage systems, use binary
! 222: for(@xml) {
! 223: print XML $_;
! 224: }
! 225: close(XML);
! 226: }
! 227: else {
! 228: # failure
! 229: if($warning) {
! 230: print STDERR "file $file wouldn't open!\n";
! 231: }
! 232: return 1;
! 233: }
! 234: return 0;
! 235: }
! 236:
! 237: #
! 238: # Strip off all lines that match the specified pattern and return
! 239: # the new array.
! 240: #
! 241:
! 242: sub striparray {
! 243: my ($pattern, $arrayref) = @_;
! 244:
! 245: my @array;
! 246:
! 247: for(@$arrayref) {
! 248: if($_ !~ /$pattern/) {
! 249: push @array, $_;
! 250: }
! 251: }
! 252: return @array;
! 253: }
! 254:
! 255: #
! 256: # pass array *REFERENCES* !
! 257: #
! 258: sub compareparts {
! 259: my ($firstref, $secondref)=@_;
! 260:
! 261: my $first = join("", @$firstref);
! 262: my $second = join("", @$secondref);
! 263:
! 264: # we cannot compare arrays index per index since with the base64 chunks,
! 265: # they may not be "evenly" distributed
! 266:
! 267: # NOTE: this no longer strips off carriage returns from the arrays. Is that
! 268: # really necessary? It ruins the testing of newlines. I believe it was once
! 269: # added to enable tests on win32.
! 270:
! 271: if($first ne $second) {
! 272: return 1;
! 273: }
! 274:
! 275: return 0;
! 276: }
! 277:
! 278: #
! 279: # Write a given array to the specified file
! 280: #
! 281: sub writearray {
! 282: my ($filename, $arrayref)=@_;
! 283:
! 284: open(TEMP, ">$filename");
! 285: binmode(TEMP,":raw"); # cygwin fix by Kevin Roth
! 286: for(@$arrayref) {
! 287: print TEMP $_;
! 288: }
! 289: close(TEMP);
! 290: }
! 291:
! 292: #
! 293: # Load a specified file and return it as an array
! 294: #
! 295: sub loadarray {
! 296: my ($filename)=@_;
! 297: my @array;
! 298:
! 299: open(TEMP, "<$filename");
! 300: while(<TEMP>) {
! 301: push @array, $_;
! 302: }
! 303: close(TEMP);
! 304: return @array;
! 305: }
! 306:
! 307: # Given two array references, this function will store them in two temporary
! 308: # files, run 'diff' on them, store the result and return the diff output!
! 309:
! 310: sub showdiff {
! 311: my ($logdir, $firstref, $secondref)=@_;
! 312:
! 313: my $file1="$logdir/check-generated";
! 314: my $file2="$logdir/check-expected";
! 315:
! 316: open(TEMP, ">$file1");
! 317: for(@$firstref) {
! 318: my $l = $_;
! 319: $l =~ s/\r/[CR]/g;
! 320: $l =~ s/\n/[LF]/g;
! 321: print TEMP $l;
! 322: print TEMP "\n";
! 323: }
! 324: close(TEMP);
! 325:
! 326: open(TEMP, ">$file2");
! 327: for(@$secondref) {
! 328: my $l = $_;
! 329: $l =~ s/\r/[CR]/g;
! 330: $l =~ s/\n/[LF]/g;
! 331: print TEMP $l;
! 332: print TEMP "\n";
! 333: }
! 334: close(TEMP);
! 335: my @out = `diff -u $file2 $file1 2>/dev/null`;
! 336:
! 337: if(!$out[0]) {
! 338: @out = `diff -c $file2 $file1 2>/dev/null`;
! 339: }
! 340:
! 341: return @out;
! 342: }
! 343:
! 344:
! 345: 1;
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to getpart.pm CVS log ![[TXT]](/icons/cvsweb/text.gif){kind=icon}
![[DIR]](/icons/cvsweb/dir.gif){kind=icon}
Up to [ELWIX - Embedded LightWeight unIX -] / embedaddon / curl / tests