#!C:/perl/bin/perl.exe
#
# Program: prod.pl
# Date:    1/17/2001
# Author:  Ovid
#
# Purpose: prod.pl is used to convert programs to a "productionized" version by commenting out
#          lines ending with "$lineTag" or between the "$startTag" and "$endTag".  Then, it's
#          written out to a destination directory. Default behavior is to backup the destination
#          file. The original files will NOT be touched.  Of course, the source and target 
#          directories should not be the same, or the "productionized" files will overwrite the
#          originals.
#
#          If a $lineTag is placed at the end of a line, it will be commented out when moved into 
#          production. A $startTag and an $endTag are used to delimit code that should be commented 
#          out for production. Nested tags and imbalanced tags are not allowed as intent can not 
#          be determined.
use strict;
use warnings;
use File::Copy;
use File::Find;
use File::Path;
use File::Basename;
use Getopt::Std;
use Win32::File; # Major portability problem :(
use Cwd qw/getcwd abs_path/;

# Please note that these tag values have been hardcoded into the POD.  If these values
# are altered, please update the POD at the end of this program.
my $lineTag  = quotemeta '#//';
my $startTag = quotemeta '#/*';
my $endTag   = quotemeta '#*/';

# The following makes for a very inefficient regex, but this program
# will not be run frequently.
my $extensions = join '|', qw( cgi pl pm );

# Use this to avoid copying self
my $thisProgram = basename( $0 );

# Current working directory
my $cwd = getcwd();

# This hash stores command line options
my %option;

# Set up source and target directories
my $sourceDir = '.';
my $targetDir = 'C:/WINNT/Profiles/cp/Desktop/target/realtarget';

validateEnvironment();

# Mirror the directory structure
find ( \&mirrorDirectories, $sourceDir );
print "\n\n";

# Here's where the real work gets done.
if ( $option{ a } ) {
    # Get (a)ll filenames recursively
	find ( \&process, $sourceDir );
} else {
    # We got here one of two ways:
    #  1.  Option C, which populates @ARGV
    #  2.  Files were specified on command line
	foreach my $file ( @ARGV ) {
		if ( -e $file and ! -d $file ) {
            # Only do it if it exists and is not a directory
			process( $file );
		}
	}
}

sub validateEnvironment {
    # They didn't tell us what to do.  Spank that puppy!
    if ( ! @ARGV ) {
    	&usage;
    	exit;
    }
    # Get the command line switches. See docs
    getopts( 'acd:DhHns:', \%option );

    $sourceDir = $option{ s } if exists $option{ s };
    $targetDir = $option{ d } if exists $option{ d };
    
    $sourceDir =~ s!/$!!; # If they supplied a trailing /, strip it
    $targetDir =~ s!/$!!;
    
    unless ( -d $sourceDir ) {
        die "$sourceDir does not appear to be a valid directory";
    }
    unless ( -d $targetDir ) {
        print "\n$targetDir does not appear to be a valid directory\n" .
              "Do you wish to create this directory (mkdir will fail if higher level directories do not exist)? ";
        my $response = <STDIN>;
        if ( $response =~ /^[yY]/ ) {
            mkdir $targetDir or die "Cannot mkdir $targetDir: $!";
        } else {
            print "\n-- Program terminating --\n";
            exit;
        }
    }
    
    if ( sameDirectory( $sourceDir, $targetDir ) ) {
        die "Source and target directories must not be the same!";
    }
    
    if ( @ARGV && ( exists $option{ a } or exists $option{ c } ) ) {
            print "\nYou appear to have specified files on the command line, but have also\n" .
                  "specified -a or -c.  Since these options determine the appropriate filenames\n" .
                  "your intention is unclear and the program is exiting.";
            exit;
    }
    
    if ( exists $option{ h } or exists $option{ H } ) {
        # They've asked for help
        &usage;
        exit;
    }
    
    # (a)ll directories and (c)urrent directory conflict.
    if ( exists $option{ a } and exists $option{ c } ) {
    	print "\nYou have specified both -a and -c options.\nPlease read the usage and correct.";
    	&usage;
    	exit;
    }
    
    if ( $option{ D } ) {
        print "You have asked to delete $targetDir and all subdirectories.\n\n" .
              "Are you sure you wish to do this? ";
        my $answer = <STDIN>;
        rmtree( $targetDir ) if $answer =~ /^[yY]/;
        print "\nRe-creating $targetDir\n";
        mkdir $targetDir or die "Cannot mkdir $targetDir: $!";
    }
    # Get all filenames in (c)urrent directory, overwriting @ARGV
    if ( exists $option{ c } ) {
	    opendir DIR, "." or die "Can't open current directory: $!";
    	@ARGV = readdir(DIR);
	    closedir DIR;
    }
}

