• Home
  • Line#
  • Scopes#
  • Navigate#
  • Raw
  • Download
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 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
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(($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
140sub 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
160sub getall {
161    return @xml;
162}
163
164sub 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
191sub 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#
207sub 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#
230sub 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#
244sub 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
259sub 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
2941;
295