std

   1 #!/usr/bin/env perl
   2
   3 #=======================================================================
   4 # std
   5 # File ID: e9801250-f743-11dd-afdc-000475e441b9
   6 #
   7 # Send file templates to stdout
   8 #
   9 # Character set: UTF-8
  10 # ©opyleft 2004– Øyvind A. Holm <sunny@sunbase.org>
  11 # License: GNU General Public License version 2 or later, see end of
  12 # file for legal stuff.
  13 #=======================================================================
  14
  15 use strict;
  16 use warnings;
  17 use Getopt::Long;
  18 use Cwd;
  19
  20 local $| = 1;
  21
  22 our %Opt = (
  23
  24     'force' => 0,
  25     'help' => 0,
  26     'notag' => "",
  27     'quiet' => 0,
  28     'rcfile' => "$ENV{'HOME'}/.stdrc",
  29     'tag' => 0,
  30     'verbose' => 0,
  31     'version' => 0,
  32
  33 );
  34 my @Tags = ();
  35
  36 our $progname = $0;
  37 $progname =~ s/^.*\/(.*?)$/$1/;
  38 our $VERSION = '0.9.0';
  39
  40 my $CMD_GIT = "git";
  41 my $CMD_WGET = "wget";
  42 my $CMD_SUUID = "suuid";
  43
  44 my $Type = "";
  45 my $Dest = "";
  46 my $session_uuid = "";
  47 my @bck_cmdline = @ARGV;
  48
  49 Getopt::Long::Configure('bundling');
  50 GetOptions(
  51
  52     'force|f' => \$Opt{'force'},
  53     'help|h' => \$Opt{'help'},
  54     'notag|T=s' => \$Opt{'notag'},
  55     'quiet|q+' => \$Opt{'quiet'},
  56     'rcfile=s' => \$Opt{'rcfile'},
  57     'tag|t=s' => \@Tags,
  58     'verbose|v+' => \$Opt{'verbose'},
  59     'version' => \$Opt{'version'},
  60
  61 ) || die("$progname: Option error. Use -h for help.\n");
  62
  63 $Opt{'verbose'} -= $Opt{'quiet'};
  64 $Opt{'help'} && usage(0);
  65 if ($Opt{'version'}) {
  66     print_version();
  67     exit(0);
  68 }
  69
  70 my $Lh = "[0-9a-fA-F]";
  71 my $v1_templ = "$Lh\{8}-$Lh\{4}-1$Lh\{3}-$Lh\{4}-$Lh\{12}";
  72
  73 my %rc = read_rcfile();
  74
  75 if (defined($ARGV[0])) {
  76     $Type = $ARGV[0];
  77 } else {
  78     usage(1);
  79 }
  80
  81 defined($ARGV[1]) && ($Dest = $ARGV[1]);
  82
  83 my ($Sec, $Min, $Hour, $Day, $Mon, $Year, $Wday, $Yday, $is_dst) = localtime();
  84 $Year += 1900;
  85 $Mon += 1;
  86
  87 my %Tag = ();
  88 if (scalar(@Tags)) {
  89     for my $Curr (@Tags) {
  90         if ($Curr =~ /^([^=]+?)=(.*)$/) {
  91             $Tag{$1} = $2;
  92         } else {
  93             die("$progname: $Curr: Invalid tag, must have the form " .
  94                 "name=value\n");
  95         }
  96     }
  97 }
  98
  99 my $retval = main();
 100 exit($retval);
 101
 102 sub main {
 103     # {{{
 104     my $Retval = 0;
 105
 106     if (length($Dest) && -e $Dest) {
 107         if ($Opt{'force'}) {
 108             msg(1, "Overwriting '$Dest'...");
 109         } else {
 110             warn("$progname: $Dest: File already exists, " .
 111                  "will not overwrite\n");
 112             return(1);
 113         }
 114     }
 115
 116     msg(2, sprintf("\@Tags = \"%s", join("\", \"", @Tags) . "\""));
 117     msg(2, sprintf("%%Tag = \"%s", join("\", \"", %Tag) . "\""));
 118
 119     my $dat_dir = $0;
 120     $dat_dir =~ s/^(.+\/)(.+?)$/$1/;
 121     $dat_dir .= "Lib/std";
 122     my $dat_file = "$dat_dir/$Type";
 123
 124     my $tmpfile = "tmp.std." . time;
 125
 126     my $orig_dir = getcwd();
 127     chdir($dat_dir) || die("$progname: $dat_dir: Cannot chdir: $!\n");
 128     if (open(PipeFP, "$CMD_GIT status $Type |")) {
 129         while (<PipeFP>) {
 130             if (/modified:\s+$dat_file/) {
 131                 warn("$progname: WARNING: $dat_file is modified\n");
 132                 last;
 133             }
 134         }
 135         close(PipeFP);
 136         chdir($orig_dir) ||
 137             die("$progname: $orig_dir: Cannot return to original dir: $!\n");
 138         mysyst("cp", "-p", $dat_file, $tmpfile);
 139     } else {
 140         warn("$progname: Unable to open \"$CMD_GIT stat\" pipe\n");
 141     }
 142
 143     if (length($Dest)) {
 144         msg(1, "Copying temp file");
 145         mysyst("cp", "-p", $tmpfile, $Dest);
 146     }
 147
 148     my $Output = "";
 149
 150     if (open(FromFP, "<$tmpfile")) {
 151         while (my $Line = <FromFP>) {
 152             $Line = replace_tags($Line);
 153             $Output .= $Line;
 154         }
 155         close(FromFP);
 156         if ($Output =~ /STD\S+DTS/s) {
 157             my ($tmp, $tmp2) = ($Output, "");
 158             my %Ha = ();
 159             $tmp =~ s/STDU(\S+?)UDTS/uc($Ha{$1} = 1)/gse;
 160             $tmp =~ s/STD(\S+?)DTS/($Ha{$1} = 1)/gse;
 161             for my $key (sort keys %Ha) {
 162                 defined($Ha{$key}) && ($tmp2 .= "$key ");
 163             }
 164             $tmp2 =~ s/ $//;
 165             warn("$progname: Warning: Undefined tags: $tmp2\n");
 166         }
 167     } else {
 168         die("$progname: $tmpfile: Cannot read file: $!\n");
 169     }
 170
 171     if (length($Dest)) {
 172         open(DestFP, ">$Dest")
 173             || die("$progname: $Dest: Cannot open file for write: $!\n");
 174         print(DestFP $Output);
 175         close(DestFP);
 176     } else {
 177         print($Output);
 178     }
 179
 180     unlink($tmpfile) || warn("$progname: $tmpfile: Cannot delete file: $!\n");
 181
 182     return $Retval;
 183     # }}}
 184 } # main()
 185
 186 sub read_rcfile {
 187     # Read userdefined data from file in $Opt{'rcfile'} {{{
 188     my %Retval = ();
 189     if (-e $Opt{'rcfile'}) {
 190         if (open(RcFP, "<", $Opt{'rcfile'})) {
 191             while (my $Line = <RcFP>) {
 192                 $Line =~ s/^\s*(.*?)\s*$/$1/;
 193                 # if ($Line =~ /^example\s*=\s*(\S+)/) {
 194                 #     $Retval{'example'} = $1;
 195                 # }
 196             }
 197             close(RcFP);
 198         } else {
 199             msg(-1, "$Opt{'rcfile'}: Cannot open file for read: $!");
 200         }
 201     }
 202     return(%Retval);
 203     # }}}
 204 } # read_rcfile()
 205
 206 sub replace_tags {
 207     # {{{
 208     my $Txt = shift;
 209     if (scalar(@Tags)) {
 210         for my $Curr (keys %Tag) {
 211             if ($Opt{'notag'} !~ /\b$Curr\b/) {
 212                 $Txt =~ s/STDU${Curr}UDTS/\U$Tag{$Curr}/g;
 213                 $Txt =~ s/STD${Curr}DTS/$Tag{$Curr}/g;
 214             }
 215         }
 216     }
 217     $Opt{'notag'} =~ /\bfilename\b/ || (length($Dest) &&
 218         ($Txt =~ s/STDfilenameDTS/$Dest/g));
 219     $Opt{'notag'} =~ /\byear\b/ || ($Txt =~ s/STDyearDTS/$Year/g);
 220     $Opt{'notag'} =~ /\buuid\b/ || ($Txt =~ s/STDuuidDTS/gen_uuid()/ge);
 221     return($Txt);
 222     # }}}
 223 } # replace_tags()
 224
 225 sub mysyst {
 226     # Customised system() {{{
 227     my @Args = @_;
 228     my $system_txt = sprintf("system(\"%s\");", join("\", \"", @Args));
 229     msg(2, "$system_txt");
 230     msg(1, "@_\n");
 231     system(@_);
 232     # }}}
 233 } # mysyst()
 234
 235 sub gen_uuid {
 236     # {{{
 237     my $Retval = "";
 238     my $Comment = "$progname " . join(" ", @bck_cmdline) . "";
 239     if (!length($session_uuid)) {
 240         chomp($session_uuid =
 241             `$CMD_SUUID --tag std --whereto o --comment "$Comment"`);
 242         if (!defined($session_uuid) || $session_uuid !~ /^$v1_templ$/) {
 243             die("$progname: $CMD_SUUID error\n");
 244         }
 245         if (length($Dest)) {
 246             print("$session_uuid\n");
 247         }
 248     }
 249     $Retval = $session_uuid;
 250     msg(2, "gen_uuid(): Retval = '$Retval'");
 251     return($Retval);
 252     # }}}
 253 } # gen_uuid()
 254
 255 sub print_version {
 256     # Print program version {{{
 257     print("$progname $VERSION\n");
 258     return;
 259     # }}}
 260 } # print_version()
 261
 262 sub usage {
 263     # Send the help message to stdout {{{
 264     my $Retval = shift;
 265
 266     if ($Opt{'verbose'}) {
 267         print("\n");
 268         print_version();
 269     }
 270     print(<<"END");
 271
 272 Usage: $progname [options] type [destfile]
 273
 274 Create a file of a specific type using a predefined template. If no
 275 destination file is specified, output goes to stdout.
 276
 277 Options:
 278
 279   -h, --help
 280     Show this help.
 281   -f, --force
 282     Overwrite existing file.
 283   -q, --quiet
 284     Be more quiet. Can be repeated to increase silence.
 285   --rcfile FILE
 286     Read initial settings from FILE instead of '\$HOME/.stdrc'.
 287   -t x, --tag x
 288     Replaces strings of the form "STDtagDTS" or "STDUtagUDTS" in the
 289     template file with another string. The "STDUtagUDTS" version
 290     converts the tag to upper case. Examples:
 291       -t testcmd=myscript.pl
 292       -t year=1997 -t "personname=John Lennon" -t os=GNU/Linux
 293     The option can be specified many times.
 294   -T x, --notag x
 295     Comma-separated list of tags not to expand. Examples:
 296       -T year,uuid
 297         Will not expand the year and uuid tags.
 298   -v, --verbose
 299     Increase level of verbosity. Can be repeated.
 300   --version
 301     Print version information.
 302
 303 Initial settings can be stored in '~/.stdrc'. The format is:
 304
 305 key = value
 306
 307 END
 308     exit($Retval);
 309     # }}}
 310 } # usage()
 311
 312 sub msg {
 313     # Print a status message to stderr based on verbosity level {{{
 314     my ($verbose_level, $Txt) = @_;
 315
 316     if ($Opt{'verbose'} >= $verbose_level) {
 317         print(STDERR "$progname: $Txt\n");
 318     }
 319     return;
 320     # }}}
 321 } # msg()
 322
 323 __END__
 324
 325 # This program is free software; you can redistribute it and/or modify
 326 # it under the terms of the GNU General Public License as published by
 327 # the Free Software Foundation; either version 2 of the License, or (at
 328 # your option) any later version.
 329 #
 330 # This program is distributed in the hope that it will be useful, but
 331 # WITHOUT ANY WARRANTY; without even the implied warranty of
 332 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 333 # See the GNU General Public License for more details.
 334 #
 335 # You should have received a copy of the GNU General Public License
 336 # along with this program.
 337 # If not, see L<http://www.gnu.org/licenses/>.
 338
 339 # vim: set fenc=UTF-8 ft=perl fdm=marker ts=4 sw=4 sts=4 et fo+=w :