#!/usr/bin/perl -w # new: basic template processor. use strict; use Template; use Getopt::Long; use File::Basename; use Config; use English qw( -no_match_vars ); use subs qw/dolist doshow dprint edit list_templates locate manpage mkuserinfo myuuid newuuid simple_tree usage version where/; $ENV{'PATH'} = join ":", qw(/bin /usr/bin /usr/local/bin /opt/sfw/bin); my $myname = basename($0); $myname =~ s/\.\w*$//; # strip any extension # Where to find templates and user information? my @tpltypes = qw/templates projects/; my @tplpath; if (exists $ENV{'TPLPATH'}) { @tplpath = split(/:/, $ENV{'TPLPATH'}); } else { push(@tplpath, "$ENV{'HOME'}/.$myname"); if ($_ = $Config{'installprefix'}) { push(@tplpath, "$_/share/$myname"); } } foreach (@tplpath) { push(@INC, $_); } # Handle command line options. my %options; my @getopt_args = ( 'a', # consider all files, not just projects or templates 'd', # debug/test 'e', # edit created file 'h|?', # print usage 'l', # list templates (in conjunction with -a or -p) 'm', # print manpage 'p', # look for template in projects directory 's', # show template without any processing 'u', # print basic userinfo file 'U', # print UUID 'v', # print version 'w', # show which template would be used and stop 'W', # show source location ); Getopt::Long::config("noignorecase", "bundling"); usage unless GetOptions(\%options, @getopt_args); manpage if $options{'m'}; mkuserinfo if $options{'u'}; myuuid if $options{'U'}; version if $options{'v'}; where if $options{'W'}; usage if $options{'h'}; # Sanity checks. if ($options{'l'} && $options{'a'} && $options{'p'}) { usage "Options 'l', 'a', and 'p' don't make sense together."; } # Set up default user values. The "userinfo.pl" file # should be in the template path. our %userinfo; require "userinfo.pl"; # Environment variables. $userinfo{'mail'} = exists $ENV{'WORK'} ? $userinfo{'email'}{'work'} : $userinfo{'email'}{'home'}; # Debug: dump any values of interest. if ($options{'d'}) { use Data::Dumper; print "Template path: @tplpath\n\n"; $Data::Dumper::Useqq = 1; # double quotes $Data::Dumper::Purity = 1; # fill in the holes for eval $Data::Dumper::Indent = 1; # mild pretty print $Data::Dumper::Sortkeys = 1; # sort output hash print Data::Dumper->Dump([\%userinfo], ['*userinfo']); } # Handle options that don't require text replacement, # like listing templates. if ($options{'l'}) { if ($options{'a'}) { dolist('all'); } elsif ($options{'p'}) { dolist('projects'); } else { dolist('templates'); } exit(0); } # Handle command line. # # If we're NOT writing a full project directory, make sure the # template file contains a '/' and an extension like "default". # This way, a command like "new txt" will simply print the default # text template to stdout, like it should. my $file = shift || die "no template, use $myname -l for a list.\n"; unless ($file =~ m!/!) { $file .= '/default' unless $options{'p'}; } # If the output file is empty, print to stdout and use # the template filename to replace the appropriate strings # in the template itself. my $dest = shift || ''; if (length($dest)) { $_ = basename($dest); } else { $_ = basename($file); } $userinfo{'file'} = $_; s/\.\w*$//; $userinfo{'func'} = $_; $userinfo{'fupper'} = uc($_); $userinfo{'flower'} = lc($_); $userinfo{'uuid'} = newuuid(); $userinfo{'fqdn'} = $Config{'myhostname'} . $Config{'mydomain'}; # If the user wants to show a raw template or see which # template would be used, do that here. my $tplfile = locate($file) or die "$file: no such template\n"; if ($options{'s'}) { doshow($tplfile); exit(0); } if ($options{'w'}) { print "Template path: @tplpath\n\n"; print "Template file: $tplfile\n"; exit(0); } # If we get this far, replace the text in the template. # If we're writing to a file, allow the user to edit if desired. my $tpl = Template->new({ABSOLUTE => 1}) || die $Template::ERROR, "\n"; # A destination has been specified, either file or directory. if (length($dest)) { # Single-file templates if (-f $tplfile) { die "Sorry, $dest already exists.\n" if -f $dest; $tpl->process($tplfile, \%userinfo, $dest) || die $tpl->error(); edit($dest) if $options{'e'}; } # Entire projects. else { die "Sorry, $dest must be a directory.\n" unless -d $dest; my $dh; opendir($dh, "$tplfile") or die "can't read dir $tplfile: $!\n"; my @files = readdir $dh; closedir($dh); foreach (sort @files) { if (-f "$tplfile/$_") { if (-f "$dest/$_") { print "will not overwrite file $dest/$_\n"; } else { print "writing $dest/$_...\n"; $tpl->process("$tplfile/$_", \%userinfo, "$dest/$_") || die $tpl->error(); } } } } } else { if (-f $tplfile) { $tpl->process($tplfile, \%userinfo) || die $tpl->error(); } else { # Make sure the user really intended to create a project here. die "$tplfile is a directory -\ndid you forget the -p option?\n" unless $options{'p'}; my $dh; opendir($dh, "$tplfile") or die "can't read dir $tplfile: $!\n"; my @files = readdir $dh; closedir($dh); foreach (sort @files) { if (-f "$tplfile/$_") { if (-f "$_") { print "will not overwrite file $_\n"; } else { print "writing $_...\n"; $tpl->process("$tplfile/$_", \%userinfo, "$_") || die $tpl->error(); } } } } } exit(0); #--------------------------------------------------------------------- # Print a usage message and exit. Require/use statements are in the # functions because they're expensive; don't do it unless these routines # are called. sub dprint { my ($emsg) = @_; print "DBG: $emsg" if $options{'d'}; } sub usage { my ($emsg) = @_; use Pod::Usage qw(pod2usage); warn "$emsg\n" if defined $emsg; pod2usage(-verbose => 99, -sections => "NAME|SYNOPSIS|OPTIONS"); } sub manpage { use Pod::Man(); my $parser = Pod::Man->new(); open(STDOUT, "| groff -T ascii -man | gcat -s | less") || die "groff\n"; $parser->parse_from_file($0); close STDOUT || die "$myname: can't close stdout: $!\n"; $? = 1 if $? == 255; # from die exit($?); } #--------------------------------------------------------------------- # Print the UUID, current version, or source location. sub myuuid { my $UUID = sprintf("%s", q$UUID: 732c6d45-2698-3844-b7c3-7bfa869105a6 $ =~ /UUID: (.*) /); print "$UUID\n"; exit(0); } sub version { my $VERSION = sprintf("%d.%02d", q$Revision: 1.20 $ =~ /(\d+)\.(\d+)/); my $DATE = sprintf("%s", q$Date: 2009/08/06 23:18:31 $ =~ /Date: (.*) /); print "$myname $VERSION $DATE\n"; exit(0); } sub where { my $SOURCE = sprintf("%s", /Source: (.*) /); print "file://$HOST", "$SOURCE\n"; exit(0); } #--------------------------------------------------------------------- # Locate a given template. The input string should look like "xxx" # or "xxx/yyy", so strip any leading or trailing slashes. use File::Find (); no warnings 'File::Find'; sub simple_tree; my @templates; sub locate { $_ = shift(@_); my $result; my $target; my $topdir; use vars qw/*name/; *name = *File::Find::name; s!^//*!!g; s!//*$!!g; # '/' means user has a specific template in mind. $target = $_; unless (m!/!) { $_ .= '/default' unless $options{'p'}; } dprint "target = $target\n"; # walk the directory trees; code is similar to dolist(). $result = undef; foreach $topdir (@tplpath) { next unless -d "$topdir"; @templates = (); File::Find::find({wanted => \&simple_tree}, $topdir); dprint "topdir = $topdir\n"; foreach (@templates) { if ($options{'p'}) { next if m!$topdir/templates!; dprint " project: file = $_\n"; } else { next if m!$topdir/projects!; dprint " template: file = $_\n"; } if (m!$target!) { $result = $_; last; } } last if $result; } return $result; } sub simple_tree { $name =~ m!(projects|templates)! && push(@templates, "$name"); } #--------------------------------------------------------------------- # Print a given raw template to stdout. Template file might be # a directory, if we've requested a project. sub doshow { my ($file) = @_; if (-f $file) { open(my $fh, "< $file") or die "$file: $!\n"; print while <$fh>; close($fh); } elsif (-d $file) { my $dh; opendir($dh, "$file") or die "can't read dir $file: $!\n"; my @files = readdir $dh; closedir($dh); foreach (sort @files) { print "$file/$_\n" if -f "$file/$_"; } } } #--------------------------------------------------------------------- # List the available templates in subdirectories beneath # the main ones listed in the template path. sub list_templates; sub dolist { my ($keep) = @_; use vars qw/*name/; *name = *File::Find::name; # Traverse each directory. Sort the results, but "default" # should show up first if present. Put a break between the # projects and templates portions. my $topdir; my @out; foreach $topdir (@tplpath) { next unless -d "$topdir"; @templates = (); @out = (); File::Find::find({wanted => \&list_templates}, $topdir); print "\n$topdir:\n"; foreach (@templates) { next if $keep eq 'projects' && m!$topdir/templates!; next if $keep eq 'templates' && m!$topdir/projects!; s!/default!/0default!; s!$topdir!!; push(@out, $_); } foreach (sort @out) { s!/0default!/default!; m!/(projects|templates)$! && print "\n"; s,[^/]*/([^/]*)$,+-----${1},s; s,[^/]*/,| ,sg; print " $_\n"; } } } sub list_templates { my ($dev, $ino, $mode, $nlink, $uid, $gid); $name =~ m!(projects|templates)! && (($dev, $ino, $mode, $nlink, $uid, $gid) = lstat($_)) && push(@templates, "$name"); } #--------------------------------------------------------------------- # Print UUID based on current date/time. use Data::UUID; use Time::HiRes qw/gettimeofday/; use POSIX qw/strftime/; sub newuuid { my $ug = new Data::UUID; my ($sec, $usec) = gettimeofday(); my @lt = localtime($sec); my $ts = strftime("%Y-%m-%d %T.", @lt) . sprintf("%-6.6d", $usec); return lc($ug->create_from_name_str(NameSpace_URL, $ts)); } #--------------------------------------------------------------------- # Print a bare-bones userinfo file to stdout. sub mkuserinfo { my $hdr = <<'EndHdr'; # @Id@ # @Source@ # # value "mail" is set by script to either work or home, so use # "mail" in templates unless you specifically need a given value. EndHdr $hdr =~ s/@/\$/g; # protect from RCS expansion. print "$hdr"; print <<'EndInfo'; %userinfo = ( "login" => "[Your login id]", "firstname" => "[Your first name]", "lastname" => "[Your last name]", "fullname" => "[Full name, if other than first + last name]", "email" => { "work" => "you\@your.workplace.com", "home" => "you\@your.home.com", "nospam" => "you at your dot workplace dot com" }, "company" => "[Your employer]", "disclaimer" => "I don't speak for the USAF or my company", "location" => "[Building you're in]", "org" => { "func" => "[Functional organization]", "ipt" => "[Process team, if any]", }, "phone" => { "comm" => "xxx-xxx-xxxx", "dsn" => "xxx-xxxx", "local" => "x-xxxx", }, "rank" => "[Civilian, Contractor, Military Rank]", "supervisor" => "[Your supervisor's name]", "title" => "[Used in your email signature]", "website" => "[Your homepage]", ); EndInfo exit(0); } #--------------------------------------------------------------------- # Edit a file. sub edit { my ($f) = shift or die "edit: no filename\n"; my ($editor) = $ENV{'EDITOR'} || "vi"; $EUID = $UID; $EGID = $GID; # XXX: initgroups() not called $ENV{PATH} = "/bin:/usr/bin"; exec($editor, $f) or die "can't exec $editor: $!"; } #--------------------------------------------------------------------- __END__ =head1 NAME new - basic template processor =head1 SYNOPSIS new [-adehlmpsuUvwW] template [output-file] =head1 OPTIONS =over 4 =item B<-a> When used in conjunction with B<-l>, shows all template files, not just the ones under either the projects or templates sub-directory. =item B<-d> Print debugging information and exit. =item B<-e> If the user has specified a single output file, start an editor on that file after the template has been filled in. =item B<-h> Print a brief help message and exit. =item B<-l> List all templates and exit. =item B<-m> Print the manual page and exit. =item B<-p> Look for the template in the "projects" sub-directory; the default behavior is to look in the "templates" sub-directory. Process every template in the specified projects sub-directory, and write the results to the destination directory or the current directory. =item B<-s> Show the requested template file without filling anything in. =item B<-u> Print a basic userinfo file to stdout and exit. =item B<-U> Print the script UUID and exit. =item B<-v> Print the version and exit. =item B<-w> Show which template file would be used, but don't create any files or generate any further output. =item B<-W> Print the source location and exit. =back =head1 DESCRIPTION B will read a template file (or directory) plus an optional output file or directory, fill in the template fields, and either print the results to stdout or to the desired output. These template files are assumed to live under the /usr/local/share/new or $HOME/.new directories. Use the environment variable B to specify a different set of directories. Basic script behavior: B<*> NEVER over-write existing files. B<*> If a directory is expected but not supplied on the command line, use the current directory. B<*> If an output file is expected but not supplied on the command line, write to stdout. B<*> When creating a project, if an output file already exists, stop before trying to write anything. =head1 EXAMPLES A template command-line argument looks like B, where B is the general category and B is the specific thing in that category. Let's say your template setup looks like this: /your/homedir/.new: +-----templates | +-----sh | | +-----default | | +-----long | | +-----short /usr/local/share/new: +-----projects | +-----proposal | | +-----MANIFEST | | +-----Makefile | | +-----proposal.ms +-----templates | +-----txt | | +-----default | | +-----letter You have a personal templates sub-directory called B holding template shell scripts B, B, and B. B would use your .../sh/long file as the input template, do whatever text replacements are specified, and write the results to stdout. B would use your .../sh/short file as the input template, do whatever text replacements are specified, and write the results to the file B. B would use the /txt/default file from /usr/local/share/new as the input template, do whatever text replacements are specified, and write the results to stdout. B would use all files under the /proposal directory from /usr/local/share/new as the input templates, do whatever text replacements are specified, and write the results to identically-named files in the current directory. =head1 AUTHOR Karl Vogel Sumaria Systems, Inc. =cut