#!/usr/bin/perl -w
# add_debug_cgi.pl
# Meryll Larkin   March 1, 2013
# This script adds a "DEBUG" switch
#  before subroutines, then adds an HTML print statement
#  after each subroutine, containing the subroutine name.
#  Useful for debugging cgi scripts.
#  Manual tweaks will probably be necessary after 
#  running this script to
#    comment out the DEBUG lines that precede the HTML headers
#  These can be discovered by running the cgi script from 
#   the command line.
#  Original script will not be changed.  After you are 
#  satisfied that the DEBUGing was added correctly, 
#  you can rename the script with the DEBUGGING to the
#  original cgi script name.
#

use strict;

print "Provide name of script file: ";
chomp (my $input =<STDIN>);
my $output = $input . "_with_DEBUGGING";

open (IN, $input) || die "could not open $input " . $! . "\n";

open (OUT, ">>$output") || die "could not open $output " . $! . "\n";

my $presubflag = 1;
my $subflag = 0;
my $subname;
my $debug_line;

while (<IN>) {
    chomp (my $line = $_);
    # identify subroutines/functions
    if ($line =~ /^\s*sub\s+\w/) {
        if ($presubflag) {
            $presubflag = 0;
            print OUT qq|
# To debug, set \$DEBUG = 1.  For production, set \$DEBUG = 0
# my $DEBUG = 0;
# my $DEBUG = 1;
            |;
            print OUT "\n";
        }
        $subflag = 1;
        $subname = $line;
        $subname =~ s/^\s*sub\s+//;
        $subname =~ s/\s+{\s*$//;
        $subname =~ s/\s*$//;
        $debug_line = 'print "<br><b>' . $subname . ' subroutine</b><br>\n" if ($DEBUG);';
        print OUT "$line\n";
        next;
    }
    if ($subflag) {
        if (($line !~ /\w/) || ($line =~ /^\s*#/)) {
            print OUT "$line\n";
            next;
        }
        if (($line =~/\Wparam\W/) || ($line =~ /\Wshift\W/) || ($line =~ /\@_/)) {
            print OUT "$line\n";
            next;
        }
        # check to see that we don't alread have a DEBUG line
        if (($line =~/$subname/) && ($line =~ /DEBUG/)) {
            print OUT "$line\n";
            $subflag = 0;
        }
        # subflag is on, but none of those above conditions are met
        else {
            print OUT "    $debug_line\n";
            print OUT "$line\n";
            $subflag = 0;
        }
    # subflag is off
    } else {
        print OUT "$line\n";
        $subflag = 0;
    }
}

close IN;
close OUT;
print "Done.  Diff the output here:  diff $input $output\n";
exit (0);