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 $output_fh;
 109         my $ssi;
 110         my $var_name;
 111         my $var_value;
 112
 113         if ($input eq $output) {
 114                 error(4, "Input and output files are equal\n");
 115         }
 116
 117         if ($input eq "-") {
 118                 $input_fh = *STDIN;
 119         } else {
 120                 if (not open($input_fh, "<", $input)) {
 121                         error(4, "%s: %s\n", $input, $!);
 122                 }
 123         }
 124         if ($output eq "-") {
 125                 $output_fh = *STDOUT;
 126         } else {
 127                 if (not open($output_fh, ">", $output)) {
 128                         error(4, "%s: %s\n", $output, $!);
 129                 }
 130         }
 131
 132         %ENV = (
 133                 "DOCUMENT_NAME" => $input,
 134                 "DOCUMENT_URI" => $input,
 135                 "DOCUMENT_ROOT" => $root,
 136         );
 137
 138         $CGI::SSI::DEBUG = 0;
 139         $ssi = CGI::SSI->new(
 140                 "DOCUMENT_NAME" => $input,
 141                 "DOCUMENT_URI" => $input,
 142                 "DOCUMENT_ROOT" => $root,
 143         );
 144
 145         while (($var_name, $var_value) = each(%{$vars})) {
 146                 $ssi->set($var_name => $var_value);
 147         }
 148
 149         print($output_fh $ssi->process(<$input_fh>));
 150 }
 151
 152 main();