#!/usr/bin/perl
# VBDebug
# Copyright (c) 1998 Peter Santoro

use strict;
use Cwd;
require 5.003;

my $VERSION = 1.01;

# Initialize variables

my $inputDirectory = ".";
my $outputDirectory = "vbdebug";
my $filename;
my @dirStack;

# validate input directory

if( @ARGV > 0 )
{
    $inputDirectory = $ARGV[0];
    die $0 . " error: invalid input directory " . $inputDirectory . "\n"  unless -d $inputDirectory;
}

# create output directory

push( @dirStack, Cwd::getcwd() );

chdir( $inputDirectory );
mkdir( $outputDirectory, 00666 );

if( ! ( -d $outputDirectory ) )
{
    chdir( pop( @dirStack ) );
    die $0 . " error: can't create output directory " . $inputDirectory . "\\" . $outputDirectory . "\n";
}

# loop through VB source files and insert VB debugging code

while ( $filename = < *.bas *.cls *.frm > )
{
    my $prompt = $inputDirectory . "\\" . $outputDirectory . "\\" . $filename . "\n";
    print( $prompt );
    
    open( INFILE, $filename );
    translateFile( $filename, $outputDirectory . "\\" . $filename );
    close( INFILE );
}

chdir( pop( @dirStack ) );

exit;

# ----------------------------------------------------------
    
sub translateFile($$)
{
    # translate source file
    
    my( $infile, $outfile ) = @_; # get parameters

    my $funcType;
	my $funcName;
    my $lineno = 0;
  
    open ( OUTFILE, ">$outfile" );
    
    while( $_ = <INFILE> )
    {
        print( OUTFILE $_ );
		$lineno++;
        
        if( atStartOfFuncOrSubOrProp( \$funcType, \$funcName ) )
        {
            outputProlog( $infile, $funcType, $funcName, \$lineno );
            locateEndOfFuncOrSubOrProp( \$lineno );
            outputEpilog( $infile, $funcType, $funcName, \$lineno );
        }    
    }
    
    close OUTFILE;
}

sub outputProlog($$$$)
{
    my( $infile, $functype, $funcname, $lineno ) = @_; # get parameters

    my $loc;

    $$lineno += 4;

    print( OUTFILE "\n#If fDebug Then\n" );
    print( OUTFILE "   If fTraceEnabled Then\n" );
    $loc = "[" . $infile . ":" . "$$lineno" . "] ";
    print( OUTFILE "      OutputDebugString\( \"" . $loc . "Entering ".$functype." ".$funcname."\" \+ chr\(10\) \)\;\n" );
    print( OUTFILE "   End If\n" );
    print( OUTFILE "#End If\n\n" );
    $$lineno += 3;
}

sub outputEpilog($$$$)
{
    my( $infile, $functype, $funcname, $lineno ) = @_; # get parameters

    my $loc;

    $$lineno += 4;

    print( OUTFILE "\n#If fDebug Then\n" );
    print( OUTFILE "   If fTraceEnabled Then\n" );
    $loc = "[" . $infile . ":" . "$$lineno" . "] ";
    print( OUTFILE "      OutputDebugString\( \"" . $loc . "Leaving ".$functype." ".$funcname."\" \+ chr\(10\) \)\;\n" );
    print( OUTFILE "   End If\n" );
    print( OUTFILE "#End If\n\n" );
    
    print( OUTFILE $_ ); # output last line of function, sub, or property
    $$lineno += 4;
}

sub locateEndOfFuncOrSubOrProp($)
{
    my( $lineno ) = @_; # get parameters

    $_ = <INFILE>;

    while( ! atEndOfFuncOrSubOrProp() )
    {
        print( OUTFILE $_ );
		$$lineno++;
        
        $_ = <INFILE>;
    }
}

sub atStartOfFuncOrSubOrProp($$)
{
    my @list;

    my( $functype, $funcname ) = @_; # get parameters

    if( $_ =~ /^\s*(Public|Private)\s+(Sub|Function|Property)/i )
    {
        @list = split( /\s+|\(/, $_);
        
        $$funcname = $list[2];
        $$functype = $list[1];
    
        1;
    }
    elsif( $_ =~ /^\s*(Sub|Function|Property)/i )
    {
        @list = split( /\s+|\(/, $_);

        $$funcname = $list[1];
        $$functype = $list[0];
    
        1;
    }
    else
    {
        0;
    }
}

sub atEndOfFuncOrSubOrProp()
{   
    if( $_ =~ /^\s*End\s+(Sub|Function|Property)/i )
    {
        1;
    }
    else
    {
        0;
    }
}

# ----------------------------------------------------------
__END__

=head1 NAME

VBDebug

=head1 DESCRIPTION

This script inserts trace statements into Visual Basic source code. It can be used to assist
the programmer with debugging Visual Basic applications.  At runtime, trace messages are sent
to VB's debugging window.  A future version may support logging to a file.

=head1 README

Please rename this distribution to VBDebug.pl before using.

Usage:

perl VBDebug.pl [VB-source-directory]

- if used, the optional parameter C<VB-source-directory> is the directory containing the VB
source code to be translated - otherwise the current directory is assumed

Notes:

This script was not designed to undo previous VBDebug translations.  Instead, it creates its
translated source C<*.BAS, *.CLS, *.FRM> files in a C<vbdebug> subdirectory.  Your original
source files are not modified.  This design is safer and was easier to implement (no undo required) than
the alternative which directly modifies your original source files.  Therefore, you should always run this
script against untranslated VB source code.  As a precaution, you might want to run this
script against a copy of your source files.

A conditional compilation variable C<fDebug> is used to control whether the inserted trace
statements will be compiled into your application.  In addition, the C<fTraceEnabled> boolean
is used to toggle tracing on or off at runtime.  You must add the C<fTraceEnabled> boolean to your
source code and enable the conditional compilation variable C<fDebug>.

This script has been tested with source code produced by Visual Basic 4.0 and 5.0.

Limitations of current release:

1. Script ignores Exit Sub, Exit Function, and Exit Property keyword combinations

2. Lacks support for logging to a file

=head1 PREREQUISITES

This script requires the C<strict> and C<Cwd> modules and C<Perl 5.003> or better.

=head1 OSNAMES

MSWin32

=head1 SCRIPT CATEGORIES

Win32
Win32/Utilities

=head1 VERSION

1.01

=head1 HISTORY

	Version 1.01
	------------
		- Updated documentation.

	Version 1.00
	------------
		- Released.


=head1 AUTHOR

Peter Santoro peter@pscomp.com

=head1 COPYRIGHT

Copyright (c) 1998 Peter Santoro.  All rights reserved.  This program is free software;
you can redistribute it and/or modify it under the same terms as Perl itself; however, you
must leave this copyright statement intact.

=head1 DATE

December 23, 1998

=head1 SOURCE

This distribution can also be found at the author's web site

http://www.connix.com/~psantoro/

=cut