1#!/usr/local/bin/perl 2# makepkg-template - template system for makepkg 3# @configure_input@ 4# 5# Copyright (c) 2013-2018 Pacman Development Team <pacman-dev@archlinux.org> 6# 7# This program is free software; you can redistribute it and/or modify 8# it under the terms of the GNU General Public License as published by 9# the Free Software Foundation; either version 2 of the License, or 10# (at your option) any later version. 11# 12# This program is distributed in the hope that it will be useful, 13# but WITHOUT ANY WARRANTY; without even the implied warranty of 14# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15# GNU General Public License for more details. 16# 17# You should have received a copy of the GNU General Public License 18# along with this program. If not, see <http://www.gnu.org/licenses/>. 19# 20use warnings; 21use strict; 22use v5.10.1; 23use Cwd qw(abs_path); 24use Getopt::Long; 25use Module::Load; 26use Module::Load::Conditional qw(can_load); 27 28my %opts = ( 29 input => '@BUILDSCRIPT@', 30 template_dir => ['@TEMPLATE_DIR@'], 31); 32 33my $template_name_charset = qr/[[:alnum:]+_.@-]/; 34my $template_marker = qr/# template/; 35 36# runtime loading to avoid dependency on cpan since this is the only non-core module 37my $loaded_gettext = can_load(modules => {'Locale::gettext' => undef}); 38if ($loaded_gettext) { 39 Locale::gettext::bindtextdomain("pacman-scripts", '@localedir@'); 40 Locale::gettext::textdomain("pacman-scripts"); 41} 42 43sub gettext { 44 my ($string) = @_; 45 46 if ($loaded_gettext) { 47 return Locale::gettext::gettext($string); 48 } else { 49 return $string; 50 } 51} 52 53sub burp { 54 my ($file_name, @lines) = @_; 55 open (my $fh, ">", $file_name) || die sprintf(gettext("can't create '%s': %s"), $file_name, $!); 56 print $fh @lines; 57 close $fh; 58} 59 60# read a template marker line and parse values into a hash 61# format is "# template (start|input); key=value; key2=value2; ..." 62sub parse_template_line { 63 my ($line, $filename, $linenumber) = @_; 64 my %values; 65 66 my ($marker, @elements) = split(/;\s?/, $line); 67 68 ($values{command}) = ($marker =~ /$template_marker (.*)/); 69 70 foreach my $element (@elements) { 71 my ($key, $val) = ($element =~ /^([a-z0-9]+)=(.*)$/); 72 unless ($key and $val) { 73 die gettext("invalid key/value pair\n"), 74 "$filename:$linenumber: $line"; 75 } 76 $values{$key} = $val; 77 } 78 79 # end doesn't take arguments 80 if ($values{command} ne "end") { 81 if (!$values{name}) { 82 die gettext("invalid template line: can't find template name\n"), 83 "$filename:$linenumber: $line"; 84 } 85 86 unless ($values{name} =~ /^$template_name_charset+$/) { 87 die sprintf(gettext("invalid chars used in name '%s'. allowed: [:alnum:]+_.\@-\n"), $values{name}), 88 "$filename:$linenumber: $line"; 89 } 90 } 91 92 return \%values; 93} 94 95# load a template, process possibly existing markers (nested templates) 96sub load_template { 97 my ($values) = @_; 98 99 my $ret = ""; 100 101 my $template_name = "$values->{name}"; 102 if (!$opts{newest} and $values->{version}) { 103 $template_name .= "-$values->{version}"; 104 } 105 $template_name .= ".template"; 106 107 foreach my $dir (reverse @{$opts{template_dir}}) { 108 my $path = "$dir/$template_name"; 109 if ( -e $path ) { 110 # resolve symlink(s) and use the real file's name for version detection 111 my ($version) = (abs_path($path) =~ /-([0-9.]+)[.]template$/); 112 113 if (!$version) { 114 die sprintf(gettext("Couldn't detect version for template '%s'\n"), $path); 115 } 116 117 my $parsed = process_file($path); 118 119 $ret .= "# template start; name=$values->{name}; version=$version;\n"; 120 $ret .= $parsed; 121 $ret .= "# template end;\n"; 122 return $ret; 123 } 124 } 125 die sprintf(gettext("Failed to find template file matching '%s'\n"), $template_name); 126} 127 128# process input file and load templates for all markers found 129sub process_file { 130 my ($filename) = @_; 131 132 my $ret = ""; 133 my $nesting_level = 0; 134 my $linenumber = 0; 135 136 open (my $fh, "<", $filename) or die sprintf(gettext("failed to open '%s': %s\n"), $filename, $!); 137 my @lines = <$fh>; 138 close $fh; 139 140 foreach my $line (@lines) { 141 $linenumber++; 142 143 if ($line =~ $template_marker) { 144 my $values = parse_template_line($line, $filename, $linenumber); 145 146 if ($values->{command} eq "start" or $values->{command} eq "input") { 147 if ($nesting_level == 0) { 148 $ret .= load_template($values); 149 } 150 } elsif ($values->{command} eq "end") { 151 # nothing to do here, just for completeness 152 } else { 153 die sprintf(gettext("Unknown template marker '%s'\n"), $values->{command}), 154 "$filename:$linenumber: $line"; 155 } 156 157 $nesting_level++ if $values->{command} eq "start"; 158 $nesting_level-- if $values->{command} eq "end"; 159 160 # marker lines should never be added 161 next; 162 } 163 164 # we replace code inside blocks with the template 165 # so we ignore the content of the block 166 next if $nesting_level > 0; 167 168 $ret .= $line; 169 } 170 return $ret; 171} 172 173sub usage { 174 my ($exitstatus) = @_; 175 print gettext("makepkg-template [options]\n"); 176 print "\n"; 177 print gettext("Options:\n"); 178 printf(gettext(" --input, -p <file> Build script to read (default: %s)\n"), '@BUILDSCRIPT@'); 179 print gettext(" --output, -o <file> file to output to (default: input file)\n"); 180 print gettext(" --newest, -n update templates to newest version\n"); 181 print gettext(" (default: use version specified in the template markers)\n"); 182 print gettext(" --template-dir <dir> directory to search for templates\n"); 183 printf(gettext(" (default: %s)\n"), '@TEMPLATE_DIR@'); 184 print gettext(" --help, -h This help message\n"); 185 print gettext(" --version Version information\n"); 186 print "\n"; 187 exit($exitstatus); 188} 189 190sub version { 191 my ($exitstatus) = @_; 192 printf "makepkg-template (pacman) %s\n", '@PACKAGE_VERSION@'; 193 print gettext( 194 'Copyright (c) 2013-2018 Pacman Development Team <pacman-dev@archlinux.org>.'."\n". 195 'This is free software; see the source for copying conditions.'."\n". 196 'There is NO WARRANTY, to the extent permitted by law.'."\n"); 197 exit($exitstatus); 198} 199 200Getopt::Long::Configure ("bundling"); 201GetOptions( 202 "help|h" => sub {usage(0); }, 203 "version" => sub {version(0); }, 204 "input|p=s" => \$opts{input}, 205 "output|o=s" => \$opts{output}, 206 "newest|n" => \$opts{newest}, 207 "template-dir=s@" => \$opts{template_dir}, 208) or usage(1); 209 210$opts{output} = $opts{input} unless $opts{output}; 211 212$opts{input} = "/dev/stdin" if $opts{input} eq "-"; 213$opts{output} = "/dev/stdout" if $opts{output} eq "-"; 214 215burp($opts{output}, process_file($opts{input})); 216