getpart.pm 7.1 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294
  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. #use strict;
  23. my @xml;
  24. my $warning=0;
  25. my $trace=0;
  26. sub decode_base64 {
  27. tr:A-Za-z0-9+/::cd; # remove non-base64 chars
  28. tr:A-Za-z0-9+/: -_:; # convert to uuencoded format
  29. my $len = pack("c", 32 + 0.75*length); # compute length byte
  30. return unpack("u", $len . $_); # uudecode and print
  31. }
  32. sub getpartattr {
  33. # if $part is undefined (ie only one argument) then
  34. # return the attributes of the section
  35. my ($section, $part)=@_;
  36. my %hash;
  37. my $inside=0;
  38. # print "Section: $section, part: $part\n";
  39. for(@xml) {
  40. # print "$inside: $_";
  41. if(!$inside && ($_ =~ /^ *\<$section/)) {
  42. $inside++;
  43. }
  44. if((1 ==$inside) && ( ($_ =~ /^ *\<$part([^>]*)/) ||
  45. !(defined($part)) )
  46. ) {
  47. $inside++;
  48. my $attr=$1;
  49. while($attr =~ s/ *([^=]*)= *(\"([^\"]*)\"|([^\> ]*))//) {
  50. my ($var, $cont)=($1, $2);
  51. $cont =~ s/^\"(.*)\"$/$1/;
  52. $hash{$var}=$cont;
  53. }
  54. last;
  55. }
  56. # detect end of section when part wasn't found
  57. elsif((1 ==$inside) && ($_ =~ /^ *\<\/$section\>/)) {
  58. last;
  59. }
  60. elsif((2 ==$inside) && ($_ =~ /^ *\<\/$part/)) {
  61. $inside--;
  62. }
  63. }
  64. return %hash;
  65. }
  66. sub getpart {
  67. my ($section, $part)=@_;
  68. my @this;
  69. my $inside=0;
  70. my $base64=0;
  71. # print "Section: $section, part: $part\n";
  72. for(@xml) {
  73. # print "$inside: $_";
  74. if(!$inside && ($_ =~ /^ *\<$section/)) {
  75. $inside++;
  76. }
  77. elsif(($inside >= 1) && ($_ =~ /^ *\<$part[ \>]/)) {
  78. if($inside > 1) {
  79. push @this, $_;
  80. }
  81. elsif($_ =~ /$part [^>]*base64=/) {
  82. # attempt to detect our base64 encoded part
  83. $base64=1;
  84. }
  85. $inside++;
  86. }
  87. elsif(($inside >= 2) && ($_ =~ /^ *\<\/$part[ \>]/)) {
  88. if($inside > 2) {
  89. push @this, $_;
  90. }
  91. $inside--;
  92. }
  93. elsif(($inside >= 1) && ($_ =~ /^ *\<\/$section/)) {
  94. if($trace && @this) {
  95. print STDERR "*** getpart.pm: $section/$part returned data!\n";
  96. }
  97. if($warning && !@this) {
  98. print STDERR "*** getpart.pm: $section/$part returned empty!\n";
  99. }
  100. if($base64) {
  101. # decode the whole array before returning it!
  102. for(@this) {
  103. my $decoded = decode_base64($_);
  104. $_ = $decoded;
  105. }
  106. }
  107. return @this;
  108. }
  109. elsif($inside >= 2) {
  110. push @this, $_;
  111. }
  112. }
  113. if($trace && @this) {
  114. # section/part has data but end of section not detected,
  115. # end of file implies end of section.
  116. print STDERR "*** getpart.pm: $section/$part returned data!\n";
  117. }
  118. if($warning && !@this) {
  119. # section/part does not exist or has no data without an end of
  120. # section; end of file implies end of section.
  121. print STDERR "*** getpart.pm: $section/$part returned empty!\n";
  122. }
  123. return @this;
  124. }
  125. sub partexists {
  126. my ($section, $part)=@_;
  127. my $inside = 0;
  128. for(@xml) {
  129. if(!$inside && ($_ =~ /^ *\<$section/)) {
  130. $inside++;
  131. }
  132. elsif((1 == $inside) && ($_ =~ /^ *\<$part[ \>]/)) {
  133. return 1; # exists
  134. }
  135. elsif((1 == $inside) && ($_ =~ /^ *\<\/$section/)) {
  136. return 0; # does not exist
  137. }
  138. }
  139. return 0; # does not exist
  140. }
  141. # Return entire document as list of lines
  142. sub getall {
  143. return @xml;
  144. }
  145. sub loadtest {
  146. my ($file)=@_;
  147. undef @xml;
  148. if(open(XML, "<$file")) {
  149. binmode XML; # for crapage systems, use binary
  150. while(<XML>) {
  151. push @xml, $_;
  152. }
  153. close(XML);
  154. }
  155. else {
  156. # failure
  157. if($warning) {
  158. print STDERR "file $file wouldn't open!\n";
  159. }
  160. return 1;
  161. }
  162. return 0;
  163. }
  164. #
  165. # Strip off all lines that match the specified pattern and return
  166. # the new array.
  167. #
  168. sub striparray {
  169. my ($pattern, $arrayref) = @_;
  170. my @array;
  171. for(@$arrayref) {
  172. if($_ !~ /$pattern/) {
  173. push @array, $_;
  174. }
  175. }
  176. return @array;
  177. }
  178. #
  179. # pass array *REFERENCES* !
  180. #
  181. sub compareparts {
  182. my ($firstref, $secondref)=@_;
  183. my $first = join("", @$firstref);
  184. my $second = join("", @$secondref);
  185. # we cannot compare arrays index per index since with the base64 chunks,
  186. # they may not be "evenly" distributed
  187. # NOTE: this no longer strips off carriage returns from the arrays. Is that
  188. # really necessary? It ruins the testing of newlines. I believe it was once
  189. # added to enable tests on win32.
  190. if($first ne $second) {
  191. return 1;
  192. }
  193. return 0;
  194. }
  195. #
  196. # Write a given array to the specified file
  197. #
  198. sub writearray {
  199. my ($filename, $arrayref)=@_;
  200. open(TEMP, ">$filename");
  201. binmode(TEMP,":raw"); # cygwin fix by Kevin Roth
  202. for(@$arrayref) {
  203. print TEMP $_;
  204. }
  205. close(TEMP);
  206. }
  207. #
  208. # Load a specified file and return it as an array
  209. #
  210. sub loadarray {
  211. my ($filename)=@_;
  212. my @array;
  213. open(TEMP, "<$filename");
  214. while(<TEMP>) {
  215. push @array, $_;
  216. }
  217. close(TEMP);
  218. return @array;
  219. }
  220. # Given two array references, this function will store them in two temporary
  221. # files, run 'diff' on them, store the result and return the diff output!
  222. sub showdiff {
  223. my ($logdir, $firstref, $secondref)=@_;
  224. my $file1="$logdir/check-generated";
  225. my $file2="$logdir/check-expected";
  226. open(TEMP, ">$file1");
  227. for(@$firstref) {
  228. my $l = $_;
  229. $l =~ s/\r/[CR]/g;
  230. $l =~ s/\n/[LF]/g;
  231. print TEMP $l;
  232. print TEMP "\n";
  233. }
  234. close(TEMP);
  235. open(TEMP, ">$file2");
  236. for(@$secondref) {
  237. my $l = $_;
  238. $l =~ s/\r/[CR]/g;
  239. $l =~ s/\n/[LF]/g;
  240. print TEMP $l;
  241. print TEMP "\n";
  242. }
  243. close(TEMP);
  244. my @out = `diff -u $file2 $file1 2>/dev/null`;
  245. if(!$out[0]) {
  246. @out = `diff -c $file2 $file1 2>/dev/null`;
  247. }
  248. return @out;
  249. }
  250. 1;