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
133
134
135
136
137
138
139
140
141
142
|
#!/usr/bin/perl -w
use strict;
# depends on: dpkg, tsort, perl
# This script should be handed a list of add-on packages on stdin, and
# it will sort them according to their dependencies. It will also add
# in other add-on packages that aren't mentioned, but are needed.
my $lib_dir = "/usr/lib/emacsen-common";
my $var_dir = "/var/lib/emacsen-common";
my $installed_add_on_pkgs = undef;
sub cwd {
my $result = `pwd`;
chomp $result;
return $result;
}
sub installed_add_on_packages_list {
# Caches value for future use...
if(! defined(@$installed_add_on_pkgs)) {
my $oldir = cwd();
chdir($lib_dir . "/packages/install/") or die "couldn't chdir";
@$installed_add_on_pkgs = glob("*");
chdir($oldir);
}
return $installed_add_on_pkgs;
}
sub get_package_status {
my($pkg) = @_;
my $status = `dpkg --status $pkg`;
$status =~ s/\n\s+//gmo; # handle any continuation lines...
return $status;
}
sub filter_depends {
my($depends_string, $installed_add_ons) = @_;
# Filter out all the "noise" (version number dependencies, etc)
# and handle or deps too "Depends: foo, bar | baz"
my @relevant_depends = split(/[,|]/, $depends_string);
@relevant_depends = map { /\s*(\S+)/o; $1; } @relevant_depends;
# Filter out all non-add-on packages.
@relevant_depends = grep {
my $candidate = $_;
grep { $_ eq $candidate } @$installed_add_ons;
} @relevant_depends;
return @relevant_depends;
}
sub generate_relevant_tsort_dependencies {
my($pkglist, $installed_add_ons, $progress_hash) = @_;
# Make a copy because we're going to mangle it.
my @listcopy = @$pkglist;
shift @_;
return(generate_relevant_tsort_dependencies_internals(\@listcopy, @_));
}
sub generate_relevant_tsort_dependencies_internals {
my($pkglist, $installed_add_ons, $progress_hash) = @_;
# print "GRD: " . join(" ", @$pkglist) . "\n";
my $pkg = shift @$pkglist;
if(!$pkg || $$progress_hash{$pkg}) {
return ();
} else {
my $status = get_package_status($pkg);
$status =~ /^Depends:\s+(.*)/mo;
my $depends = $1; $depends = "" if ! $depends;
my @relevant_depends = filter_depends($depends, $installed_add_ons);
my $newpkglist = [@$pkglist, @relevant_depends];
$$progress_hash{$pkg} = 1;
# pkg is in twice so we don't have to worry about package with no
# relevant dependencies. tsort can't handle that.
my @tsort_strings = "$pkg $pkg\n";
map { push @tsort_strings, "$_ $pkg\n"; } @relevant_depends;
return (@tsort_strings,
generate_relevant_tsort_dependencies_internals($newpkglist,
$installed_add_ons,
$progress_hash));
}
}
sub reorder_add_on_packages {
my($pkglist, $installed_add_ons) = @_;
my @depends = generate_relevant_tsort_dependencies($pkglist,
$installed_add_ons,
{}
);
my $pid = open(TSORT, "-|");
die "Couldn't fork for tsort: $!" unless defined($pid);
# What a strange idiom...
if($pid == 0) {
my $sub_pid = open(IN, "|-");
die "Couldn't sub-fork for tsort: $!" unless defined($sub_pid);
if($sub_pid == 0) {
exec 'tsort' or die "Couldn't run tsort: $!";
}
print IN @depends;
exit 0;
}
my @ordered_pkgs = <TSORT>;
chomp @ordered_pkgs;
return @ordered_pkgs
}
sub generate_add_on_install_list {
my($packages_to_sort) = @_;
my @sorted_pkgs = reorder_add_on_packages($packages_to_sort,
installed_add_on_packages_list());
return(@sorted_pkgs);
}
# Test code
# my @input_packages = <STDIN>;
# my @result = generate_add_on_install_list(@input_packages);
# print " " . join("\n ", @result);
# To make require happy...
1;
|
