1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
|
#!/usr/bin/perl
#
# Internal library functions for the dh(1) command
package Debian::Debhelper::Sequence;
use strict;
use warnings;
use Exporter qw(import);
use Debian::Debhelper::Dh_Lib qw(getpackages);
use Debian::Debhelper::SequencerUtil qw(extract_rules_target_name sequence_type SEQUENCE_NO_SUBSEQUENCES
SEQUENCE_ARCH_INDEP_SUBSEQUENCES SEQUENCE_TYPE_ARCH_ONLY SEQUENCE_TYPE_INDEP_ONLY SEQUENCE_TYPE_BOTH);
sub _as_command {
my ($input) = @_;
if (ref($input) eq 'HASH') {
return $input;
}
my $rules_target = extract_rules_target_name($input);
if (defined($rules_target)) {
my $sequence_type = sequence_type($rules_target);
return {
'command' => $input,
'command-options' => [],
'sequence-limitation' => $sequence_type,
}
}
return {
'command' => $input,
'command-options' => [],
'sequence-limitation' => SEQUENCE_TYPE_BOTH,
}
}
sub new {
my ($class, $name, $sequence_type, @cmds) = @_;
return bless({
'_name' => $name,
'_subsequences' => $sequence_type,
'_cmds' => [map {_as_command($_)} @cmds],
}, $class);
}
sub name {
my ($this) = @_;
return $this->{'_name'};
}
sub allowed_subsequences {
my ($this) = @_;
return $this->{'_subsequences'};
}
sub _insert {
my ($this, $offset, $existing, $new) = @_;
my @list = @{$this->{'_cmds'}};
my @new;
my $new_cmd = _as_command($new);
foreach my $command (@list) {
if ($command->{'command'} eq $existing) {
push(@new, $new_cmd) if $offset < 0;
push(@new, $command);
push(@new, $new_cmd) if $offset > 0;
} else {
push(@new, $command);
}
}
$this->{'_cmds'} = \@new;
return;
}
sub remove_command {
my ($this, $command) = @_;
$this->{'_cmds'} = [grep { $_->{'command'} ne $command } @{$this->{'_cmds'}}];
return;
}
sub add_command_at_start {
my ($this, $command) = @_;
unshift(@{$this->{'_cmds'}}, _as_command($command));
return;
}
sub add_command_at_end {
my ($this, $command) = @_;
push(@{$this->{'_cmds'}}, _as_command($command));
return;
}
sub rules_target_name {
my ($this, $sequence_type) = @_;
die("Internal error: Invalid sequence type $sequence_type") if $sequence_type eq SEQUENCE_NO_SUBSEQUENCES;
my $name = $this->{'_name'};
my $allowed_sequence_type = $this->{'_subsequences'};
if ($sequence_type ne SEQUENCE_TYPE_BOTH and $allowed_sequence_type eq SEQUENCE_NO_SUBSEQUENCES) {
die("Internal error: Requested subsequence ${sequence_type} of sequence ${name}, but it has no subsequences");
}
if ($sequence_type ne SEQUENCE_TYPE_BOTH) {
return "${name}-${sequence_type}";
}
return $name;
}
sub as_rules_target_command {
my ($this) = shift;
my $rules_name = $this->rules_target_name(@_);
return "debian/rules ${rules_name}";
}
sub flatten_sequence {
my ($this, $sequence_type) = @_;
die("Invalid sequence type $sequence_type") if $sequence_type eq SEQUENCE_NO_SUBSEQUENCES;
my @cmds;
my $has_arch_pkgs = getpackages("arch") ? 1 : 0;
my $has_indep_pkgs = getpackages("indep") ? 1 : 0;
for my $cmd_desc (@{$this->{'_cmds'}}) {
my $seq_limitation = $cmd_desc->{'sequence-limitation'};
next if ($seq_limitation eq SEQUENCE_TYPE_ARCH_ONLY and not $has_arch_pkgs);
next if ($seq_limitation eq SEQUENCE_TYPE_INDEP_ONLY and not $has_indep_pkgs);
if ($seq_limitation eq $sequence_type or $sequence_type eq SEQUENCE_TYPE_BOTH or $seq_limitation eq SEQUENCE_TYPE_BOTH) {
my $cmd = $cmd_desc->{'command'};
my @cmd_options = $cmd_desc->{'command-options'};
push(@cmds, [$cmd, @cmd_options]);
next;
}
}
return @cmds;
}
1;
|
