test/regression/xmlpp.pl

   1 #!/usr/bin/perl  -w
   2
   3 #
   4 #  Copyright (c) 2002, DecisionSoft Limited All rights reserved.
   5 #  Please see:
   6 #  http://software.decisionsoft.com/license.html
   7 #  for more information.
   8 #
   9
  10 # $Revision: 1.1 $
  11 #
  12 # xmlpp: XML pretty printing
  13 #
  14
  15 # For custom attribute sorting create an attributeOrdering.txt file that
  16 # lists each attributes separated by a newline in the order you would like
  17 # them to be sorted separated by a newline. Then use the -s option.
  18
  19 use FileHandle;
  20 use Fcntl;
  21 use Getopt::Std;
  22
  23 use vars qw($opt_h $opt_H $opt_s $opt_z $opt_t $opt_e $opt_S $opt_c $opt_n);
  24
  25 my $indent=0;
  26 my $textContent='';
  27 my $lastTag=undef;
  28 my $output;
  29 my $inAnnotation = 0;
  30
  31
  32 if (!getopts('nzhHsteSc') or $opt_h) {
  33     usage();
  34 }
  35
  36 if ($opt_s){
  37
  38 # expect to find attributeOrdering.txt file in same directory
  39 # as xmlpp is being run from
  40
  41   my $scriptDir = $0;
  42   if ($scriptDir =~ m#/#){
  43     $scriptDir =~ s#/[^/]+$##;
  44   }
  45   else{
  46     $scriptDir =".";
  47   }
  48
  49   # get attribute ordering from external file
  50   if (open(SORTLIST, "<$scriptDir/attributeOrdering.txt")) {
  51     @sortlist = <SORTLIST>;
  52     chomp @sortlist;
  53     close (SORTLIST);
  54     @specialSort = grep(/^\w+/, @sortlist);
  55   }
  56   else {
  57    print STDERR  "Could not open $scriptDir/attributeOrdering.txt: $!\nWARNING attribute sorting will only be alphabetic\n\n";
  58   }
  59 }
  60
  61
  62 # set line separator to ">" speeding up parsing of XML files
  63 # with no line breaks
  64
  65 $/ = ">";
  66
  67
  68 my $sortAttributes = $opt_s;
  69 my $newLineComments = $opt_c;
  70 my $splitAttributes = $opt_t;
  71 my $schemaHackMode = $opt_S;
  72 my $normaliseWhiteSpace = $opt_n;
  73
  74 my $filename = $ARGV[0];
  75 if ($opt_z && (!$filename or $filename eq '-')) {
  76     print STDERR "Error: I can't edit STDIN in place.\n";
  77     usage();
  78 }
  79
  80 if (!$opt_z && scalar(@ARGV) > 1) {
  81     print STDERR "Warning: Multiple files specified without -z option\n";
  82 }
  83
  84 my $fh;
  85
  86 my $stdin;
  87
  88 if (!$filename or $filename eq '-') {
  89     $fh=*STDIN;
  90     $stdin=1;
  91 } else {
  92     $fh = open_next_file() or exit(1);
  93     $stdin=0;
  94 }
  95
  96 do {
  97     $indent=0;
  98     $textContent='';
  99     $lastTag=undef;
 100     $output = '';
 101     my $re_name = "(?:[A-Za-z0-9_:][A-Za-z0-9_:.-]*)";
 102     my $re_attr = "(?:'[^']*'|\"[^\"]*\")";
 103     my $input;
 104
 105     while ($input .= <$fh>) {
 106         while ($input) {
 107             if ($input =~ s/^<($re_name)((?:\s+$re_name\s*=\s*$re_attr)*\s*)(\/?)>(.*)$/$4/s ) {
 108                 my %attr;
 109                 my ($name,$attr,$selfclose) = ($1,$2,$3);
 110                 while ($attr =~ m/($re_name)\s*=\s*($re_attr)/gs) {
 111                     my ($name,$value) = ($1,$2);
 112                     $value =~ s/^["'](.*)["']$/$1/s;
 113                     $attr{$name} = $value;
 114                 }
 115                 if ($opt_e) {
 116                     parseStart($name, 0, %attr);
 117                     if ($selfclose) { parseEnd($name) }
 118                 } else {
 119                     parseStart($name, $selfclose, %attr);
 120                 }
 121             } elsif ($input =~ s/^<\/($re_name)\s*>(.*)$/$2/s) {
 122                 parseEnd($1);
 123             } elsif ($input =~ s/^<!--(.*?)-->(.*)$/$2/s) {
 124                 parseComment($1);
 125             } elsif ($input =~ s/^([^<]+)(.*)$/$2/s) {
 126                 parseDefault($1);
 127             } elsif ($input =~ s/^(<\?[^>]*\?>)(.*)$/$2/s) {
 128                 parsePI("$1\n");
 129             } elsif ($input =~ s/^(<\!DOCTYPE[^\[>]*(\[[^\]]*\])?[^>]*>)(.*)$/$3/s) {
 130                 parseDoctype("$1");
 131             } else {
 132                 last;
 133             }
 134         }
 135         if (eof($fh)) {
 136             last;
 137         }
 138     }
 139
 140
 141     if ($input) {
 142         $input =~ m/([^\n]+)/gs;
 143         print STDERR "WARNING: junk remaining on input: $1\n";
 144     }
 145     $fh->close();
 146
 147     if (!$opt_z) {
 148         if(!$opt_H){
 149             print "$output\n"
 150         } else {
 151             print html_escape($output)."\n"
 152         }
 153     } else {
 154         if ($input) {
 155             print STDERR "Not overwriting file\n";
 156         } else {
 157             open FOUT,"> $filename" or die "Cannot overwrite file: $!";
 158             if(!$opt_H){
 159                 print FOUT "$output\n"
 160             } else {
 161                 print FOUT html_escape($output)."\n"
 162             }
 163             close FOUT
 164         }
 165     }
 166 } while (
 167     !$stdin && $opt_z && ($fh = open_next_file(\$filename))
 168   );
 169
 170
 171
 172 sub parseStart {
 173     my $s = shift;
 174     my $selfclose = shift;
 175     my %attr = @_;
 176
 177     $textContent =~ s/\s+$//;
 178     printContent($textContent);
 179
 180     if($inAnnotation) {
 181         return;
 182     }
 183
 184     if($schemaHackMode and $s =~ m/(^|:)annotation$/) {
 185         $inAnnotation = 1;
 186         $textContent = '';
 187         $lastTag = 1;
 188         return;
 189     }
 190     if (length($output)) {
 191         $output .= "\n";
 192     }
 193
 194     $output .= "  " x $indent;
 195     $output .= "<$s";
 196     my @k = keys %attr;
 197
 198     if ($sortAttributes && (scalar(@k) > 1) ){
 199
 200       my @alphaSorted;
 201       my @needSpecialSort;
 202       my @final;
 203       my $isSpecial;
 204
 205       # sort attributes alphabetically (default ordering)
 206       @alphaSorted = sort @k;
 207
 208       # read through sorted list, if attribute doesn't have specified
 209       # sort order, push it onto the end of the final array (this maintains
 210       # alphabetic order). Else create a list that has attributes needing
 211       # special ordering.
 212       foreach $attribute (@alphaSorted){
 213         $isSpecial = 0;
 214         foreach $sortAttrib (@specialSort){
 215           if ($attribute eq $sortAttrib){
 216             push @needSpecialSort, $attribute;
 217             $isSpecial = 1;
 218           }
 219         }
 220         if (!$isSpecial){
 221           push @final, $attribute;
 222         }
 223       }
 224
 225       # now read through the specialSort list backwards looking for
 226       # any match in the needSpecialSort list. Unshift this onto the
 227       # front of the final array to maintain proper order.
 228       foreach my $attribute (reverse @specialSort){
 229         foreach (@needSpecialSort){
 230           if ($attribute eq $_){
 231             unshift @final, $attribute;
 232           }
 233         }
 234       }
 235
 236       @k = @final;
 237     }
 238
 239     foreach my $attr (@k) {
 240         #
 241         # Remove (min|max)Occurs = 1 if schemaHackMode
 242         #
 243         if ($schemaHackMode and $attr =~ m/^(minOccurs|maxOccurs)$/ and $attr{$attr} eq "1") {
 244             next;
 245         }
 246
 247         if ($splitAttributes) {
 248             $output .= "\n"."  " x $indent." ";
 249         }
 250         if ($attr{$attr} =~ /'/) {
 251             $output .= " $attr=\"$attr{$attr}\"";
 252         } else {
 253             $output .= " $attr='$attr{$attr}'";
 254         }
 255     }
 256     if ($splitAttributes and @k) {
 257         $output .= "\n"."  " x $indent;
 258     }
 259     if ($selfclose) {
 260         $output .= " />";
 261         $lastTag = 0;
 262     } else {
 263         $output .= ">";
 264         $indent++;
 265         $lastTag = 1;
 266     }
 267     $textContent = '';
 268 }
 269
 270 sub parseEnd {
 271     my $s = shift;
 272
 273     if($inAnnotation) {
 274         if($s =~ m/(^|:)annotation$/) {
 275             $inAnnotation = 0;
 276         }
 277         return;
 278     }
 279
 280     if($normaliseWhiteSpace) {
 281         $textContent =~ s/^\s*(.*?)\s*$/$1/;
 282     }
 283     $indent--;
 284     printContent($textContent);
 285     if ($lastTag == 0) {
 286         $output .= "\n";
 287         $output .= "  " x $indent;
 288     }
 289     $output .= "</$s>";
 290     $textContent = '';
 291     $lastTag = 0;
 292 }
 293
 294 sub parseDefault {
 295     my $s = shift;
 296     if($inAnnotation) { return }
 297     $textContent .= "$s";
 298 }
 299
 300 sub parsePI {
 301     my $s = shift;
 302     $output .= "$s";
 303 }
 304
 305 sub parseDoctype {
 306     my $s = shift;
 307     if ($s =~ /^([^\[]*\[)([^\]]*)(\].*)$/ms) {
 308       $start = $1;
 309       $DTD = $2;
 310       $finish = $3;
 311       $DTD =~ s/\</\n  \</msg;
 312       $output .= "$start$DTD\n$finish\n";
 313     } else {
 314       $output .= "$s";
 315     }
 316 }
 317
 318 sub parseComment {
 319     my $s = shift;
 320     if($inAnnotation) { return }
 321     printContent($textContent,1);
 322     if ($s =~ /([^\<]*)(<.*>)(.*)/ms) {
 323       $start = $1;
 324       $xml = $2;
 325       $finish = $3;
 326       $xml =~ s/\</\n\</msg;
 327       $xml =~ s/(\n\s*\n?)+/\n/msg;
 328       $xml =~ s/^\s*//msg;
 329       $xml =~ s/\s*$//msg;
 330       $s = "$start\n$xml\n$finish";
 331     }
 332     $s =~ s/\n\s*$/\n  /msg;
 333     if ($newLineComments) {
 334         $output .= "\n<!--$s-->\n";
 335     } else {
 336         $output .= "<!--$s-->";
 337     }
 338     $textContent='';
 339 }
 340
 341 sub printContent {
 342     my $s = shift;
 343     my $printLF = shift;
 344     my ($LF,$ret) = ("","");
 345
 346     if ($s =~ m/\n\s*$/) {
 347         $LF = "\n";
 348     }
 349     if ($s =~ m/^[\s\n]*$/) {
 350         $ret = undef;
 351     } else {
 352         $output .= "$s";
 353         $ret = 1;
 354     }
 355     if ($printLF) {
 356         $output .= $LF;
 357     }
 358 }
 359
 360
 361 sub html_escape {
 362     my $s = shift;
 363     $s =~ s/&/&amp;/gsm;
 364     $s =~ s/</&lt;/gsm;
 365      $s =~ s/>/&gt;/gsm;
 366     return $s;
 367 }
 368
 369 sub open_next_file {
 370     my $filename = shift;
 371     $$filename = shift @ARGV;
 372     while ($$filename and ! -f $$filename) {
 373         print STDERR "WARNING: Could not find file: $$filename\n";
 374         $$filename = shift @ARGV;
 375     }
 376     if(!$$filename) {
 377         return undef;
 378     }
 379     my $fh = new FileHandle;
 380     $fh->open("< $$filename") or die "Can't open $$filename: $!";
 381     return $fh;
 382 }
 383
 384 sub usage {
 385     print STDERR <<EOF;
 386 usage: $0 [ options ] [ file.xml ... ]
 387
 388 options:
 389   -h  display this help message
 390   -H  escape characters (useful for further processing)
 391   -t  split attributes, one per line (useful for diff)
 392   -s  sort attributes (useful for diff)
 393   -z  in place edit (zap)
 394   -e  expand self closing tags (useful for diff)
 395   -S  schema hack mode (used by xmldiff)
 396   -c  place comments on new line.
 397   -n  normalise whitespace (remove leading and trailing whitespace from nodes
 398       with text content.
 399
 400 EOF
 401     exit 1;
 402 }
 403