src/ssic.pl

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Getopt::Long;
   7 use CGI::SSI;
   8
   9 sub main
  10 {
  11         my %opts;
  12         my $input;
  13         my $output;
  14
  15         $SIG{'__WARN__'} = \&warning;
  16
  17         Getopt::Long::Configure("no_ignore_case", "bundling", "gnu_compat",
  18                 "no_getopt_compat");
  19         if (not GetOptions(\%opts,
  20                         "o=s",
  21                         "D=s%",
  22                         "I=s",
  23                         "h|help",
  24                         "V|version",
  25                 )) {
  26                 usage(*STDERR);
  27                 exit(4);
  28         }
  29
  30         if (exists($opts{'h'})) {
  31                 help(*STDERR);
  32                 exit(0);
  33         }
  34         if (exists($opts{'V'})) {
  35                 version(*STDERR);
  36                 exit(0);
  37         }
  38
  39         if ($#ARGV lt 0) {
  40                 error(4, "No input files\n");
  41         }
  42         if (exists($opts{'o'})) {
  43                 if ($#ARGV gt 0) {
  44                         error(4, "Cannot specify -o with multiple files\n");
  45                 }
  46                 compile($ARGV[0], $opts{'o'}, $opts{'D'}, $opts{'I'});
  47         } else {
  48                 for $input (@ARGV) {
  49                         $output = $input;
  50                         $output =~ s/\.[^.]+$/.html/;
  51                         compile($input, $output, $opts{'D'}, $opts{'I'});
  52                 }
  53         }
  54 }
  55
  56 sub usage
  57 {
  58         my ($fh) = @_;
  59
  60         printf($fh "Usage: %s [-o <output>] <input> ...\n", $0);
  61 }
  62
  63 sub help
  64 {
  65         my ($fh) = @_;
  66
  67         usage($fh);
  68         print("Options:\n");
  69         print("  -D <name>=<value>  Set the variable <name> to <value>\n");
  70         print("  -I <directory>     Set the document root to <directory>\n");
  71         print("  -o <output>        Place the output into <output>\n");
  72         print("  -h, --help         Display this information\n");
  73         print("  -V, --version      Display compiler version information\n");
  74 }
  75
  76 sub version
  77 {
  78         my ($fh) = @_;
  79
  80         print("ssic 0.1.0\n");
  81         print("Copyright (C) 2013 Patrick \"P. J.\" McDermott\n");
  82         print("License GPLv3+: GNU GPL version 3 or later " .
  83                 "<http://gnu.org/licenses/gpl.html>.\n");
  84         print("This is free software: you are free to change and " .
  85                 "redistribute it.\n");
  86         print("There is NO WARRANTY, to the extent permitted by law.\n");
  87 }
  88
  89 sub warning
  90 {
  91         my ($fmt, @args) = @_;
  92
  93         printf("ssic: Warning: " . $fmt, @args);
  94 }
  95
  96 sub error
  97 {
  98         my ($status, $fmt, @args) = @_;
  99
 100         printf("ssic: Error: " . $fmt, @args);
 101         exit($status);
 102 }
 103
 104 sub compile
 105 {
 106         my ($input, $output, $vars, $root) = @_;
 107         my $input_fh;
 108         my $input_abs;
 109         my $output_fh;
 110         my $ssi;
 111         my $var_name;
 112         my $var_value;
 113
 114         if ($input eq $output and $input ne "-") {
 115                 warning("Input and output files are equal\n");
 116         }
 117
 118         if ($input eq "-") {
 119                 $input_fh = *STDIN;
 120                 $input_abs = File::Spec->rel2abs(".");
 121         } else {
 122                 if (not open($input_fh, "<", $input)) {
 123                         error(4, "%s: %s\n", $input, $!);
 124                 }
 125                 $input_abs = File::Spec->rel2abs($input);
 126         }
 127         if ($output eq "-") {
 128                 $output_fh = *STDOUT;
 129         } else {
 130                 if (not open($output_fh, ">", $output . "~")) {
 131                         error(4, "%s: %s\n", $output . "~", $!);
 132                 }
 133         }
 134
 135         # CGI::SSI uses SCRIPT_FILENAME to determine the value of LAST_MODIFIED.
 136         %ENV = (
 137                 "DOCUMENT_NAME" => $input,
 138                 "DOCUMENT_URI" => $input,
 139                 "DOCUMENT_ROOT" => $root,
 140                 "SCRIPT_FILENAME" => $input_abs,
 141         );
 142
 143         $CGI::SSI::DEBUG = 0;
 144         $ssi = CGI::SSI->new(
 145                 "DOCUMENT_NAME" => $input,
 146                 "DOCUMENT_URI" => $input,
 147                 "DOCUMENT_ROOT" => $root,
 148         );
 149
 150         while (($var_name, $var_value) = each(%{$vars})) {
 151                 $ssi->set($var_name => $var_value);
 152         }
 153
 154         print($output_fh $ssi->process(<$input_fh>));
 155
 156         if ($input ne "-") {
 157                 close($input_fh);
 158         }
 159         if ($output ne "-") {
 160                 close($output_fh);
 161         }
 162
 163         if (not rename($output . "~", $output)) {
 164                 error(4, "%s: %s\n", $output, $!);
 165         }
 166 }
 167
 168 main();