http://www.perlmonks.org?node_id=54073
Category: Win32 Stuff
Author/Contact Info Ovid email me
Description: We had a situation at work where programs running in our test environment behave differently than programs in our production environment. Specifically, when copying programs to our production environment, we wanted to automatically comment out use warnings, debugging code, or anything else that was merely being used for development.

To use this code, append a "#//" at the end of every line that should not be in production. If you have a block of code that shouldn't be in production, wrap the code in #/* and #*/ tags. Then, run this code, specifying source and destination directories, and it will automatically comment out the appropriate code. It will skip itself and all programs that do not end with the extensions in $extensions

Further, it can process files that you specify, all files in the current directory, all directories or subdirectories, make the target directory if it doesn't exist, and more. It needs some work, but it's fairly flexible.

It uses some Windows specific code, but I'm sure it can easily be ported to a *nix environment.

#!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" v
+ersion 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, t
+he 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 co
+mmented 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 i
+f 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 exitin
+g.";
            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 re
+ad the usage and correct.";
        &usage;
        exit;
    }
    
    if ( $option{ D } ) {
        print "You have asked to delete $targetDir and all subdirector
+ies.\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 h
+oles
                          # Probably not a problem with this script, b
+ut 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 ta
+gs 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 opti
+on 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\tFil
+e 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 se
+t $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 direc
+tory.

    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 f
+or 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/Pr
+ofiles/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, re
+cursively
going through subdirectories.  The I<productionized> files will be cop
+ied to the
destination directory in an identical folder structure.

=head1 DESCRIPTION

prod.pl allows programs to be developed in a testing environment witho
+ut worrying
about I<development only> features being copied into production.  To u
+se 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 lin
+e 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 thei
+r 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 debuggin
+g code (such as print
statements) can be commented out by wrapping them in start and end tag
+s.

=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 u
+se C<-a> and C<-c>
together, for example.  The program will halt and tell you what a moro
+n 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<ext
+reme caution>.

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

=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> extensi
+on.  This switch
suppresses that backup.

=item 8 C<-s> This specifies the source directory.  This must not be t
+he 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 re
+sult.

This program will not copy or productionize itself.

The program will die if source and target directories are the same.  T
+his 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 argumen
+t.  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