addheader.pl to HTML.

index -|- end

Generated: Tue Feb 2 17:54:17 2010 from addheader.pl 2007/04/11 5.9 KB.

#!/perl -w
# NAME: addheader.pl
# AIM: To insert a block of text into the head of a C/C++ file
# geoff mclane - http://geoffmclane.com/mperl/index.htm
#
use strict;
use warnings;
use File::Basename;
require 'logfile.pl' or die "Unable to load logfile.pl ...\n";
# log file stuff
my ($LF);
my $outfile = 'temp.'.$0.'.txt';
if ($0 =~ /\w{1}:\\.*/) {
   my @tmpsp = split(/\\/,$0);
   $outfile = 'temp.'.($tmpsp[-1]).'.txt';
}
open_log($outfile);
prt( "$0 ... Hello, World ...\n" );
my $recursive = 0;
my $in_folder = "test";
my $headln = "// Public Domain s/w - NO WARRANTY IMPLIED!";
my $header = <<EOF;
// ****************************************
//  REVISION LOG ENTRY
//  Revision By: Geoff R. McLane - http://geoffmclane.com/ms/index.htm
//  Revised on 11/04/2007 04:00
//  Comments: First release
// ****************************************
EOF
my @file_list = ();
my @folders = ();
my @excl_list = qw( _derived _private _vti_cnf _vti_pvt );
my $fcnt = 0;
my $file = '';
parse_args( @ARGV );
$fcnt = process_directory( $in_folder, 0 );
if ($fcnt == 0) {
   prt( "WARNING: Failed to find any files in $in_folder ...\n" );
} else {
   prt( "Processing $fcnt files from $in_folder ...\n" );
}
foreach $file (@file_list) {
   process_file( $file );
}
prt( "Done $fcnt files from $in_folder ...\n" );
close_log($outfile,1);
exit(0);
#################################
### subs
sub sub_main {
   my ($f) = shift;
   return substr($f, length($in_folder) + 1);
}
sub is_my_file {
   my ($fil) = shift;
   my ($nm,$dir,$ext) = fileparse( $fil, qr/\.[^.]*/ );
   if ($ext =~ /^\.c/i) {
      return 1;
   } elsif ($ext =~ /^\.cpp/i) {
      return 2;
   } elsif ($ext =~ /^\.cxx/i) {
      return 3;
   } elsif ($ext =~ /^\.h/i) {
      return 4;
   } elsif ($ext =~ /^\.hxx/i) {
      return 5;
   } elsif ($ext =~ /^\.hpp/i) {
      return 6;
   }
   return 0;
}
sub process_directory { ## $in_folder
   my ($inf, $lev) = @_;
   my $rcnt = 0;
   my ($DH);
   if ( !opendir($DH, $inf) ) {
      prt( "ERROR: Unable to OPEN FOLDER [$inf] ... $! ... \n" );
      return $rcnt;
   }
   my @files = readdir($DH);
   closedir $DH;
   my $fcnt = scalar @files;
   prt( "Have $fcnt to process from $inf ...\n" );
   foreach my $file (@files) {
      if (($file eq '.') || ($file eq '..')) {
         next;
      }
      my $ff = $inf . "\\" . $file;
      if (-d $ff) {
         if ($recursive) {
            if (in_excl_list($file)) {
               push(@folders, sub_main($ff));
            }
            $rcnt += process_directory( $ff, $lev + 1 );
         }
      } else {
         # is a FILE
         if ( is_my_file($file) ) {
            push(@file_list, $ff);
            $rcnt++;
         }
      }
   }
   return $rcnt;
}
sub process_file {
   my ($fil) = shift;
   my ($ic, $gh, $i, $max, $i2);
   my @lines = ();
   my ($FH);
   my $line = '';
   my $cnt = 0;
   if ( ! open $FH, "<$fil" ) {
      prt( "ERROR: Failed to OPEN $fil ... $! ... \n" );
      return;
   }
   @lines = <$FH>;
   close $FH;
   $max = scalar @lines;
   prt( "Processing $max lines of $fil ...\n" );
   $cnt = 0;
   $ic = 0;
   $gh = 0;
   #foreach $line (@lines) {
   for ($i = 0; $i < $max; $i++) {
      $cnt++;
      $line = trimall( $lines[$i] );
      # skip blank lines, and
      # initial comments to find insertion point
      # Also determine is the $headln needs be inserted
      if (length($line)) {
         if ($line =~ /\s*\/\/(.*)/ ) {
            # skip this comment line
            $line = trimall( $1 );
            if ($line =~ /^Public\s+Domain.*/i) {
               $gh = $cnt;   # mark PD header
               prt( "At $cnt - Found Public Domain ... [$line] ...\n" );
            } elsif ( $line =~ /^\*\*\*\*\*\*\*/ ) {
               prt( "At $cnt - Looks like the start of REVISION block ...\n" );
               $i2 = $i + 1;   # check next line
               $line = trimall( $lines[$i2] );
               if ($line =~ /^\s*\/\/\s*REVISION\s+LOG\s+ENTRY/) {
                  $ic = $cnt;
                  prt( "At $cnt - Found previous revision ... [$line] ...\n" );
                  last;
               } else {
                  prt( "At $cnt - Oops not start of REVISION block ...\n" );
               }
            }
         } else {
            # not a comment
            $ic = $cnt;
            prt( "At $cnt - Found insertion point ... [$line] ...\n" );
            last;
         }
      }
   }
   if ($ic == 0) {
      prt( "WARNING: Failed to find header insert line ...\n" );
      return;
   }
   rename_2_old_bak( $fil );
   if (! open $FH, ">$fil" ) {
      prt( "ERROR: Failed to CREATE $fil ... $! ... \n" );
      return;
   }
   $cnt = 0;   # restart counter
   for ($i = 0; $i < $max; $i++) {
      $cnt++;
      $line = $lines[$i];
      if ($cnt == $ic) {
         if ($gh == 0) {
            print $FH "$headln\n";
            prt( "At $cnt - Inserting ... [$headln] ...\n" );
         }
         prt( "At $cnt - Inserting revision block ...\n" );
         print $FH $header;
      }
      print $FH "$line";
   }
   close $FH;
}
# RENAME A FILE TO .OLD, or .BAK
# 0 - do nothing if file does nto exist.
# 1 - rename to .OLD if .OLD does NOT exist
# 2 - rename to .BAK, if .OLD already exists,
# 3 - deleting any previous .BAK ...
sub rename_2_old_bak {
   my ($fil) = shift;
   my $ret = 0;
   if ( -f $fil ) {
      my ($nm,$dir,$ext) = fileparse( $fil, qr/\.[^.]*/ );
      my $nmbo = $dir . $nm . '.old';
      $ret = 1;
      if ( -f $nmbo) {
         $ret = 2;
         $nmbo = $dir . $nm . '.bak';
         if ( -f $nmbo ) {
            $ret = 3;
            unlink $nmbo;
         }
      }
      rename $fil, $nmbo;
   }
   return $ret;
}
sub trimall {
   my ($ln) = shift;
   chomp $ln;         # remove CR (\n)
   $ln =~ s/\r$//;      # remove LF (\r)
   $ln =~ s/\t/ /g;   # TAB(s) to a SPACE
   while ($ln =~ /\s\s/) {
      $ln =~ s/\s\s/ /g;   # all double space to SINGLE
   }
   while ($ln =~ /^\s/) {
      $ln = substr($ln,1); # remove all LEADING space
   }
   while ($ln =~ /\s$/) {
      $ln = substr($ln,0, length($ln) - 1); # remove all TRAILING space
   }
   return $ln;
}
sub parse_args {
   my @av = @_;
   while (@av) {
      my $arg = shift @av;
   }
}
sub in_excl_list {
   my ($d) = shift;
   foreach my $ed (@excl_list) {
      if (lc($d) eq lc($ed)) {
         return 1;
      }
   }
   return 0;
}
sub parse_args {
   my @av = @_;
   while (@av) {
      my $arg = shift @av;
      $in_folder = $arg;
   }
}
# eof - addheader.pl

index -|- top

checked by tidy  Valid HTML 4.01 Transitional