#!/usr/bin/perl -w

#####################################################################
# Perl script creator, by Brian Arnold                              #
# Used to create scripts, including the proper modules and flags    #
#                                                                   #
# Created:  15 July 2002                                            #
# Modified: 15 July 2002                                            #
#                                                                   #
# create.pl --manual for details                                    #
#####################################################################

### Pragmas
use strict;                 # Helps enforce clean coding, catch errors
use warnings;               # Helps even more

### Module inclusion
use Pod::Usage;             # Documentation
use Getopt::Long;           # Command-line options
use POSIX qw(strftime);     # Useful for date manip
use Data::Dumper;           # Helpful in debugging constructs

### Constants
use constant DEBUG => 0;    # Hard debugging, 0 for off, 1 for on
my $author = "Brian Arnold";# Author of script - set up as non-constan
+t for
                            # convenience later in script
my $author_email = 'brian@cs.unm.edu';

### Getopt::Long Configuration
# Notes:
# bundling:     Allows single-letter abbreviations to be grouped such
#               that "-vax" as an option would be read as "-v -a -x"
#               instead of a long option named vax.
# pass_through: Hands any unknown arguments through to @ARGV.
Getopt::Long::Configure('bundling','pass_through');

my %options;            # Used to store command-line options for easy 
+access
GetOptions(\%options,
           'nowarnings|nw',
           'nostrict|ns',
           'header|H',
           'Taint|T',
           'CGI|C|c',
           'pod|p',
           'getopt|g',
           'document|d',
           'strftime|s',
           'timelocal|t',
           'datadumper|D',
           'overwrite|o',
           'Debug',
           'help|h',
           'manual|m',);

my $debug = DEBUG || $options{'Debug'};
my $perlpath = `which perl`;    # An educated guess as to where Perl i
+s at
chomp $perlpath;                # Strip the newline
my $file;                       # Create a file variable, for easier
                                # coding later on
my $date = strftime("%A, %B %d, %Y", localtime); # Used in header bloc
+k
my $pod_date = strftime("%d %B %Y", localtime);  # Used in pod

# Turn on pod and getopt if document is set
if ($options{'document'}) {
    $options{'pod'} = 1;
    $options{'getopt'} = 1;
}

# Turn on Taint if CGI is set
$options{'Taint'} = 1 if $options{'CGI'};

# If help requested, generate standard help and exit
pod2usage(-verbose => 1) if $options{'help'};

# If man page requested, generate man page and exit
pod2usage(-verbose => 2) if $options{'manual'};

# DEBUG: Dump Options
if ($debug) {
    PrintDebug("Contents of \%options:\n");
    PrintDebug(Dumper(\%options));
    PrintDebug("Contents of \@ARGV:\n");
    PrintDebug(Dumper(\@ARGV));
}

# Check ARGV for filename, assume STDOUT if none
if (!$ARGV[0] or $ARGV[0] eq '-') {
    # Writing to STDOUT
    open(FILEOUT, ">&STDOUT") or die "$0: Unable to duplicate STDOUT: 
+$!\n";
    PrintDebug("Using STDOUT for output") if $debug;
}
else {
    # Writing to a file
    $file = shift @ARGV;
    open(FILEOUT, "> $file") or die "$0: Unable to open $file: $!\n";
    PrintDebug("Writing File to $file") if $debug;
}

### Start printing out script
# Print shebang, including options
print FILEOUT "#!/usr/bin/perl";
print FILEOUT " -w" unless $options{'nowarnings'};
print FILEOUT " -T" if $options{'Taint'};
print FILEOUT "\n\n";

# Print simple header block unless noheader is specified
if ($options{'header'}) {
    print FILEOUT "#" x 70, "\n";
    if (defined $file) {
        printf FILEOUT "# %-66s #\n", $file;
    }
    else {
        print FILEOUT "#"," "x68,"#\n";
    }
    printf FILEOUT "# by %-63s #\n", $author;
    print FILEOUT "#", " " x 68, "#\n";
    printf FILEOUT "# %-66s #\n", "Description here";
    print FILEOUT "#", " " x 68, "#\n";
    printf FILEOUT "# Created:       %-51s #\n", $date;
    printf FILEOUT "# Last Modified: %-51s #\n", $date;
    print FILEOUT "#" x 70, "\n\n";
}

