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                         "h|help",
  23                         "V|version",
  24                 )) {
  25                 usage(*STDERR);
  26                 exit(4);
  27         }
  28
  29         if (exists($opts{'h'})) {
  30                 help(*STDERR);
  31                 exit(0);
  32         }
  33         if (exists($opts{'V'})) {
  34                 version(*STDERR);
  35                 exit(0);
  36         }
  37
  38         if ($#ARGV lt 0) {
  39                 error(4, "No input files\n");
  40         }
  41         if (exists($opts{'o'})) {
  42                 if ($#ARGV gt 0) {
  43                         error(4, "Cannot specify -o with multiple files\n");
  44                 }
  45                 compile($ARGV[0], $opts{'o'}, $opts{'D'});
  46         } else {
  47                 for $input (@ARGV) {
  48                         $output = $input;
  49                         $output =~ s/\.[^.]+$/.html/;
  50                         compile($input, $output, $opts{'D'});
  51                 }
  52         }
  53 }
  54
  55 sub usage
  56 {
  57         my ($fh) = @_;
  58
  59         printf($fh "Usage: %s [-o <output>] <input> ...\n", $0);
  60 }
  61
  62 sub help
  63 {
  64         my ($fh) = @_;
  65
  66         usage($fh);
  67         print("Options:\n");
  68         print("  -D <name>=<value>  Set the variable <name> to <value>\n");
  69         print("  -o <output>        Place the output into <output>\n");
  70         print("  -h, --help         Display this information\n");
  71         print("  -V, --version      Display compiler version information\n");
  72 }
  73
  74 sub version
  75 {
  76         my ($fh) = @_;
  77
  78         print("ssic 0.1.0\n");
  79         print("Copyright (C) 2013 Patrick \"P. J.\" McDermott\n");
  80         print("License GPLv3+: GNU GPL version 3 or later " .
  81                 "<http://gnu.org/licenses/gpl.html>.\n");
  82         print("This is free software: you are free to change and " .
  83                 "redistribute it.\n");
  84         print("There is NO WARRANTY, to the extent permitted by law.\n");
  85 }
  86
  87 sub warning
  88 {
  89         my ($fmt, $args) = @_;
  90
  91         printf("ssic: Warning: " . $fmt, $args);
  92 }
  93
  94 sub error
  95 {
  96         my ($status, $fmt, $args) = @_;
  97
  98         printf("ssic: Error: " . $fmt, $args);
  99         exit($status);
 100 }
 101
 102 sub compile
 103 {
 104         my ($input, $output, $vars) = @_;
 105         my $input_fh;
 106         my $output_fh;
 107         my $ssi;
 108         my $var_name;
 109         my $var_value;
 110
 111         if ($input eq $output) {
 112                 error(4, "Input and output files are equal\n");
 113         }
 114
 115         open($input_fh, "<", $input);
 116         open($output_fh, ">", $output);
 117
 118         %ENV = (
 119                 "DOCUMENT_NAME" => $input,
 120                 "DOCUMENT_URI" => $input,
 121         );
 122
 123         $CGI::SSI::DEBUG = 0;
 124         $ssi = CGI::SSI->new(
 125                 "DOCUMENT_NAME" => $input,
 126                 "DOCUMENT_URI" => $input,
 127         );
 128
 129         while (($var_name, $var_value) = each(%{$vars})) {
 130                 $ssi->set($var_name => $var_value);
 131         }
 132
 133         print($output_fh $ssi->process(<$input_fh>));
 134 }
 135
 136 main();