Generated: Tue Feb 2 17:54:39 2010 from gendbglist.pl 2009/10/23 2.2 KB.
#!/perl -w # NAME: gendbglist.pl # AIM: VERY SPECIFIC - generate a perl debug stg block # 2009/10/23 - geoff mclane - http://geoffair.net/mperl/ use strict; use warnings; use File::Basename; use Cwd; unshift(@INC, 'C:\GTools\perl'); 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 $perl_dir = 'C:\GTools\perl'; my $outfile = $perl_dir."\\temp.$pgmname.txt"; open_log($outfile); # user variables my $load_log = 1; ### program variables my @warnings = (); my $cwd = cwd(); my $in_file = 'gendbglist.txt'; sub pgm_exit($$) { my ($val,$msg) = @_; if (length($msg)) { $msg .= "\n" if (!($msg =~ /\n$/)); prt($msg) } close_log($outfile,$load_log); exit($val); } 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 process_file($) { my ($fil) = @_; if (open INF, "<$fil") { my @lines = <INF>; close INF; my $lncnt = scalar @lines; prt( "Processing $lncnt lines...\n" ); my ($line,$itm,$val,$rem); foreach $line (@lines) { $line = trim_all($line); if ($line =~ /^my\s+\$dbg_(.+)\s*=\s*(\d+)\s*;(.*)$/) { $itm = trim_all($1); $val = $2; $rem = trim_all($3); $rem = "#" if ( !($rem =~ /^#/) ); prt( " if (\$dbg_$itm) { \$dbs .= \"$itm \"; } $rem\n" ); } } } else { prt( "ERROR: Unable to OPEN file [$fil]... $!...\n" ); pgm_exit(1,"ERROR: FILE NOT FOUND"); } } ######################################### ### MAIN ### prt( "$pgmname: in [$cwd]: Hello, World...\n" ); process_file($in_file); pgm_exit(0,"Normal exit(0)"); ######################################## # eof - gendbglist.pl