~ubuntu-branches/ubuntu/hoary/debian-edu/hoary

« back to all changes in this revision

Viewing changes to gen-control

  • Committer: Bazaar Package Importer
  • Author(s): Joey Hess
  • Date: 2004-06-10 13:18:54 UTC
  • Revision ID: james.westby@ubuntu.com-20040610131854-fhtqpfxy2ewofoew
Tags: 0.771
* Joey Hess
  - Rebuild against current testing, amaya-gtk and amaya-lesstif are no
    longer available.
  - Medium urgency upload to perhaps get into testing this time.

Show diffs side-by-side

added added

removed removed

Lines of Context:
 
1
#!/usr/bin/perl
 
2
#
 
3
# Author: Petter Reinholdtsen <pere@hungry.com>
 
4
# Date:   2001-08-23
 
5
#
 
6
# Generate the control file used by the Debian Edu task package.
 
7
 
 
8
use warnings;
 
9
use strict;
 
10
 
 
11
use Getopt::Std;
 
12
use File::Path;
 
13
 
 
14
use vars qw(%opts %available %excluded %included @wanted %missing
 
15
            @tasks $debug);
 
16
my @arch = qw(alpha arm i386 ia64 m68k mips mipsel powerpc s390 sparc hppa);
 
17
 
 
18
$debug = 0;
 
19
 
 
20
my %taskinfo = ();
 
21
 
 
22
my $aptsources = "./sources.list.testing";
 
23
 
 
24
getopts("cdaemis:", \%opts);
 
25
 
 
26
$aptsources = $opts{'s'} if ($opts{'s'});
 
27
 
 
28
$debug = 1 if ($opts{'d'});
 
29
 
 
30
load_available_packages();
 
31
 
 
32
load_tasks();
 
33
 
 
34
if ($opts{'c'}) {
 
35
    gen_control();
 
36
} else {
 
37
    if ($opts{'e'}) {
 
38
        print_excluded_packages();
 
39
    } elsif ($opts{'a'}) {
 
40
        print_all_packages();
 
41
    } else {
 
42
        print_available_packages();
 
43
    }
 
44
}
 
45
print_missing_packages() if ($opts{'m'});
 
46
 
 
47
sub apt {
 
48
    my $op = shift;
 
49
 
 
50
    my $aptdir  = "./tmp/apt";
 
51
    my @aptopts = ("Dir::Etc::sourcelist=$aptsources",
 
52
                   "Dir::State=$aptdir/state",
 
53
                   "Dir::Cache=$aptdir/cache",
 
54
                   "Dir::State::Status=/dev/null",
 
55
                   "Debug::NoLocking=true");
 
56
 
 
57
    # Stupid apt-get and apt-cache do not understand the same arguments!
 
58
    # I have to map them to different formats to get both working.
 
59
 
 
60
    if ("update" eq $op) {
 
61
        mkpath "$aptdir/state/lists/partial";
 
62
        mkpath "$aptdir/cache/archives/partial";
 
63
 
 
64
        my $aptget   = "apt-get --assume-yes -o " . join(" -o ", @aptopts);
 
65
 
 
66
        print STDERR "aptget: $aptget\n" if $debug;
 
67
        system("$aptget update 1>&2");
 
68
    } elsif ("apt-cache" eq "$op") {
 
69
        my $aptcache = "apt-cache -o=" . join(" -o=", @aptopts);
 
70
        print STDERR "aptcache: $aptcache\n" if $debug;
 
71
        return $aptcache;
 
72
    }
 
73
}
 
74
 
 
75
sub gen_control {
 
76
    my $task;
 
77
    for $task (sort keys %taskinfo) {
 
78
        print "Package: $task\n";
 
79
        my $header;
 
80
        for $header (qw(Section Architecture Priority)) {
 
81
            print "$header: $taskinfo{$task}{$header}\n"
 
82
                if (defined $taskinfo{$task}{$header});
 
83
        }
 
84
 
 
85
        for $header (qw(Depends Suggests Recommends)) {
 
86
            print "$header: ", join(", ", sort @{$taskinfo{$task}{$header}}),"\n"
 
87
                if (defined $taskinfo{$task}{$header});
 
88
        }
 
89
 
 
90
        # Description Description-long
 
91
        print "Description: $taskinfo{$task}{Description}\n";
 
92
        print "$taskinfo{$task}{'Description-long'}"; # Already contain newline
 
93
 
 
94
        print "\n";
 
95
    }
 
96
}
 