sub process {
    my $fileName = $_ || shift;
    $fileName =~ s/\0//g; # Strip out null bites to prevent security holes
                          # Probably not a problem with this script, but a
                          # good practice nonetheless
    return if $fileName eq $thisProgram;
    
    my $pathName = $File::Find::name;
    
    # The following is a no-op with -a.  Pathname does not affect the logic.  Instead, it
    # is used to generate more informative error messages. File::Find does the chdir() for us.
	$pathName = defined $pathName ? $pathName : $fileName;
	
    # We only process cgi, pl, or pm files
	return if $fileName !~ /([\w]+\.(?:$extensions))$/i;
	print "Processing $pathName\n";
	
	my ( $startLine, $endLine );
	my ( $startCount, $endCount ) = ( 0, 0 );

	open FILE, "<$fileName" or die "Can't open $fileName for reading: $!";
    my @lineOfCode = <FILE>;
	close FILE;
	
	
	for my $index ( 0 .. $#lineOfCode ) {

        # Line tag
		if ( $lineOfCode[ $index ] =~ /$lineTag\s*$/ ) {
            # Comment out the line of code
			$lineOfCode[ $index ] =~ s/^/#/;
		}

		# Start tag
		if ( $lineOfCode[ $index ] =~ m!^\s*$startTag! ) {
			if ( defined $startLine ) {
                # ERROR: we've already found a start tag!
				nestingError( "start", $startLine, $index, $pathName );
				return;
			};
			$startLine = $index;
			$startCount++;
		}
		
		# End tag
		if ( $lineOfCode[ $index ] =~ m!^\s*$endTag! ) {
			$endLine = $index;
			$endCount++;
		}

		if ( defined $startLine and defined $endLine ) {
			if ( $endLine - $startLine > 1 ) {
                # Comment out lines between start and end tags
				for my $cleanIndex ( $startLine + 1 .. $endLine - 1) {
					$lineOfCode[ $cleanIndex ] =~ s/^/#/;
				}
			} 
			undef $startLine;
			undef $endLine;
		}
	}
	if ( $startCount != $endCount ) {
		print "\n-- $pathName skipped due to imbalanced tags.\n" .
              "-- You have $startCount start tags and $endCount end tags in file $fileName.\n";
		return;
	}
    saveModifiedFile( $fileName, \@lineOfCode );    
}

sub mirrorDirectories {
    my $targ_dir = $File::Find::dir;
    $targ_dir    =~ s/^$sourceDir/$targetDir/;

    if ( ! -d $targ_dir ) {
        print "Creating $targ_dir\n";
        mkdir $targ_dir or die "Cannot mkdir $targ_dir: $!";
    }
}

sub saveModifiedFile {
    my $fileName     = shift;
    my @contents     = @{ $_[0] };
    my $contents     = join '', @contents;
    my $relativePath = $File::Find::dir;
    $relativePath    =~ s/^\.//; # remove preceeding dot
    my $fullPath     = $targetDir . $relativePath . "/$fileName";
    my $backUpFile   = $fullPath . ".bak";

    # Backing up the files is the default.  If the specify the -n option on
    # the command line, no backup of the files will occur.
	unless ( exists $option{ n } ) {
        print "\tBacking up $fileName to $backUpFile\n";
        if ( -e $fullPath ) {
            unlink $backUpFile if -e $backUpFile;
    		if ( ! copy ( $fullPath, "$backUpFile" ) ) {
                print "\tCouldn't copy $fileName to $backUpFile\n\tFile Skipped.\n";
		        return;
            }
        }
	}
    if ( -e $fullPath ) {
        Win32::File::SetAttributes( $fullPath, NORMAL ) or die "Can't set $fileName to NORMAL: $!";
    }
	open FILE, ">$fullPath" or die "Can't open $fullPath for writing: $!";
	print FILE $contents;
	close FILE;
    Win32::File::SetAttributes( $fullPath, READONLY ) or die "Can't set $fileName to READONLY: $!";
}

sub sameDirectory {
    my ( $dir1, $dir2 ) = @_;
    
    # abs_path returns the absolute path of the directory or false, if no such
    # path is available.    
    -d $dir1 and $dir1 = abs_path( $dir1 ) or return -1;
    -d $dir2 and $dir2 = abs_path( $dir2 ) or return -1;
    $dir1 eq $dir2 ? 1 : 0 ;
}

