3
# Copyright (C) 2011 Modestas Vainius <modax@debian.org>
5
# This program is free software: you can redistribute it and/or modify
6
# it under the terms of the GNU General Public License as published by
7
# the Free Software Foundation, either version 3 of the License, or
8
# (at your option) any later version.
10
# This program is distributed in the hope that it will be useful,
11
# but WITHOUT ANY WARRANTY; without even the implied warranty of
12
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13
# GNU General Public License for more details.
15
# You should have received a copy of the GNU General Public License
16
# along with this program. If not, see <http://www.gnu.org/licenses/>
21
package Debian::PkgKde::Dhmk::DhCompat;
26
sub _find_cmd_and_do {
27
# &$proc($cmd_array_ref, $cmd_index_ref)
28
my ($proc, $command) = @_;
29
foreach my $tname (keys %$targets) {
30
my $tcmds = $targets->{$tname}{cmds};
31
for (my $i = 0; $i < @$tcmds; $i++) {
32
if (!defined($command) || $tcmds->[$i] eq $command) {
41
s/'/'"'"'/g foreach @opts;
43
return map({ "'$_'" } @opts);
45
return "'" . join("' '", @opts) . "'";
49
############### Dh Addon API ############################
51
# Insert $new_command in sequences before $existing_command
53
my ($existing_command, $new_command) = @_;
54
return _find_cmd_and_do(sub {
55
my ($cmds, $i) = ($_[0], ${$_[1]});
57
unshift @$cmds, $new_command;
59
my @tail = splice(@$cmds, $i);
60
push @$cmds, $new_command, @tail;
63
}, $existing_command);
66
# Insert $new_command in sequences after $existing_command
68
my ($existing_command, $new_command) = @_;
69
return _find_cmd_and_do(sub {
70
my ($cmds, $i) = ($_[0], ${$_[1]});
71
my @tail = ($i < $#{$cmds}) ? splice(@$cmds, $i+1) : ();
72
# print $#_, join("--", @tail), "\n";
73
push @$cmds, $new_command, @tail;
75
}, $existing_command);
78
# Remove $existing_command from the list of commands to run in all sequences.
80
my ($existing_command) = @_;
81
return _find_cmd_and_do(sub {
82
my ($cmds, $i) = ($_[0], ${$_[1]});
83
splice(@$cmds, $i, 1);
85
}, $existing_command);
88
# Add $new_command to the beginning of the specified sequence. If the sequence
89
# does not exist, it will be created.
91
my ($new_command, $sequence) = @_;
92
if (exists $targets->{$sequence}) {
93
unshift @{$targets->{$sequence}{cmds}}, $new_command;
95
$targets->{$sequence} = { cmds => [ $new_command ], deps => "" };
99
# Append $opt1, $opt2 etc. to the list of additional options which dh passes
100
# when running the specified $command.
101
sub add_command_options {
102
my ($command, @opts) = @_;
103
push @{$extra_cmd_opts{$command}}, @opts;
106
# Remove @opts from the list of additional options which dh passes when running
107
# the specified $command. If @opts is empty, remove all extra options
108
sub remove_command_options {
109
my ($command, @opts) = @_;
110
if (exists $extra_cmd_opts{$command}) {
112
delete $extra_cmd_opts{$command};
114
my $re = "(" . join("|", map {"\Q$_\E"} @opts) . ")";
115
$extra_cmd_opts{$command} = [ grep { !/^$re$/ } @{$extra_cmd_opts{$command}} ];
120
########### Main module subroutines ###################
125
$targets = $opts{targets};
133
# Backup current environment in order to export changes which addons have
137
foreach my $addon (@addons) {
138
my $mod="Debian::Debhelper::Sequence::$addon";
142
die "unable to load addon $addon: $@";
146
# Compare environment and note changes
147
foreach my $e (keys %ENV) {
148
if (!exists $oldenv{$e} || (($ENV{$e} || "") ne ($oldenv{$e} || "")))
150
$env_changes{$e} = { old => $oldenv{$e}, new => $ENV{$e} };
154
# Merge $extra_cmd_opts to $targets
155
foreach my $c (keys %extra_cmd_opts) {
156
next if !@{$extra_cmd_opts{$c}};
157
_find_cmd_and_do(sub {
158
my ($cmds, $i) = ($_[0], ${$_[1]});
159
$cmds->[$i] .= " " . _escape_shell(@{$extra_cmd_opts{$c}});
163
return \%env_changes;
166
# Generate extra options from command line options
169
# Convert "--option value" syntax to --option=value like dh(1) would do
170
foreach my $opt (@_) {
173
} elsif (@opts && $opts[$#opts] =~ /^--/) {
174
$opts[$#opts] .= "=" . $opt;
179
return join(" ", map({ s/^'-/-O'-/; $_ } _escape_shell(@opts)));
188
$filename =~ s,^.*/([^/]+)/*$,$1,;
194
$filename =~ s,[^/]+/*$,,;
198
sub parse_commands_file {
203
open (my $fh, "<", $filename) or
204
die "unable to open dhmk commands file $filename: $!";
212
# Use $targetname in place of a command to insert commands from the
213
# previously defined target.
214
while (my $line = <$fh>) {
216
if ($line =~ /^\s*#/ || $line =~ /^\s*$/) {
217
next; # comment or empty line
218
} elsif ($line =~ /^(\S.+):\s*(.*)$/) {
220
$targets{$t}{deps} = $2 || "";
221
$targets{$t}{cmds} = [];
222
} elsif (defined $t) {
223
if ($line =~ /^\s+(.*)$/) {
225
# If it's a variable, dereference it
226
if ($c =~ /^\s*\$(\S+)\s*$/) {
227
if (exists $targets{$1}) {
228
push @{$targets{$t}{cmds}}, @{$targets{$1}{cmds}};
230
die "could not dereference variable \$$1. Target '$1' was not defined yet";
233
push @{$targets{$t}{cmds}}, $c;
236
die "dangling command '$line'. Missing target definition";
239
die "invalid commands file syntax";
252
my $opts_need_values = qr/with(?:out)?/;
253
my $opts_no_values = qr//;
254
foreach my $arg (@ARGV) {
255
if ($optname eq "--") {
257
} elsif ($optname && !defined $optval) {
259
} elsif ($arg eq "--") {
262
} elsif ($arg =~ /^--($opts_need_values)=(.*)$/) {
265
} elsif ($arg =~ /^--($opts_need_values)$/) {
268
} elsif ($arg =~ /^--($opts_no_values)=(.*)$/) {
269
die "option $1 does not accept a value";
270
} elsif ($arg =~ /^--($opts_no_values)$/) {
276
if (defined $optval) {
277
if ($optname eq "" || $optname eq "--") {
278
push @extraopts, $optval;
279
# Do not reset $optname
281
if ($optname =~ /^$opts_need_values$/) {
283
die "option $optname requires a value";
285
if ($optname eq "with") {
286
push @addons, split(/,/, $optval);
287
} elsif ($optname eq "without") {
288
@addons = grep { $_ ne $optval } @addons;
290
die "internal bug: unrecognized dhmk.pl option: $optname (val: $optval)";
292
} elsif ($optname =~ /^$opts_no_values$/) {
293
# No such options exist yet
295
die "unrecognized command line option: $optname";
303
return ( addons => \@addons, extraopts => \@extraopts );
309
foreach my $t (values %$targets) {
310
foreach my $c (@{$t->{cmds}}) {
311
$cmds{$1} = 1 if $c =~ /^(\S+)/;
314
return sort keys %cmds;
317
sub get_override_info {
318
my ($rules_file, @commands) = @_;
319
my $magic = "##dhmk_no_override##";
321
# Initialize all overrides first
323
my @override_targets;
324
foreach my $c (@commands) {
326
push @override_targets, "override_$c";
329
# Now remove overrides based on the rules file output
330
my $saved_makeflags = $ENV{MAKEFLAGS};
331
delete $ENV{MAKEFLAGS};
332
open(my $make, "-|", "make", "-f", $rules_file, "-j1", "-n",
333
"--no-print-directory",
335
"dhmk_override_info_mode=yes") or
336
die "unable to execute make for override calculation: $!";
337
while (my $line = <$make>) {
338
if ($line =~ /^$magic(.*)$/ && exists $overrides{$1}) {
339
delete $overrides{$1};
343
die "make (get_override_info) failed with $?";
345
$ENV{MAKEFLAGS} = $saved_makeflags if defined $saved_makeflags;
350
sub write_definevar {
351
my ($fh, $name, $value, $escape) = @_;
352
$escape = 1 if !defined $escape;
355
$value =~ s/\$/\$\$/g if $escape;
356
print $fh "define $name", "\n", $value, "\n", "endef", "\n";
358
print $fh "$name =", "\n";
362
sub write_exportvar {
363
my ($fh, $name,$export) = @_;
364
$export = "export" if !defined $export;
365
print $fh "$export $name", "\n";
368
sub write_dhmk_rules {
369
my ($dhmk_file, $rules_file, $targets, $overrides,
370
$extraopts, $env_changes) = @_;
372
open (my $fh, ">", $dhmk_file) or
373
die "unable to open dhmk rules file ($dhmk_file) for writing: $!";
374
print $fh "# This file was automatically generated by ", basename($0), "\n";
375
print $fh "# DO NOT edit as your changes will eventually be lost.", "\n";
376
print $fh "# DO NOT include this file in the source package.", "\n";
378
print $fh "# Action command sequences", "\n";
379
foreach my $tname (keys %$targets) {
380
my $t = $targets->{$tname};
382
foreach my $cline (@{$t->{cmds}}) {
383
my $c = ($cline =~ /^(\S+)/) && $1;
385
print $fh $tname, "_", $c, " = ", $cline, "\n";
387
print $fh "dhmk_", $tname, "_commands = ", join(" ", @commands), "\n";
388
print $fh "dhmk_", $tname, "_depends = ", $t->{deps}, "\n";
392
print $fh "# Overrides", "\n";
393
foreach my $o (sort keys %$overrides) {
394
print $fh "dhmk_override_", $o, " = yes", "\n";
398
# Export specified extra options for debhelper programs (e.g. for use in
401
print $fh "# Export specified extra options for debhelper programs", "\n";
402
write_definevar($fh, "DHMK_OPTIONS", $extraopts, 0);
403
write_exportvar($fh, "DHMK_OPTIONS");
407
if (keys %$env_changes) {
408
print $fh "# Export environment changes", "\n";
409
foreach my $e (keys %$env_changes) {
410
print $fh "dhmk_envvar_orig_$e := \$($e)\n";
411
if (defined ($env_changes->{$e}{new})) {
412
write_definevar($fh, $e, $env_changes->{$e}{new});
414
write_export($fh, $e, "unexport");
417
# Restore all modified environment variables when remaking $dhmk_file
418
foreach my $e (keys %$env_changes) {
419
print $fh "$dhmk_file: $e = \$(dhmk_envvar_orig_$e)", "\n";
427
my $COMMANDS_FILE = dirname($0) . "/commands";
428
my $DHMK_RULES_FILE = "debian/dhmk_rules.mk";
429
my $RULES_FILE = "debian/rules";
432
my $targets = parse_commands_file($COMMANDS_FILE);
433
my %cmdopts = parse_cmdline();
437
Debian::PkgKde::Dhmk::DhCompat::init(targets => $targets);
438
if (@{$cmdopts{addons}}) {
439
$env_changes = Debian::PkgKde::Dhmk::DhCompat::load_addons(@{$cmdopts{addons}});
441
die "unable to load requested dh addons: " . join(", ", @{$cmdopts{addons}});
444
if (@{$cmdopts{extraopts}}) {
445
$shextraopts = Debian::PkgKde::Dhmk::DhCompat::gen_extraopts(@{$cmdopts{extraopts}});
447
my $overrides = get_override_info($RULES_FILE, get_commands($targets));
448
write_dhmk_rules($DHMK_RULES_FILE, $RULES_FILE, $targets, $overrides,
449
$shextraopts, $env_changes);
added
removed
qt-kde-team/3/dhmk.pl