97
 
 
98
#
 
99
# Check the APT cache, and find the packages currently available.
 
100
#
 
101
sub load_available_packages
 
102
{
 
103
    apt("update");
 
104
    my $aptcache = apt("apt-cache");
 
105
    open(APT, "$aptcache dump |") || die "Unable to start apt-cache";
 
106
    my $pkg;
 
107
    while (<APT>) {
 
108
        chomp;
 
109
        if (/^Package: (.+)$/) {
 
110
            $pkg = $1;
 
111
            print STDERR "Found pkg '$pkg'\n" if $debug;
 
112
        }
 
113
        if (/^\s+Version:\s+(.+)/) {
 
114
            print STDERR " pkg $pkg = ver $1\n" if $debug;
 
115
#           print "C: $pkg $available{$pkg} lt $1\n" if ( exists $available{$pkg});
 
116
            $available{$pkg} = $1 if ( ! exists $available{$pkg} ||
 
117
                                       $available{$pkg} lt $1 );
 
118
        }
 
119
    }
 
120
}
 
121
 
 
122
#
 
123
# Load all tasks
 
124
#
 
125
sub load_tasks {
 
126
    my $taskfile;
 
127
 
 
128
    # First document their existence, so they can depend on each other.
 
129
    for $taskfile (<tasks/*>) {
 
130
        next if ("tasks/CVS" eq $taskfile);
 
131
        next if ($taskfile =~ m/~$/);
 
132
 
 
133
        my $curpkg = $taskfile;
 
134
        $curpkg =~ s%tasks/%education-%;
 
135
        $available{$curpkg} = "n/a";
 
136
 
 
137
        push(@tasks, "$taskfile:$curpkg");
 
138
    }
 
139
 
 
140
    # Next, load their content.
 
141
    my $foo;
 
142
    for $foo (@tasks) {
 
143
        my ($taskfile, $curpkg) = $foo =~ m/^(.+):(.+)$/;
 
144
        next if ("tasks/CVS" eq $taskfile);
 
145
        
 
146
        load_task($taskfile, $curpkg);
 
147
    }
 
148
}
 
149
 
 
150
sub process_pkglist {
 
151
    my $pkgstring = shift;
 
152
    my @pkglist = ();
 
153
    my @missinglist = ();
 
154
    my $packages;
 
155
    for $packages (split(/\s*,\s*/, $pkgstring)) {
 
156
        print "E: double comma?: $_\n" if ($packages =~ /^\s*$/ && $debug);
 
157
        my $package;
 
158
        my @alternates=split(/\s*\|\s*/, $packages);
 
159
        my $alternatecount=0;
 
160
        for $package (@alternates) {
 
161
            print STDERR "Loading pkg '$package'\n" if $debug;
 
162
            if ($package =~ /^-(.+)$/) {
 
163
                $excluded{$1} = 1;
 
164
            } elsif ( !exists $available{$package} ) {
 
165
                if ( !exists $missing{$package}) {
 
166
                    $missing{$package} = 1;
 
167
                }
 
168
                push(@missinglist, $package);
 
169
            } else {
 
170
                if ($alternatecount == 0) {
 
171
                    push(@pkglist, $package);
 
172
                }
 
173
                else {
 
174
                    $pkglist[-1].=" | $package";
 
175
                }
 
176
                $alternatecount++;
 
177
 
 
178
                if ( ! $included{$package} ) {
 
179
                    push(@wanted, $package);
 
180
                    $included{$package} = 1;
 
181
                }
 
182
            }
 
183
        }
 
184
    }
 
185
    return (\@pkglist, \@missinglist);
 
186
}
 