# Print Pragmas
print FILEOUT "### Pragmas\n";
print FILEOUT <<END_OF_STRICT unless $options{'nostrict'};
use strict;                 # Helps enforce clean coding, catch errors
END_OF_STRICT
print FILEOUT <<END_OF_WARNINGS unless $options{'nowarnings'};
use warnings;               # Helps even more, catches more errors

END_OF_WARNINGS
# End of Pragmas

# Print module includes
print FILEOUT "### Module inclusion\n";
print FILEOUT <<END_OF_CGI if $options{'CGI'};
use CGI;                    # CGI object makes CGI scripts easier
END_OF_CGI
print FILEOUT <<END_OF_POD if $options{'pod'};
use Pod::Usage;             # Documentation
END_OF_POD
print FILEOUT <<END_OF_GETOPT if $options{'getopt'};
use Getopt::Long;           # Command-line options
END_OF_GETOPT
print FILEOUT <<END_OF_POSIX if $options{'strftime'};
use POSIX qw(strftime);     # Useful for time manip
END_OF_POSIX
print FILEOUT <<END_OF_TL if $options{'timelocal'};
use Time::Local             # Useful for time manip
END_OF_TL
print FILEOUT <<END_OF_DD if $options{'datadumper'};
use Data::Dumper;           # Helpful in debugging constructs
END_OF_DD
print FILEOUT "\n";
# End of module includes

# Print constants
print FILEOUT <<END_OF_CONSTANT;
### Constants
use constant DEBUG => 0;    # Hard debugging, 0 for off, 1 for on

END_OF_CONSTANT
# End of constants

# Print basic getopt config if need be
print FILEOUT <<END_OF_GETOPT_CONFIG if $options{'getopt'};
### Getopt::Long Configuration
# Notes:
# bundling:     Allows single-letter abbreviations to be grouped such
#               that "-vax" as an option would be read as "-v -a -x"
#               instead of a long option named vax.
# pass_through: Hands any unknown arguments through to \@ARGV.
Getopt::Long::Configure('bundling','pass_through');

my \%options;            # Used to store command-line options for easy
+ access
GetOptions(\\\%options,
           'Debug|D',
           'help|h',
           'manual|m',);

END_OF_GETOPT_CONFIG
# End of getopt config

# Setup a $debug variable to make debug info a little easier
print FILEOUT <<END_OF_DEBUG;
my \$debug = DEBUG || \$options{'Debug'};

END_OF_DEBUG
# End of $debug setup

# Set up pod2usage if document is set.  Had thought of using putting
# this into the getopt_config area, but really it's only going to be
# available if someone adds pod2usage and getopt together.  Heck, the
# only reason you can include Pod::Usage without Getopt::Long is becau
+se
# it was a good exercise.
print FILEOUT <<END_OF_HELP if $options{'document'};
# If help requested, generated standard help and exit
pod2usage(1) if \$options{'help'};

# If man page requested, generate man page and exit
pod2usage(2) if \$options{'manual'};

END_OF_HELP
# End of pod2usage setup

# Some quick notes to be placed in the new script
print FILEOUT <<END_OF_NOTES;
# This is a good spot for the body of code to be inserted.

END_OF_NOTES

### Pod printout area
# Start basic pod
if ($options{'pod'}) {
    print FILEOUT <<END_OF_POD;
__END__

=head1 NAME

 $file

=head1 SYNOPSIS

 $file

END_OF_POD

    # Add an options section if getopt is defined
    print FILEOUT <<END_OF_OPTIONS if $options{'getopt'};
=head1 OPTIONS

 --help, -h         Displays a brief help and exits
 --manual, -m       Displays the manual page for this script

END_OF_OPTIONS

    # Put in description
    print FILEOUT <<END_OF_DESC;
=head1 DESCRIPTION

 Describe script here

END_OF_DESC

    # If using options, setup an options area how I like it
    print FILEOUT <<END_OF_POD_OPTS if $options{'getopt'};
=over 4

=item B<--help, -h>

 Displays a brief help and exits.

=item B<--manual, -m>

 Displays this manual page, then exits.

=back

END_OF_POD_OPTS

    # Finish basic pod
    print FILEOUT <<END_OF_POD;
=head1 ARGUMENTS

=over 4

=item B<argument>

 Describe arguments here

=back

=head1 AUTHOR

END_OF_POD
    # Add author, and e-mail if defined
    print FILEOUT " $author";
    print FILEOUT " <$author_email>" if $author_email;

    print FILEOUT <<END_OF_POD;


=head1 CREDITS

=head1 BUGS

=head1 TODO

=head1 UPDATES

 $pod_date: Created

=cut

END_OF_POD
}

