Beefy Boxes and Bandwidth Generously Provided by pair Networks
Think about Loose Coupling

comment on

( #3333=superdoc: print w/replies, xml ) Need Help??
#!C:/perl/bin/perl.exe # # Program: # Date: 1/17/2001 # Author: Ovid # # Purpose: 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: file2.cgi The above line will "productionize" 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: -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 - Prep files for production =head1 SYNOPSIS C< -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 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 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 <> =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, expects a list of files on the command line. Destination directory must exists prior to running the program. =cut

In reply to Auto prepare code for production by Ovid

Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":

  • Are you posting in the right place? Check out Where do I post X? to know for sure.
  • Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
    <code> <a> <b> <big> <blockquote> <br /> <dd> <dl> <dt> <em> <font> <h1> <h2> <h3> <h4> <h5> <h6> <hr /> <i> <li> <nbsp> <ol> <p> <small> <strike> <strong> <sub> <sup> <table> <td> <th> <tr> <tt> <u> <ul>
  • Snippets of code should be wrapped in <code> tags not <pre> tags. In fact, <pre> tags should generally be avoided. If they must be used, extreme care should be taken to ensure that their contents do not have long lines (<70 chars), in order to prevent horizontal scrolling (and possible janitor intervention).
  • Want more info? How to link or or How to display code and escape characters are good places to start.
Log In?

What's my password?
Create A New User
Domain Nodelet?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others about the Monastery: (3)
As of 2022-09-29 17:49 GMT
Find Nodes?
    Voting Booth?
    I prefer my indexes to start at:

    Results (125 votes). Check out past polls.