tests/getpart.pm

   1 #***************************************************************************
   2 #                                  _   _ ____  _
   3 #  Project                     ___| | | |  _ \| |
   4 #                             / __| | | | |_) | |
   5 #                            | (__| |_| |  _ <| |___
   6 #                             \___|\___/|_| \_\_____|
   7 #
   8 # Copyright (C) 1998 - 2012, 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
  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;