Generated: Sun Apr 15 11:45:53 2012 from chkdbgon.pl 2011/11/04 7.7 KB.
#!/usr/bin/perl -w # NAME: chkdbgon.pl # AIM: VERY SPECIFIC : Check all perl scripts for my $debug_on NOT 0 # 04/11/2011 - Do a special check on file in the LIST FILE, if file 'tempzl2.txt' # if available. This is generated by the zipamupd.bat file... # 24/08/2010 geoff mclane http://geoffair.net/mperl use strict; use warnings; use File::Basename; # split path ($name,$dir,$ext) = fileparse($file [, qr/\.[^.]*/] ) use Cwd; use File::stat; # to get the file date and size my $perl_dir = 'C:\GTools\perl'; unshift(@INC, $perl_dir); require 'logfile.pl' or die "Unable to load logfile.pl ...\n"; # log file stuff my ($LF); my $pgmname = $0; if ($pgmname =~ /\w{1}:\\.*/) { my @tmpsp = split(/\\/,$pgmname); $pgmname = $tmpsp[-1]; } my $outfile = $perl_dir."\\temp.$pgmname.txt"; open_log($outfile); # user variables my $load_log = 0; my $in_file = ''; my $list_file = 'tempzl2.txt'; my %checklist = (); my $special_count = 0; ### program variables my @warnings = (); my $cwd = cwd(); my $os = $^O; my $min_fil_len = 0; sub prtw($) { my ($tx) = shift; $tx =~ s/\n$//; prt("$tx\n"); push(@warnings,$tx); } sub show_warnings() { if (@warnings) { prt( "\nGot ".scalar @warnings." WARNINGS...\n" ); foreach my $itm (@warnings) { prt("$itm\n"); } prt("\n"); } else { ###prt( "\nNo warnings issued.\n\n" ); } } sub pgm_exit($$) { my ($val,$msg) = @_; show_warnings(); if (length($msg)) { $msg .= "\n" if (!($msg =~ /\n$/)); prt($msg) } close_log($outfile,$load_log); exit($val); } sub begins_with { my ($rt, $pt) = @_; my $ln = length($rt); my ($i); if (length($pt) >= $ln) { for ($i = 0; $i < $ln; $i++) { return 0 if (substr($rt,$i,1) ne substr($pt,$i,1)); } return 1; # does indeed begin with... } return 0; } # VARIOUS FIXES FOR THE FILE NAME # 1. ensure ALL DOS format # 2. remove any simple dot relative, like '.\' from beginning # 3. if given a FULL PATH name, remove C:\FG\20\FlightGear # 4. if a relative name, remove FligthGear # 5. if any removal, ensure any beginning '\' is removed sub sub_root_dir($) { my ($ff) = shift; # = $a_dir.$src $ff = path_u2d($ff); my $rd = $perl_dir; $rd .= "\\" if (!($rd =~ /(\\|\/)$/)); $rd = path_u2d($rd); if (begins_with($rd, $ff)) { $ff = substr($ff, length($rd)); } return $ff; } sub scan_directory($) { my $dir = shift; if (!opendir(DIR,$dir)) { pgm_exit(1,"ERROR: Unable to opendir [$dir]!\n Check name, location, and FIX this script!\n"); } my @files = readdir(DIR); closedir(DIR); my @perl = (); my ($file,$ff,$fcnt); $fcnt = 0; $dir .= "\\" if (!($dir =~ /(\\|\/)$/)); prt("Processing directory [$dir]... moment... "); foreach $file (@files) { next if (($file eq '.')||($file eq '..')); $ff = $dir.$file; next if (-d $ff); if ($file =~ /\.pl$/i) { push(@perl,$ff); $fcnt++; } } prt("got $fcnt perl script names...\n"); return \@perl; } # My particular time 'translation' - replaced date_string #sub YYYYMMDD($) { sub DDMMYYYY($) { # 0 1 2 3 4 5 6 7 8 my ($tm) = shift; my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($tm); $year += 1900; $mon += 1; my $dmy = ''; if ($mday < 10) { $dmy .= '0'.$mday; } else { $dmy .= "$mday"; } $dmy .= ':'; if ($mon < 10) { $dmy .= '0'.$mon; } else { $dmy .= "$mon"; } $dmy .= ":$year"; return $dmy; } # Load and scan each script # Make NOISE is $debug_on is ON, AND that file is in the %checklist sub scan_scripts($) { my $ra = shift; my ($file,$lncnt,@lines,$line,$num,$dnfile); my $tot = scalar @{$ra}; # prt("Scanning $tot scripts... showing only thos with \$debug_on = >0...\n"); my $cnt = 0; my $oncnt = 0; my ($sfil,$sb,$dtt,$cnts,$i,$len,$lnn,$msg); my @found = (); # process each script found # ========================= foreach $file (@{$ra}) { $cnt++; if (open INF,"<$file") { @lines = <INF>; close INF; $lncnt = scalar @lines; $dnfile = 0; $dtt = ''; if ($sb = stat($file)) { $dtt = DDMMYYYY($sb->mtime); } $sfil = sub_root_dir($file); $lnn = 0; foreach $line (@lines) { chomp $line; $lnn++; if ($line =~ /^\s*my\s+\$debug_on\s*=\s*(\d+)/) { $num = $1; if ($num > 0) { $cnts = sprintf("%4d of %4d", $cnt, $tot); $dnfile++; $line =~ s/\#.*$//; $oncnt++; push(@found, [$cnts, $sfil, $dtt, $line, $lnn]); } } } } } prt("Found $oncnt files, of $tot HAVE \$debug_on ON!\n") if ($oncnt); for ($i = 0; $i < $oncnt; $i++) { $sfil = $found[$i][1]; $len = length($sfil); $min_fil_len = $len if ($len > $min_fil_len); } my @checkfound = (); for ($i = 0; $i < $oncnt; $i++) { $cnts = $found[$i][0]; $sfil = $found[$i][1]; $dtt = $found[$i][2]; $line = $found[$i][3]; $lnn = $found[$i][4]; $msg = ''; if (defined $checklist{$sfil}) { $msg = " CHECK ME"; push(@checkfound,$sfil); } $sfil .= ' ' while (length($sfil) < $min_fil_len); $dtt .= ' ' while (length($dtt) < 10); prt("$cnts: $dtt $sfil $lnn $line $msg\n"); } if (@checkfound) { $cnts = scalar @checkfound; prtw("WARNING: Of $special_count check list $cnts found ON! ".join(' ',@checkfound).";=((\n"); } elsif ($special_count) { prt("NONE of $list_file check list $special_count files have debug_on. Happiness ;=))\n"); } return $oncnt; } sub load_check_list() { # fill in my %checklist = (); my $missed_list = ''; my $dupe_list = ''; if (open INF, "<$list_file") { my @lines = <INF>; close INF; my ($line,$cnt,$missed,$dupes); $cnt = 0; $missed = 0; foreach $line (@lines) { chomp $line; if (-f $line) { if (defined $checklist{$line}) { $dupes++; $dupe_list .= "$line "; } else { $checklist{$line} = 1; $cnt++; $special_count++; } } else { $missed++; $missed_list .= "$line "; } } if ($cnt) { if ($dupes) { prtw("WARNING: $dupes duplicate names found in $list_file! $dupe_list\n"); } if ($missed) { prtw("WARNING: $missed file names found in $list_file! $missed_list\n"); } prt("Paying special attention to $cnt files from $list_file.\n"); } else { prtw("WARNING: No files found in $list_file!\n"); } } else { prtw("WARNING: Unable to OPEN $list_file!\n"); } } ######################################### ### MAIN ### load_check_list() if (-f $list_file); my $ref_arr = scan_directory($perl_dir); my $exit_val = scan_scripts($ref_arr); pgm_exit($exit_val,""); ######################################## # eof - chkdbgon.pl