devtools/highlight_template.pl

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