1 #***************************************************************************
3 # Project ___| | | | _ \| |
5 # | (__| |_| | _ <| |___
6 # \___|\___/|_| \_\_____|
8 # Copyright (C) 1998 - 2012, Daniel Stenberg, <daniel@haxx.se>, et al.
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.
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.
18 # This software is distributed on an "AS IS" basis, WITHOUT WARRANTY OF ANY
19 # KIND, either express or implied.
21 ###########################################################################
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
38 # if $part is undefined (ie only one argument) then
39 # return the attributes of the section
41 my ($section, $part)=@_;
46 # print "Section: $section, part: $part\n";
49 # print "$inside: $_";
50 if(!$inside && ($_ =~ /^ *\<$section/)) {
53 if((1 ==$inside) && ( ($_ =~ /^ *\<$part([^>]*)/) ||
59 while($attr =~ s/ *([^=]*)= *(\"([^\"]*)\"|([^\> ]*))//) {
60 my ($var, $cont)=($1, $2);
61 $cont =~ s/^\"(.*)\"$/$1/;
66 # detect end of section when part wasn't found
67 elsif((1 ==$inside) && ($_ =~ /^ *\<\/$section\>/)) {
70 elsif((2 ==$inside) && ($_ =~ /^ *\<\/$part/)) {
78 my ($section, $part)=@_;
84 # print "Section: $section, part: $part\n";
87 # print "$inside: $_";
88 if(!$inside && ($_ =~ /^ *\<$section/)) {
91 elsif(($inside >= 1) && ($_ =~ /^ *\<$part[ \>]/)) {
95 elsif($_ =~ /$part [^>]*base64=/) {
96 # attempt to detect our base64 encoded part
101 elsif(($inside >= 2) && ($_ =~ /^ *\<\/$part[ \>]/)) {
107 elsif(($inside >= 1) && ($_ =~ /^ *\<\/$section/)) {
108 if($trace && @this) {
109 print STDERR "*** getpart.pm: $section/$part returned data!\n";
111 if($warning && !@this) {
112 print STDERR "*** getpart.pm: $section/$part returned empty!\n";
115 # decode the whole array before returning it!
117 my $decoded = decode_base64($_);
123 elsif($inside >= 2) {
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";
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";
141 my ($section, $part)=@_;
146 if(!$inside && ($_ =~ /^ *\<$section/)) {
149 elsif((1 == $inside) && ($_ =~ /^ *\<$part[ \>]/)) {
152 elsif((1 == $inside) && ($_ =~ /^ *\<\/$section/)) {
153 return 0; # does not exist
156 return 0; # does not exist
159 # Return entire document as list of lines
169 if(open(XML, "<$file")) {
170 binmode XML; # for crapage systems, use binary
179 print STDERR "file $file wouldn't open!\n";
187 # Strip off all lines that match the specified pattern and return
192 my ($pattern, $arrayref) = @_;
197 if($_ !~ /$pattern/) {
205 # pass array *REFERENCES* !
208 my ($firstref, $secondref)=@_;
210 my $first = join("", @$firstref);
211 my $second = join("", @$secondref);
213 # we cannot compare arrays index per index since with the base64 chunks,
214 # they may not be "evenly" distributed
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.
220 if($first ne $second) {
228 # Write a given array to the specified file
231 my ($filename, $arrayref)=@_;
233 open(TEMP, ">$filename");
234 binmode(TEMP,":raw"); # cygwin fix by Kevin Roth
242 # Load a specified file an return it as an array
248 open(TEMP, "<$filename");
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!
260 my ($logdir, $firstref, $secondref)=@_;
262 my $file1="$logdir/check-generated";
263 my $file2="$logdir/check-expected";
265 open(TEMP, ">$file1");
275 open(TEMP, ">$file2");
284 my @out = `diff -u $file2 $file1 2>/dev/null`;
287 @out = `diff -c $file2 $file1 2>/dev/null`;