bin/ssic

   1 #!/usr/bin/perl
   2 #
   3 # ssic - Server Side Includes Compiler
   4 #
   5 # Copyright (C) 2013  Patrick "P. J." McDermott
   6 #
   7 # This program is free software: you can redistribute it and/or modify
   8 # it under the terms of the GNU General Public License as published by
   9 # the Free Software Foundation, either version 3 of the License, or
  10 # (at your option) any later version.
  11 #
  12 # This program is distributed in the hope that it will be useful,
  13 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15 # GNU General Public License for more details.
  16 #
  17 # You should have received a copy of the GNU General Public License
  18 # along with this program.  If not, see <http://www.gnu.org/licenses/>.
  19
  20 use strict;
  21 use warnings;
  22
  23 use Getopt::Long;
  24 use CGI::SSI;
  25
  26 sub main
  27 {
  28         my %opts;
  29         my $ssi;
  30         my $input;
  31         my $output;
  32
  33         $SIG{'__WARN__'} = \&warning;
  34
  35         Getopt::Long::Configure("no_ignore_case", "bundling", "gnu_compat",
  36                 "no_getopt_compat");
  37         if (not GetOptions(\%opts,
  38                         "o=s",
  39                         "D=s%",
  40                         "I=s",
  41                         "h|help",
  42                         "V|version",
  43                 )) {
  44                 usage(*STDERR);
  45                 exit(4);
  46         }
  47
  48         if (exists($opts{'h'})) {
  49                 help(*STDOUT);
  50                 exit(0);
  51         }
  52         if (exists($opts{'V'})) {
  53                 version(*STDOUT);
  54                 exit(0);
  55         }
  56
  57         if ($#ARGV lt 0) {
  58                 error(4, "No input files\n");
  59         }
  60
  61         $ssi = init_compiler($opts{'D'}, $opts{'I'});
  62
  63         if (exists($opts{'o'})) {
  64                 if ($#ARGV gt 0) {
  65                         error(4, "Cannot specify -o with multiple files\n");
  66                 }
  67                 compile($ssi, $ARGV[0], $opts{'o'});
  68         } else {
  69                 for $input (@ARGV) {
  70                         $output = $input;
  71                         $output =~ s/\.[^.]+$/.html/;
  72                         compile($ssi, $input, $output);
  73                 }
  74         }
  75
  76         undef $ssi;
  77 }
  78
  79 sub usage
  80 {
  81         my ($fh) = @_;
  82
  83         printf($fh "Usage: %s [-o <output>] <input> ...\n", $0);
  84 }
  85
  86 sub help
  87 {
  88         my ($fh) = @_;
  89
  90         usage($fh);
  91         print("Options:\n");
  92         print("  -D <name>=<value>  Set the variable <name> to <value>\n");
  93         print("  -I <directory>     Set the document root to <directory>\n");
  94         print("  -o <output>        Place the output into <output>\n");
  95         print("  -h, --help         Display this information\n");
  96         print("  -V, --version      Display compiler version information\n");
  97 }
  98
  99 sub version
 100 {
 101         my ($fh) = @_;
 102
 103         print("ssic 0.1.0\n");
 104         print("Copyright (C) 2013 Patrick \"P. J.\" McDermott\n");
 105         print("License GPLv3+: GNU GPL version 3 or later " .
 106                 "<http://gnu.org/licenses/gpl.html>.\n");
 107         print("This is free software: you are free to change and " .
 108                 "redistribute it.\n");
 109         print("There is NO WARRANTY, to the extent permitted by law.\n");
 110 }
 111
 112 sub warning
 113 {
 114         my ($fmt, @args) = @_;
 115
 116         printf(STDERR "ssic: Warning: " . $fmt, @args);
 117 }
 118
 119 sub error
 120 {
 121         my ($status, $fmt, @args) = @_;
 122
 123         printf(STDERR "ssic: Error: " . $fmt, @args);
 124         exit($status);
 125 }
 126
 127 sub init_compiler
 128 {
 129         my ($vars, $root) = @_;
 130         my $ssi;
 131         my $var_name;
 132         my $var_value;
 133
 134         %ENV = (
 135                 "DOCUMENT_ROOT" => $root,
 136         );
 137
 138         $CGI::SSI::DEBUG = 0;
 139         $ssi = CGI::SSI->new();
 140
 141         $ssi->set("DOCUMENT_ROOT" => $root);
 142
 143         while (($var_name, $var_value) = each(%{$vars})) {
 144                 $ssi->set($var_name => $var_value);
 145         }
 146
 147         return $ssi;
 148 }
 149
 150 sub compile
 151 {
 152         my ($ssi, $input, $output) = @_;
 153         my $input_fh;
 154         my $input_abs;
 155         my $output_fh;
 156
 157         if ($input eq $output and $input ne "-") {
 158                 warning("Input and output files are equal\n");
 159         }
 160
 161         if ($input eq "-") {
 162                 $input_fh = *STDIN;
 163                 $input_abs = File::Spec->rel2abs(".");
 164         } else {
 165                 if (not open($input_fh, "<", $input)) {
 166                         error(4, "%s: %s\n", $input, $!);
 167                 }
 168                 $input_abs = File::Spec->rel2abs($input);
 169         }
 170         if ($output eq "-") {
 171                 $output_fh = *STDOUT;
 172         } else {
 173                 if (not open($output_fh, ">", $output . "~")) {
 174                         error(4, "%s: %s\n", $output . "~", $!);
 175                 }
 176         }
 177
 178         # CGI::SSI uses SCRIPT_FILENAME to determine the value of LAST_MODIFIED.
 179         $ENV{"DOCUMENT_NAME"} = $input;
 180         $ENV{"DOCUMENT_URI"} = $input;
 181         $ENV{"SCRIPT_FILENAME"} = $input_abs;
 182
 183         # Reset config tags to default values.
 184         $ssi->config("errmsg",
 185                 "[an error occurred while processing this directive]");
 186         $ssi->config("sizefmt", "abbrev");
 187         $ssi->config("timefmt", undef);
 188
 189         $ssi->set("DOCUMENT_NAME" => $input);
 190         $ssi->set("DOCUMENT_URI" => $input);
 191
 192         print($output_fh $ssi->process(<$input_fh>));
 193
 194         if ($input ne "-") {
 195                 close($input_fh);
 196         }
 197         if ($output ne "-") {
 198                 close($output_fh);
 199                 if (not rename($output . "~", $output)) {
 200                         error(4, "%s: %s\n", $output, $!);
 201                 }
 202         }
 203 }
 204
 205 main();