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
Replies are listed 'Best First'.
Re (tilly) 1: Auto prepare code for production
by tilly (Archbishop) on Jan 25, 2001 at 08:56 UTC
    I am not a fan of having code differ between development and production. Basically you have a portability problem here. Read this excellent advice on portability and my notes on how to interpret it. If you do it right you should have a very small number of key modules that set up your environment and then have your development code run exactly the same way in production.

    This will be a simpler environment to work in, be easier for development, easier for testing, and you will be able to avoid fears that the differences between development and production are biting you yet again...

      tilly: you raise a good point. This script is something that I was assigned to write and thought I would offer to others in the event that they were called upon to perform a similar task. I can see a valid reason for such a script if one has a proper development environment set up:
      1. Development area: Here's where geeks like myself play around and create marvelous works of art. Here, we can experiment and do what we will.
      2. Staging: Here's where the development scripts get rigourously tested. QA occurs here (and that should be Quality Verification, not Quality Assessment, but that's a personal rant). The environment here should be an exact duplicate of what's in production.
      3. Production: Duh.
      Properly, a script such as mine should only be applied in the migration from development to staging. For example, I often have this at the top of my code:
      #/* use warnings; use CGI::Carp qw( fatalsToBrowser ); use CGI::DebugVars; my $debug = CGI::DebugVars->new; #*/
      Later on, I'll have individual lines like this:
      print $debug->table( ORDEROBJECT => $order ); #//
      If I am copying over twenty programs, this script will automatically comment out those lines (amongst others) while simultaneously copying the code to the proper area. The problem with my code, IMHO, is not the code itself, but our lack of a proper staging area that perfectly mimics production. If, however, such an area exists and one is copying 73 programs to it, going through those programs and commenting out "use warnings" or "fatalsToBrowser" statements all over the place is a sure recipe for missing a few. With a tag-based system, they are much easier to catch.

      Your turn :)

      Cheers,
      Ovid

      Update: Both dws and tilly are right. I did miss the point of tilly's post. Sigh.

      Join the Perlmonks Setiathome Group or just click on the the link and check out our stats.

        I think you entirely missed my point. I was suggesting that you produce a small module or two that either differs between development and production, or automatically detects that, then behaves appropriately. So you would do:
        use My::Configurable::Debugging; my $debug = My::Configurable::Debugging->new();
        and then later do:
        $debug->print_table{ ORDEROBJECT => $order );
        which calls a method that might or might not actually do anything useful.

        Now through the bulk of your scripts there is no change betweeen production and development. You don't litter your code with tags where if a developer forgets the tags somewhere they could let debug code slip into production. Or where they can put the tag in and forget that the line does something non-trivial and important. Relying on people to not make mistakes when there is no way they can get feedback that it is a mistake is a Bad Idea. Better yet since the shipped code has all of the debugging support present (though not active), you can easily turn that into a logging option in production if something works as not expected...

        What is key is to arrange to be sure that your development environment will (except for minimal necessary details) appear identical to production. Making this process take little to no care on the part of developers removes a significant cause of error. In fact this is the old mantra of centralizing your logic in one place rather than scattering it through your code, whether it is scattered through if conditions, preprocessor statements, etc.

        If you write a complicated standard and say, OK. If we all manage to follow this carefully, never making mistakes, everything will work fine! you are guaranteeing that it won't actually happen. If you write a simple standard and say, Here is the API. As long as we only use this API the process should not mess up! you at least have a fighting chance...

        The value of favoring something like print $debug->table( ORDEROBJECT => $order ) if $DEBUG{ORDER}; over print $debug->table( ORDEROBJECT => $order ); #// is that there may be times when you get backed into debugging in a production environment.

        If you're hosting your production environment (and have direct access to the database servers), it may be practical to replicate an environment that's failing. But if you're shipping a system that customers will be running within their own firewall, you may need to fall back on enabling some level of debug code in situ. Having the ability to turn on debug code remotely has saved my projects' butts many times over the past decade, and saved us from spending megabucks on last-minute airline tickets.