gendbglist.pl to HTML.

index -|- end

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

index -|- top

checked by tidy  Valid HTML 4.01 Transitional