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