pacman/scripts/makepkg-template.pl.in

#!/usr/bin/perl
#   makepkg-template - template system for makepkg
#   @configure_input@
#
#   Copyright (c) 2013 Pacman Development Team <pacman-dev@archlinux.org>
#
#   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 2 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 warnings;
use strict;
use v5.10.1;
use Cwd qw(abs_path);
use Getopt::Long;
use Module::Load;
use Module::Load::Conditional qw(can_load);

my %opts = (
	input => '@BUILDSCRIPT@',
	template_dir => '@TEMPLATE_DIR@',
);

my $template_name_charset = qr/[[:alnum:]+_.@-]/;
my $template_marker = qr/# template/;

# runtime loading to avoid dependency on cpan since this is the only non-core module
my $loaded_gettext = can_load(modules => {'Locale::gettext' => undef});
if ($loaded_gettext) {
	Locale::gettext::bindtextdomain("pacman-scripts", '@localedir@');
	Locale::gettext::textdomain("pacman-scripts");
}

sub gettext {
	my ($string) = @_;

	if ($loaded_gettext) {
		return Locale::gettext::gettext($string);
	} else {
		return $string;
	}
}

sub burp {
	my ($file_name, @lines) = @_;
	open (my $fh, ">", $file_name) || die sprintf(gettext("can't create '%s': %s"), $file_name, $!);
	print $fh @lines;
	close $fh;
}

# read a template marker line and parse values into a hash
# format is "# template (start|input); key=value; key2=value2; ..."
sub parse_template_line {
	my ($line, $filename, $linenumber) = @_;
	my %values;

	my ($marker, @elements) = split(/;\s?/, $line);

	($values{command}) = ($marker =~ /$template_marker (.*)/);

	foreach my $element (@elements) {
		my ($key, $val) = ($element =~ /^([a-z0-9]+)=(.*)$/);
		unless ($key and $val) {
			die gettext("invalid key/value pair\n%s:%s: %s"),
				"$filename:$linenumber: $line";
		}
		$values{$key} = $val;
	}

	# end doesn't take arguments
	if ($values{command} ne "end") {
		if (!$values{name}) {
			die gettext("invalid template line: can't find template name\n"),
				"$filename:$linenumber: $line";
		}

		unless ($values{name} =~ /^$template_name_charset+$/) {
			die sprintf(gettext("invalid chars used in name '%s'. allowed: [:alnum:]+_.\@-\n"), $values{name}),
				"$filename:$linenumber: $line";
		}
	}

	return \%values;
}

# load a template, process possibly existing markers (nested templates)
sub load_template {
	my ($values) = @_;

	my $ret = "";

	my $path;
	if (!$opts{newest} and $values->{version}) {
		$path = "$opts{template_dir}/$values->{name}-$values->{version}.template";
	} else {
		$path = "$opts{template_dir}/$values->{name}.template";
	}

	# resolve symlink(s) and use the real file's name for version detection
	my ($version) = (abs_path($path) =~ /-([0-9.]+)[.]template$/);

	if (!$version) {
		die sprintf(gettext("Couldn't detect version for template '%s'"), $values->{name});
	}

	my $parsed = process_file($path);

	$ret .= "# template start; name=$values->{name}; version=$version;\n";
	$ret .= $parsed;
	$ret .= "# template end;\n";
	return $ret;
}

# process input file and load templates for all markers found
sub process_file {
	my ($filename) = @_;

	my $ret = "";
	my $nesting_level = 0;
	my $linenumber = 0;

	open (my $fh, "<", $filename) or die sprintf(gettext("failed to open '%s': %s"), $filename, $!);
	my @lines = <$fh>;
	close $fh;

	foreach my $line (@lines) {
		$linenumber++;

		if ($line =~ $template_marker) {
			my $values = parse_template_line($line, $filename, $linenumber);

			if ($values->{command} eq "start" or $values->{command} eq "input") {
				if ($nesting_level == 0) {
					$ret .= load_template($values);
				}
			} elsif ($values->{command} eq "end") {
				# nothing to do here, just for completeness
			} else {
				die sprintf(gettext("Unknown template marker '%s'\n"), $values->{command}),
					"$filename:$linenumber: $line";
			}

			$nesting_level++ if $values->{command} eq "start";
			$nesting_level-- if $values->{command} eq "end";

			# marker lines should never be added
			next;
		}

		# we replace code inside blocks with the template
		# so we ignore the content of the block
		next if $nesting_level > 0;

		$ret .= $line;
	}
	return $ret;
}

sub usage {
	my ($exitstatus) = @_;
	print  gettext("makepkg-template [options]\n");
	print "\n";
	print  gettext("Options:\n");
	printf(gettext("  --input, -p <file>    Build script to read (default: %s)\n"), '@BUILDSCRIPT@');
	print  gettext("  --output, -o <file>   file to output to (default: input file)\n");
	print  gettext("  --newest, -n          update templates to newest version\n");
	print  gettext("                        (default: use version specified in the template markers)\n");
	print  gettext("  --template-dir <dir>  directory to search for templates\n");
	printf(gettext("                        (default: %s)\n"), '@TEMPLATE_DIR@');
	print  gettext("  --help, -h            This help message\n");
	print  gettext("  --version             Version information\n");
	print "\n";
	exit($exitstatus);
}

sub version {
	my ($exitstatus) = @_;
	printf "makepkg-template (pacman) %s\n", '@PACKAGE_VERSION@';
	print gettext(
		'Copyright (c) 2013 Pacman Development Team <pacman-dev@archlinux.org>.'."\n".
		'This is free software; see the source for copying conditions.'."\n".
		'There is NO WARRANTY, to the extent permitted by law.'."\n");
	exit($exitstatus);
}

Getopt::Long::Configure ("bundling");
GetOptions(
	"help|h" => sub {usage(0); },
	"version" => sub {version(0); },
	"input|p=s" => \$opts{input},
	"output|o=s" => \$opts{output},
	"newest|n" => \$opts{newest},
	"template-dir=s" => \$opts{template_dir},
) or usage(1);

$opts{output} = $opts{input} unless $opts{output};

$opts{input} = "/dev/stdin" if $opts{input} eq "-";
$opts{output} = "/dev/stdout" if $opts{output} eq "-";

burp($opts{output}, process_file($opts{input}));

# vim: set noet: