src/ssic.pl

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