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        elsif((2 ==$inside) && ($_ =~ /^ *\<\/$part/)) {
67            $inside--;
68        }
69    }
70    return %hash;
71}
72
73sub getpart {
74    my ($section, $part)=@_;
75
76    my @this;
77    my $inside=0;
78    my $base64=0;
79
80 #   print "Section: $section, part: $part\n";
81
82    for(@xml) {
83 #       print "$inside: $_";
84        if(!$inside && ($_ =~ /^ *\<$section/)) {
85            $inside++;
86        }
87        elsif((1 ==$inside) && ($_ =~ /^ *\<$part[ \>]/)) {
88            if($_ =~ /$part [^>]*base64=/) {
89                # attempt to detect base64 encoded parts
90                $base64=1;
91            }
92            $inside++;
93        }
94        elsif((2 ==$inside) && ($_ =~ /^ *\<\/$part/)) {
95            $inside--;
96        }
97        elsif((1==$inside) && ($_ =~ /^ *\<\/$section/)) {
98            if($trace) {
99                print STDERR "*** getpart.pm: $section/$part returned data!\n";
100            }
101            if(!@this && $warning) {
102                print STDERR "*** getpart.pm: $section/$part returned empty!\n";
103            }
104            if($base64) {
105                # decode the whole array before returning it!
106                for(@this) {
107                    my $decoded = decode_base64($_);
108                    $_ = $decoded;
109                }
110            }
111            return @this;
112        }
113        elsif(2==$inside) {
114            push @this, $_;
115        }
116    }
117    if($warning) {
118        print STDERR "*** getpart.pm: $section/$part returned empty!\n";
119    }
120    return @this; #empty!
121}
122
123sub loadtest {
124    my ($file)=@_;
125
126    undef @xml;
127
128    if(open(XML, "<$file")) {
129        binmode XML; # for crapage systems, use binary
130        while(<XML>) {
131            push @xml, $_;
132        }
133        close(XML);
134    }
135    else {
136        # failure
137        if($warning) {
138            print STDERR "file $file wouldn't open!\n";
139        }
140        return 1;
141    }
142    return 0;
143}
144
145#
146# Strip off all lines that match the specified pattern and return
147# the new array.
148#
149
150sub striparray {
151    my ($pattern, $arrayref) = @_;
152
153    my @array;
154
155    for(@$arrayref) {
156        if($_ !~ /$pattern/) {
157            push @array, $_;
158        }
159    }
160    return @array;
161}
162
163#
164# pass array *REFERENCES* !
165#
166sub compareparts {
167 my ($firstref, $secondref)=@_;
168
169 my $first = join("", @$firstref);
170 my $second = join("", @$secondref);
171
172 # we cannot compare arrays index per index since with the base64 chunks,
173 # they may not be "evenly" distributed
174
175 # NOTE: this no longer strips off carriage returns from the arrays. Is that
176 # really necessary? It ruins the testing of newlines. I believe it was once
177 # added to enable tests on win32.
178
179 if($first ne $second) {
180     return 1;
181 }
182
183 return 0;
184}
185
186#
187# Write a given array to the specified file
188#
189sub writearray {
190    my ($filename, $arrayref)=@_;
191
192    open(TEMP, ">$filename");
193    binmode(TEMP,":raw"); # cygwin fix by Kevin Roth
194    for(@$arrayref) {
195        print TEMP $_;
196    }
197    close(TEMP);
198}
199
200#
201# Load a specified file an return it as an array
202#
203sub loadarray {
204    my ($filename)=@_;
205    my @array;
206
207    open(TEMP, "<$filename");
208    while(<TEMP>) {
209        push @array, $_;
210    }
211    close(TEMP);
212    return @array;
213}
214
215# Given two array references, this function will store them in two temporary
216# files, run 'diff' on them, store the result and return the diff output!
217
218sub showdiff {
219    my ($logdir, $firstref, $secondref)=@_;
220
221    my $file1="$logdir/check-generated";
222    my $file2="$logdir/check-expected";
223
224    open(TEMP, ">$file1");
225    for(@$firstref) {
226        print TEMP $_;
227    }
228    close(TEMP);
229
230    open(TEMP, ">$file2");
231    for(@$secondref) {
232        print TEMP $_;
233    }
234    close(TEMP);
235    my @out = `diff -u $file2 $file1 2>/dev/null`;
236
237    if(!$out[0]) {
238        @out = `diff -c $file2 $file1 2>/dev/null`;
239    }
240
241    return @out;
242}
243
244
2451;
246