#!/usr/bin/perl
#
# ssic - Server Side Includes Compiler
#
# Copyright (C) 2013  Patrick "P. J." McDermott
#
# This program is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program.  If not, see <http://www.gnu.org/licenses/>.

use strict;
use warnings;

use Getopt::Long;
use CGI::SSI;

sub main
{
	my %opts;
	my $ssi;
	my $input;
	my $output;

	$SIG{'__WARN__'} = \&warning;

	Getopt::Long::Configure("no_ignore_case", "bundling", "gnu_compat",
		"no_getopt_compat");
	if (not GetOptions(\%opts,
			"o=s",
			"D=s%",
			"I=s",
			"h|help",
			"V|version",
		)) {
		usage(*STDERR);
		exit(4);
	}

	if (exists($opts{'h'})) {
		help(*STDOUT);
		exit(0);
	}
	if (exists($opts{'V'})) {
		version(*STDOUT);
		exit(0);
	}

	if ($#ARGV lt 0) {
		error(4, "No input files\n");
	}

	$ssi = init_compiler($opts{'D'}, $opts{'I'});

	if (exists($opts{'o'})) {
		if ($#ARGV gt 0) {
			error(4, "Cannot specify -o with multiple files\n");
		}
		compile($ssi, $ARGV[0], $opts{'o'});
	} else {
		for $input (@ARGV) {
			$output = $input;
			$output =~ s/\.[^.]+$/.html/;
			compile($ssi, $input, $output);
		}
	}

	undef $ssi;
}

sub usage
{
	my ($fh) = @_;

	printf($fh "Usage: %s [-o <output>] <input> ...\n", $0);
}

sub help
{
	my ($fh) = @_;

	usage($fh);
	print("Options:\n");
	print("  -D <name>=<value>  Set the variable <name> to <value>\n");
	print("  -I <directory>     Set the document root to <directory>\n");
	print("  -o <output>        Place the output into <output>\n");
	print("  -h, --help         Display this information\n");
	print("  -V, --version      Display compiler version information\n");
}

sub version
{
	my ($fh) = @_;

	print("ssic 0.1.0\n");
	print("Copyright (C) 2013 Patrick \"P. J.\" McDermott\n");
	print("License GPLv3+: GNU GPL version 3 or later " .
		"<http://gnu.org/licenses/gpl.html>.\n");
	print("This is free software: you are free to change and " .
		"redistribute it.\n");
	print("There is NO WARRANTY, to the extent permitted by law.\n");
}

sub warning
{
	my ($fmt, @args) = @_;

	printf(STDERR "ssic: Warning: " . $fmt, @args);
}

sub error
{
	my ($status, $fmt, @args) = @_;

	printf(STDERR "ssic: Error: " . $fmt, @args);
	exit($status);
}

sub init_compiler
{
	my ($vars, $root) = @_;
	my $ssi;
	my $var_name;
	my $var_value;

	%ENV = (
		"DOCUMENT_ROOT" => $root,
	);

	$CGI::SSI::DEBUG = 0;
	$ssi = CGI::SSI->new();

	$ssi->set("DOCUMENT_ROOT" => $root);

	while (($var_name, $var_value) = each(%{$vars})) {
		$ssi->set($var_name => $var_value);
	}

	return $ssi;
}

sub compile
{
	my ($ssi, $input, $output) = @_;
	my $input_fh;
	my $input_abs;
	my $output_fh;

	if ($input eq $output and $input ne "-") {
		warning("Input and output files are equal\n");
	}

	if ($input eq "-") {
		$input_fh = *STDIN;
		$input_abs = File::Spec->rel2abs(".");
	} else {
		if (not open($input_fh, "<", $input)) {
			error(4, "%s: %s\n", $input, $!);
		}
		$input_abs = File::Spec->rel2abs($input);
	}
	if ($output eq "-") {
		$output_fh = *STDOUT;
	} else {
		if (not open($output_fh, ">", $output . "~")) {
			error(4, "%s: %s\n", $output . "~", $!);
		}
	}

	# CGI::SSI uses SCRIPT_FILENAME to determine the value of LAST_MODIFIED.
	$ENV{"DOCUMENT_NAME"} = $input;
	$ENV{"DOCUMENT_URI"} = $input;
	$ENV{"SCRIPT_FILENAME"} = $input_abs;

	# Reset config tags to default values.
	$ssi->config("errmsg",
		"[an error occurred while processing this directive]");
	$ssi->config("sizefmt", "abbrev");
	$ssi->config("timefmt", undef);

	$ssi->set("DOCUMENT_NAME" => $input);
	$ssi->set("DOCUMENT_URI" => $input);

	print($output_fh $ssi->process(<$input_fh>));

	if ($input ne "-") {
		close($input_fh);
	}
	if ($output ne "-") {
		close($output_fh);
		if (not rename($output . "~", $output)) {
			error(4, "%s: %s\n", $output, $!);
		}
	}
}

main();