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