187
 
 
188
sub load_task {
 
189
    my ($taskfile, $curpkg) = @_;
 
190
    open(TASKFILE, "<$taskfile") || die "Unable to open $taskfile";
 
191
    my $line;
 
192
 
 
193
    $taskinfo{$curpkg} = ();
 
194
 
 
195
    print STDERR "Loading task $curpkg\n" if $debug;
 
196
 
 
197
    while (<TASKFILE>) {
 
198
        chomp;
 
199
        next if (m/^\#/); # Skip comments
 
200
        $line = $_;
 
201
 
 
202
        # Append multi-line
 
203
        while ($line =~ /\\$/) {
 
204
            $line =~ s/\s*\\//;
 
205
            $_ = <TASKFILE>;
 
206
            chomp;
 
207
            $line .= $_;
 
208
        }
 
209
        # Remove trailing space
 
210
        $line =~ s/\s+$//;
 
211
 
 
212
        $_ = $line;
 
213
        $taskinfo{$curpkg}{'Section'}      = $1 if (m/^Section:\s+(.+)$/);
 
214
        $taskinfo{$curpkg}{'Architecture'} = $1 if (m/^Architecture:\s+(.+)$/);
 
215
 
 
216
        $taskinfo{$curpkg}{'Priority'}     = $1 if (m/^Priority:\s+(.+)$/);
 
217
 
 
218
        if (m/^Description:\s+(.+)$/) {
 
219
            $taskinfo{$curpkg}{'Description'} = $1;
 
220
            $taskinfo{$curpkg}{'Description-long'} = "";
 
221
            while (<TASKFILE>) {
 
222
                # End of description, pass next line to pattern matching
 
223
                last if (m/^\S+/ || m/^\s*$/);
 
224
 
 
225
                $taskinfo{$curpkg}{'Description-long'} .= $_;
 
226
            }
 
227
        }
 
228
 
 
229
        next unless defined $_;
 
230
 
 
231
        my $header;
 
232
        for $header (qw(Depends Suggests Recommends)) {
 
233
            if (m/^$header:\s+(.+)$/ && $1 !~ /^\s*$/) {
 
234
                $taskinfo{$curpkg}{$header} = ()
 
235
                    if (! exists $taskinfo{$curpkg}{$header});
 
236
                my ($pkglist, $missinglist) = process_pkglist($1);
 
237
                push(@{$taskinfo{$curpkg}{$header}}, @{$pkglist});
 
238
 
 
239
                # Avoid missing packages in Depends lists, allow them
 
240
                # in the two others.  Insert missing depends in
 
241
                # suggests list.
 
242
                if (@{$missinglist}) {
 
243
                    if ("Depends" eq $header) {
 
244
                        push(@{$taskinfo{$curpkg}{'Suggests'}}, @{$missinglist});
 
245
                    } else {
 
246
                        push(@{$taskinfo{$curpkg}{$header}}, @{$missinglist});
 
247
                    }
 
248
                }
 
249
            }
 
250
        }
 
251
 
 
252
        if (/^Avoid:\s+(.+)$/) {
 
253
            my @pkgs = split(/\s*,\s*/, $1);
 
254
            my $packages;
 
255
            for $packages (@pkgs) {
 
256
                my $package;
 
257
                for $package (split(/\s*\|\s*/, $packages)) {
 
258
                    $excluded{$package} = 1;
 
259
                }
 
260
            }
 
261
        }
 
262
 
 
263
        if (/^Ignore:\s+(.+)$/) {
 
264
            my @pkgs = split(/\s*,\s*/, $1);
 
265
            my $packages;
 
266
            for $packages (@pkgs) {
 
267
                my $package;
 
268
                for $package (split(/\s*\|\s*/, $packages)) {
 
269
                    # Remove explanations, ie the paranteses at the end.
 
270
                    $package =~ s/\s*\([^\)]*\)\s*$//;
 
271
                    $missing{$package} = 1;
 
272
                }
 
273
            }
 
274
        }
 
275
    }
 
276
    close(TASKFILE);
 
277
}
 
278
 
 
279
sub print_excluded_packages {
 
280
    print join("\n", sort keys %excluded),"\n";
 
281
}
 
282
 
 
283
sub print_available_packages {
 
284
    print join("\n", @wanted),"\n";
 
285
}
 
286
 
 
287
sub print_all_packages {
 
288
    print STDERR "Printing all packages\n" if $debug;
 
289
    print join("\n", @wanted, keys %missing),"\n";
 
290
}
 
291
 
 
292
sub print_missing_packages {
 
293
    if (%missing) {
 
294
        print STDERR "Missing or avoided packages:\n";
 
295
        my $package;
 
296
        for $package (sort keys %missing) {
 
297
            if (exists $available{$package}) {
 
298
                print STDERR "  $package (v$available{$package} available)\n";
 
299
            } else {
 
300
                print STDERR "  $package\n";
 
301
            }
 
302
        }
 
303
        exit 1 unless $opts{'i'};
 
304
    }
 
305
}