sub nestingError {
	my ( $tag, $first, $last, $fileName ) = @_;
	$first++;
	$last++;
	print <<"    END_HERE";

-- Mis-nested $tag tags found on lines $first and $last in $fileName.
-- Please correct and rerun.
-- $fileName skipped.

    END_HERE
}

sub usage {
	print <<"    END_HERE";

    USAGE:
    
    prod.pl file1.pl file2.cgi

    The above line will "productionize" file1.pl and file2.cgi if they exist.
    The "productionized" files will be copied to the destination directory.

    The following switches are available and may be combined:

    a - productionize (a)ll files recursively, starting with (s)ource directory
    c - productionize all files in (c)urrent directory
    d - (d)estination directory
    D - recursive (D)elete of all files in destination.  Will prompt for confirmation
    h - This message and exit.  No processing will occur.
    H - Same as -h
    n - (n)o backup of files
    s - (s)ource directory

    NOTE:  

    both -d and -s require an argument.  Every switch is optional, but at least
    one switch must be supplied.

    EXAMPLE:

    prod.pl -an -s C:/WINNT/Profiles/cp/desktop/somedir -d C:/WINNT/Profiles/cp/desktop/anotherdir/production

    The above command will recursively copy all files and folders from the specified source to the 
    destination directory with no backup of files.

    END_HERE
}

__END__

=head1 NAME

prod.pl - Prep files for production

=head1 SYNOPSIS

C<prod.pl -a -s . -d C:/WINNT/profiles/cp/desktop/target>

The above line will I<productionize> all files in source directory, recursively
going through subdirectories.  The I<productionized> files will be copied to the
destination directory in an identical folder structure.

=head1 DESCRIPTION

prod.pl allows programs to be developed in a testing environment without worrying
about I<development only> features being copied into production.  To use this,
several tags have been identified.  As of this writing, they are:

=over 4

=item 1 C<#//> This is a B<line tag>.  Append this to the end of a line with nothing
but whitespace following and prod.pl will comment out this line.

=item 2 C<#/*> This is a B<start tag>.  All lines I<between> start and end tags will
be commented out.

=item 3 C<#*/> This is the aforementioned B<end tag>.

=back

The B<start tag> and B<end tag> must each be the I<first> item on their respective lines.
White space before these lines is permitted.

These tags are useful for ensuring that C<use warnings;> or C<use CGI::Carp qw(fatalsToBrowser);>
are not included in production code.  Also, large sections of debugging code (such as print
statements) can be commented out by wrapping them in start and end tags.

=head1 COMMAND LINE SWITCHES

There are a variety of switches that may be used on the command line.  Generally, these
switches may be combined, but common sense should be applied.  Don't use C<-a> and C<-c>
together, for example.  The program will halt and tell you what a moron you are.

The following switches are available (in alphabetical order)

=over 4
 
=item 1 C<-a> This switch is used to I<productionize> all files in the source directory
and all subdirectories of the source directory.  May not be used with C<-c>.

=item 2 C<-c> This switch is used to I<productionize> all files in the current directory.
No subdirectories will be used.

=item 3 C<-d> This specifies the destination directory.  This must not be the same as the
source directory.  Requires an argument.

=item 4 C<-D> This will erase all files and folders in the destination directory.  It will
prompt you before continuing as this is unrecoverable.  Use with B<extreme caution>.

=item 5 C<-h> Help.  This will generate a short synopsis of program usage.

=item 6 C<-H> Same as C<-h>.

=item 7 C<-n> No backup.  Typically, files to be overwritten in backup directory are backed
up by copying them to an identically named file with a I<.bak> extension.  This switch
suppresses that backup.

=item 8 C<-s> This specifies the source directory.  This must not be the same as the destination
directory.  Requires an argument.

=back

=head1 AUTHOR

Curtis A. Poe <poec@yahoo.com>

=head1 MISCELLANEOUS

This script uses the C<Win32::File> module and is not portable as a result.

This program will not copy or productionize itself.

The program will die if source and target directories are the same.  This is deliberate to prevent
overwriting of source files.

Mis-nested or imbalanced (e.g. three start tags and two end tags) tags will cause a file to be skipped.

All switches are optional, but I<something> must be used as an argument.  If the switches are
excluded, prod.pl expects a list of files on the command line.

Destination directory must exists prior to running the program.

=cut