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