blob: 5198b5fa30ddd088980dfe0a959b259617902664 [file] [log] [blame]
lh9ed821d2023-04-07 01:36:19 -07001#***************************************************************************
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;