View of /trunk/webwork/system/scripts/pb_new.pl

    1 #!/usr/local/bin/perl
    2 
    3 
    4 # 'pb_new' Perl Beautifier
    5 
    6 
    7 
    8 # Written by P. Lutus Ashland, Oregon lutusp@arachnoid.com 5/20/96
    9 
   10 # slight changes by A. Pizer (apizer@math.rochester.edu) 10/2/97
   11 
   12 
   13 
   14 # This script processes Perl scripts, cleans up and indents, like cb does
   15 
   16 for C
   17 
   18 
   19 
   20 # Be careful with this script - it accepts wildcards and processes every
   21 
   22 text file
   23 
   24 # that meets the wildcard criteria. This could be a catastrophe in the
   25 
   26 hands of the unwary.
   27 
   28 
   29 
   30 $tabstring = "    "; # You may place any tab-stop characters you want here
   31 
   32       # Pizer changed this to 4 spaces
   33 
   34 
   35 
   36 if($ARGV[0] eq "") {
   37 
   38   print "usage: file1 file2 etc. or wildcards (replaces originals in
   39 
   40 place)\n";
   41 
   42 }
   43 
   44 else {
   45 
   46   foreach $filename (@ARGV) {
   47 
   48     if(-T $filename) {
   49 
   50       &process($filename);
   51 
   52     }
   53 
   54   }
   55 
   56 }
   57 
   58 
   59 
   60 sub process {
   61 
   62   $fn = $_[0];
   63 
   64   undef $/; # so we can grab the entire file at once
   65 
   66   undef @infa; # prevent left-overs
   67 
   68   print STDERR "$fn";
   69 
   70   open (INFILE,$fn);
   71 
   72   @infa = split(/\n/,<INFILE>);
   73 
   74   close INFILE;
   75 
   76 
   77 
   78   $/ = "\n"; # restore default
   79 
   80 
   81 
   82   open (OUTFILE,">$fn");
   83 
   84   $tabtotal = 0;
   85 
   86   for (@infa) {
   87 
   88 
   89 
   90   unless ($_ =~/^\s*#/){   #Pizer  changed this to ignore comment lines
   91 
   92         s/^\s*(.*?)\s*$/$1/; # strip leading and trailing spaces
   93 
   94     }
   95 
   96     $a = $_; # copy original string
   97 
   98     $q = $a; # i plan to modify this copy for testing
   99 
  100     $q =~ s/\\\#//g; # remove escaped comment tokens
  101 
  102     $q =~ s/\#.*?$//g; # remove Perl-style comments
  103 
  104     $q =~ s{/\*.*?\*/} []gsx; # remove C-style comments
  105 
  106     $q =~ s/\\\{//g; # remove escaped left  braces
  107 
  108     $q =~ s/\\\}//g; # remove escaped right braces
  109 
  110     $q =~ s/\\\(//g; # remove escaped left  parentheses
  111 
  112     $q =~ s/\\\)//g; # remove escaped right parentheses
  113 
  114 
  115 
  116     $q =~ s/\'.*?\'//g; # remove single-quoted lines
  117 
  118 
  119 
  120 # now the remaining braces/parentheses should be structural
  121 
  122 
  123 
  124     $delta = -($q =~ s/\}/\}/g); # subtract closing braces
  125 
  126     $delta += ($q =~ s/\{/\{/g); # add opening braces
  127 
  128 
  129 
  130     $delta -= ($q =~ s/\)/\)/g); # subtract closing parens
  131 
  132     $delta += ($q =~ s/\(/\(/g); # add opening parens
  133 
  134 
  135 
  136     $tabtotal += ($delta < 0)?$delta:0; # subtract closing braces/parentheses
  137 
  138 
  139 
  140     $i = ($tabtotal > 0)?$tabtotal:0; # create tab index
  141 
  142 
  143 
  144     $tabtotal += ($delta>0)?$delta:0; # add opening braces/parentheses for
  145 
  146 next print
  147 
  148 
  149 
  150     unless ($a =~/^\s*#/) { # don't tab comments Pizer change
  151 
  152       print OUTFILE $tabstring x $i; # "tab" out to position
  153 
  154     }
  155 
  156     print OUTFILE "$a\n"; # print original line
  157 
  158   } # -- for (@infa)
  159 
  160 
  161 
  162   close OUTFILE;
  163 
  164 
  165 
  166   if($tabtotal != 0) {
  167 
  168     print STDERR " Indentation error: $tabtotal\n";
  169 
  170   }
  171 
  172   else {
  173 
  174     print STDERR "\n";
  175 
  176   }
  177 
  178 } # sub process
  179