# Close file and set to execute
if (defined $file) {
    close FILEOUT or die "$0: Unable to close $file: $!\n";
    chmod 0755, $file;
}

exit(0);

### End of main body of code, subfunctions follow

sub PrintDebug {
    my ($msg) = @_;
    print STDERR "***DEBUG: $msg\n";
}

__END__

=head1 NAME

 create.pl - Creates Perl script templates

=head1 SYNOPSIS

 create.pl [options] filename

=head1 OPTIONS

 --nowarnings, --nw Doesn't turn on the -w flag on the shebang line
 --nostrict, --ns   Doesn't use strict (not advised)
 --header, -H       Print out a header block detailing author etc.
 --Taint, -T        Includes the -T on the shebang line
 --CGI, -c          Includes the CGI module, sets up a $q CGI object,
                    and includes -T on the shebang line
 --pod, -p          Includes the Pod::Usage module
 --getopt, -g       Includes the Getopt::Long module
 --document, -d     Includes both Getopt::Long and Pod::Usage
                    (equivalent to -p -g)
 --timelocal, -t    Includes the Time::Local module
 --strftime, -s     Includes the POSIX module, importing strftime
 --datadumper, -d   Includes the Data::Dumper module
 --overwrite, -o    Overwrites any existing script
 --Debug, -D        Turns on debug output
 --help, -h         Displays a brief help and exits
 --manual, -m       Displays the manual page for this script

=head1 DESCRIPTION

 create.pl is a Perl script that generates template Perl scripts, to
 save time and effort when it comes to writing a new script.

 It takes the filename argument, generates a file with that name,
 saves the file and turns on the execute bit (or warns if unable to)

=over 4

=item B<--nowarnings, -nw>

 Doesn't include a "-w" on the shebang line - not advised to use,
 included for completeness

=item B<--nostrict, -ns>

 Doesn't add the 'use strict' pragma - highly not advised to use,
 included for completeness

=item B<--Taint, -T>

 Inserts a "-T" on the shebang line ("#!/usr/bin/perl -T).

=item B<--CGI, -c>

 Includes the CGI module, creates a $q CGI object.
 Also includes -T on the shebang line, for safety.

=item B<--pod, -p>

 Includes the Pod::Usage module

=item B<--getopt, -g>

 Includes the Getopt::Long module

=item B<--document, -d>

 Essentially a shortcut equivalent to -p -g, includes both Pod::Usage
 and Getopt::Long

=item B<--timelocal, -t>

 Includes the Time::Local module

=item B<--strftime, -s>

 Includes the POSIX module, importing strftime

=item B<--datadumper, -d>

 Includes the Data::Dumper Module

=item B<--overwrite, -o>

 Can be used to overwrite a file that already exists.  To be honest,
 this option is here just for the heck of it, and I really can't
 see any reason anyone would use it.

=item B<--Debug, -D>

 Turns on debugging output, will do some Data::Dumper dumps along
 the way.

=item B<--help, -h>

 Displays a brief help and exits.

=item B<--manual, -m>

 Displays this manual page, then exits.

=back

=head1 ARGUMENTS

=over 4

=item B<filename>

 The filename specifies the name of the file used to save the script
 Specifying a single dash '-' should print the script to standard
 output.

=back

=head1 AUTHOR

 Brian Arnold <brian@cs.unm.edu>

=head1 CREDITS

 http://www.perlmonks.org - without this site, I wouldn't know what I
 know to do this.  Someone posted something similar once, but I just
 can't find it

=head1 BUGS

 None I know of

=head1 TODO

 Possibly clean up some of the POD, maybe add more features to include
 other modules

=head1 UPDATES

 15 July 2002:  Created

=cut
[download]