devtools/highlight_template.pl

   1 #!/usr/bin/env perl
   2 eval '(exit $?0)' && eval 'exec perl -w -S $0 ${1+"$@"}'
   3     & eval 'exec perl -w -S $0 $argv:q'
   4     if 0;
   5
   6 # ******************************************************************
   7 #      Author: Chad Elliott
   8 #        Date: 2/16/2006
   9 # ******************************************************************
  10
  11 # ******************************************************************
  12 # Pragma Section
  13 # ******************************************************************
  14
  15 use strict;
  16 use FileHandle;
  17 use FindBin;
  18 use File::Spec;
  19 use File::Basename;
  20
  21 my $basePath = $FindBin::Bin;
  22 if ($^O eq 'VMS') {
  23   $basePath = File::Spec->rel2abs(dirname($0)) if ($basePath eq '');
  24   $basePath = VMS::Filespec::unixify($basePath);
  25 }
  26 $basePath = dirname($basePath);
  27 unshift(@INC, $basePath . '/modules');
  28
  29 require ProjectCreator;
  30 require TemplateParser;
  31
  32 # ******************************************************************
  33 # Data Section
  34 # ******************************************************************
  35
  36 my %keywords;
  37 my %arrow_op;
  38 my $ifmod     = 0;
  39 my $formod    = 0;
  40 my $cmod      = 50;
  41 my %keycolors = (0 => [160, 32, 240],
  42                  1 => [255, 50, 50],
  43                  2 => [50, 50, 255],
  44                 );
  45 my $version   = '1.3';
  46
  47 # ******************************************************************
  48 # Subroutine Section
  49 # ******************************************************************
  50
  51 sub setup_keywords {
  52   ## Get the main MPC keywords
  53   my $keywords = ProjectCreator::getKeywords();
  54   foreach my $key (keys %$keywords) {
  55     $keywords{$key} = 0;
  56   }
  57
  58   ## Get the pseudo template variables
  59   my $pjc = new ProjectCreator();
  60   $keywords = $pjc->get_command_subs();
  61   foreach my $key (keys %$keywords) {
  62     $keywords{$key} = 0;
  63   }
  64
  65   ## Get the template function names
  66   $keywords = TemplateParser::getKeywords();
  67   foreach my $key (keys %$keywords) {
  68     $keywords{$key} = 0;
  69   }
  70
  71   ## Get the template parser arrow operator keys
  72   $keywords = TemplateParser::getArrowOp();
  73   foreach my $key (keys %$keywords) {
  74     $arrow_op{$key} = 0;
  75   }
  76
  77   ## These TemplateParser keywords need special values so
  78   ## that the color coding will recognize these as different
  79   ## from the rest of the keywords
  80   foreach my $key ('if', 'else', 'endif') {
  81     $keywords{$key} = 1;
  82   }
  83   foreach my $key ('foreach', 'forfirst',
  84                    'fornotfirst', 'fornotlast', 'forlast', 'endfor') {
  85     $keywords{$key} = 2;
  86   }
  87 }
  88
  89
  90 sub convert_to_html {
  91   my $line = shift;
  92   $line =~ s/&/&amp;/g;
  93   $line =~ s/</&lt;/g;
  94   $line =~ s/>/&gt;/g;
  95   $line =~ s/"/&quot;/g;
  96   $line =~ s/ /&nbsp;/g;
  97   $line =~ s/\t/&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;/g;
  98   $line =~ s/\n/<br>/;
  99   return $line;
 100 }
 101
 102
 103 sub usageAndExit {
 104   print "highlight_template.pl v$version\n",
 105         "Usage: ", basename($0), " <template> [html output]\n\n",
 106         "This script will color highlight the template provided using\n",
 107         "varying colors for the different keywords, variables and text.\n",
 108         "Nested if's and foreach's will have slightly different colors.\n";
 109   exit(0);
 110 }
 111
 112 # ******************************************************************
 113 # Main Section
 114 # ******************************************************************
 115
 116 my $status = 0;
 117 my $fh     = new FileHandle();
 118 my $input  = $ARGV[0];
 119 my $output = $ARGV[1];
 120
 121 usageAndExit() if (!defined $input || $input =~ /^-/);
 122
 123 if (!defined $output) {
 124   $output = $input;
 125   $output =~ s/\.mpd$//;
 126   $output .= '.html';
 127 }
 128
 129 if (open($fh, $input)) {
 130   setup_keywords();
 131
 132   my $deftxt = 'black';
 133   my @codes;
 134   while(<$fh>) {
 135     my $len = length($_);
 136     for(my $start = 0; $start < $len;) {
 137       my $sindex = index($_, '<%', $start);
 138       if ($sindex >= 0) {
 139         my $left = substr($_, $start, $sindex - $start);
 140         if ($left ne '') {
 141           push(@codes, [$deftxt, $left]);
 142         }
 143         my $eindex = index($_, '%>', $sindex);
 144         if ($eindex >= $sindex) {
 145           $eindex += 2;
 146         }
 147         else {
 148           $eindex = $len;
 149         }
 150
 151         my $part  = substr($_, $sindex, $eindex - $sindex);
 152         my $key   = substr($part, 2, length($part) - 4);
 153         my $name  = $key;
 154         my $color = 'green';
 155         my @entry;
 156         if ($key =~ /^([^\(]+)\(.*\)/) {
 157           $name = $1;
 158           if (defined $keywords{$name}) {
 159             @entry = @{$keycolors{$keywords{$1}}};
 160           }
 161         }
 162         elsif (defined $keywords{$key}) {
 163           @entry = @{$keycolors{$keywords{$key}}};
 164         }
 165         else {
 166           foreach my $ao (keys %arrow_op) {
 167             if ($key =~ /^$ao/) {
 168               @entry = @{$keycolors{$arrow_op{$ao}}};
 169               last;
 170             }
 171           }
 172         }
 173
 174         if (defined $entry[0]) {
 175           if ($name eq 'if') {
 176             $ifmod++;
 177             $entry[0] -= ($cmod * ($ifmod - 1));
 178           }
 179           elsif ($name eq 'endif') {
 180             $entry[0] -= ($cmod * ($ifmod - 1));
 181             $ifmod-- if ($ifmod > 0);
 182           }
 183           elsif (defined $keywords{$name} &&
 184                  $keywords{$name} == $keywords{'if'}) {
 185             $entry[0] -= ($cmod * ($ifmod - 1));
 186           }
 187           elsif ($name eq 'foreach') {
 188             $formod++;
 189             $entry[2] -= ($cmod * ($formod - 1));
 190           }
 191           elsif ($name eq 'endfor') {
 192             $entry[2] -= ($cmod * ($formod - 1));
 193             $formod-- if ($formod > 0);
 194           }
 195           elsif (defined $keywords{$name} &&
 196                  $keywords{$name} == $keywords{'foreach'}) {
 197             $entry[2] -= ($cmod * ($formod - 1));
 198           }
 199           foreach my $entry (@entry) {
 200             $entry = 0 if ($entry < 0);
 201           }
 202           $color = '#' . sprintf("%02x%02x%02x", @entry);
 203         }
 204
 205         push(@codes, [$color, $part]);
 206         $start = $eindex;
 207       }
 208       else {
 209         my $part = substr($_, $start, $len - $start);
 210         push(@codes, [$deftxt, $part]);
 211         $start += ($len - $start);
 212       }
 213     }
 214   }
 215   close($fh);
 216
 217   if (open($fh, ">$output")) {
 218     print $fh "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\">\n",
 219               "<html><head><title>", basename($input), "</title></head>\n",
 220               "<body>\n";
 221     foreach my $code (@codes) {
 222       $$code[1] = convert_to_html($$code[1]);
 223       my $newline = ($$code[1] =~ s/<br>//);
 224       print $fh ($$code[1] ne '' ?
 225                    "<font color=\"$$code[0]\">$$code[1]</font>" : ''),
 226                 ($newline ? "<br>\n" : '');
 227     }
 228     print $fh "</body></html>\n";
 229   }
 230   else {
 231     print STDERR "ERROR: Unable to open $output for writing\n";
 232     ++$status;
 233   }
 234 }
 235 else {
 236   print STDERR "ERROR: Unable to open $input for reading\n";
 237   ++$status;
 238 }
 239
 240 exit($status);
 241