source: soft/build_system/build_system/mkcd/tags/V3_8_5_1mdk/pm/Mkcd/Package.pm @ 1

Last change on this file since 1 was 1, checked in by fasma, 12 years ago

Initial Import from Mandriva's soft revision 224062 and package revision 45733

File size: 11.8 KB
Line 
1package Mkcd::Package;
2
3our $VERSION = '1.0.0';
4
5use File::NCopy qw(copy);       
6use File::Path;       
7use URPM;
8use URPM::Build;
9use Mkcd::Tools qw(du cleanrpmsrate printDiscsFile log_);
10use strict;
11require Exporter;
12our @ISA = qw(Exporter);
13our @EXPORT = qw(check_rpmsrate packageOutOfRpmsrate genDeps getLeaves list_hdlist getSize rpmVersionCompare mkcd_build_hdlist %ARCH get_sorted_packages);
14
15my %ARCH;
16
17=head1 NAME
18
19Packages - mkcd module
20
21=head1 SYNOPSYS
22
23    require Mkcd::Functions;
24
25=head1 DESCRIPTION
26
27C<Mkcd::Functions> include the mkcd low level packages functions.
28
29=head1 SEE ALSO
30
31mkcd
32
33=head1 COPYRIGHT
34
35Copyright (C) 2000,2001 MandrakeSoft <warly@mandrakesoft.com>
36
37This program is free software; you can redistribute it and/or modify
38it under the terms of the GNU General Public License as published by
39the Free Software Foundation; either version 2, or (at your option)
40any later version.
41
42This program is distributed in the hope that it will be useful,
43but WITHOUT ANY WARRANTY; without even the implied warranty of
44MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
45GNU General Public License for more details.
46
47You should have received a copy of the GNU General Public License
48along with this program; if not, write to the Free Software
49Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
50
51=cut
52
53%ARCH = ( 
54    x86_64 => 1,
55    i586 => 1,
56    noarch => 1,
57    k7 => 1,
58    ppc => 1,
59    ia64 => 1,
60    i686 => 2,
61    i486 => 2,
62    i386 => 3
63);
64
65sub genDeps {
66    my ($top, $reps, $deps, $VERBOSE, $TMP) = @_;
67    $top or print "ERROR genDeps: no top dir defined\n" and return 0;
68    %$reps or return 0;
69    -d $top or mkpath $top or die "FATAL genDeps: could not create $top\n";
70   
71    # FIXME the function parse_hdlist exist and should be used if the rpms list has not changed
72    # if ($deps || ! (-f "$top/depslist.ordered" && -f "$top/hdlist.cz")) {
73        my @rpms;
74        my %done;
75        foreach my $rep (keys %$reps) {
76            #$VERBOSE and print "genDeps: adding rep $rep\n";
77            foreach my $rpm (@{$reps->{$rep}}) {
78                $done{$rpm} and next;
79                push @rpms, "$rep/$rpm.rpm";
80                $done{$rpm} = 1
81            }
82        }
83        # Need to create hdlist and synsthesis on filesystem to estimate deps files
84        # size in disc->guessHdlistSize.
85        return mkcd_build_hdlist(1, [ 0, { rpms => \@rpms,
86                   hdlist => "$top/hdlist.cz",
87                   synthesis => "$top/synthesis.hdlist.cz",
88                   callback => sub {
89                       my ($urpm, $id) = @_;
90                       my $pkg = $urpm->{depslist}[$id];
91                       my $fullname = $pkg->fullname;
92                       my $filename = $pkg->filename;
93                       $filename =~ s/\.rpm$//;
94                       $urpm->{sourcerpm}{$fullname} = $pkg->sourcerpm;
95                       $urpm->{rpm}{$fullname} = $pkg;
96                       $urpm->{files}{$fullname} = [ $pkg->files ];
97                       $urpm->{rpmkey}{rpm}{$fullname} = $filename;
98                       $urpm->{rpmkey}{key}{$filename} = $fullname;
99                       $pkg->pack_header
100                   }
101               } ], "$TMP/.mkcd_build_hdlist", "$top/depslist.ordered", "$top/provides", "$top/compss");
102}
103
104sub mkcd_build_hdlist {
105    my ($num, $hdlist, $headers_dir, $depslist, $provides, $compss) = @_;
106    my $urpm = new URPM;
107    my $last;
108    print "mkcd_build_hdlist: first pass\n";
109    foreach (1 .. $num) {
110        if ($hdlist->[$_]{done}) {
111            print "mkcd_build_hdlist: reading existing hdlist $hdlist->[$_]{hdlist} (1st pass)\n";
112            $urpm->parse_hdlist($hdlist->[$_]{hdlist})
113        } else {
114            $last = $_;
115            $hdlist->[$_]{headers} = 
116            [ $urpm->parse_rpms_build_headers(
117                dir => $headers_dir, 
118                rpms => $hdlist->[$_]{rpms}) ];
119        }
120    }
121
122    print "mkcd_build_hdlist: second pass\n";
123    $urpm->unresolved_provides_clean;
124    foreach (1 .. $num) {
125        my $e = $hdlist->[$_];
126        if ($e->{done} && $_ > $last) {
127            print "mkcd_build_hdlist: reading existing hdlist $e->{hdlist} (2nd pass)\n";
128            $urpm->parse_hdlist($e->{hdlist});
129            $urpm->compute_deps;
130        } else {
131            my ($start, $end) = $urpm->parse_headers(dir => $headers_dir, headers => $e->{headers}, callback => $hdlist->[$_]{callback});
132            $urpm->compute_deps;
133            if (!@{$e->{headers}}) {
134                print "WARNING mkcd_build_hdlist: $e->{hdlist} and $e->{synthesis} are empty (start $start end $end)\n";
135                next
136            }
137            if (length $e->{hdlist}) {
138                print "mkcd_build_hdlist: write $e->{hdlist}\n";
139                $urpm->build_hdlist(start => $start, end => $end, dir => $headers_dir, hdlist => $e->{hdlist}, ratio => 9);
140            }
141            if (length $e->{synthesis}) {
142                print "mkcd_build_hdlist: write $e->{synthesis}\n";
143                $urpm->build_synthesis(start => $start, end => $end, synthesis => $e->{synthesis})
144            }
145        }
146    }
147    $urpm->build_base_files(depslist => $depslist, provides => $provides, compss => $compss);
148
149    return $urpm;
150}
151
152sub get_sorted_packages {
153    my ($urpm, $hdlist, $sort, $cd_rep, $dir, $nolive, $verbose, $LOG) = @_;
154    my %done_rep;
155    $LOG or open $LOG, "&>STDERR";
156    log_("get_sorted_packages\n", $verbose, $LOG, 2);
157    my %id;
158    for (my $i; $i < @{$urpm->{depslist}}; $i++) {
159        $id{$urpm->{depslist}[$i]->filename} = $i
160    }
161    for (my $i = 1; $i < @$hdlist; $i++) {
162        if (! ref $cd_rep->{$i}) {
163            log_("WARNING installation: cdrep $i is emtpy, ignoring\n", $verbose, $LOG, 5);
164            next
165        }
166        my ($cd, $repname) = @{$cd_rep->{$i}};
167        my @chunk;
168        foreach (@{$hdlist->[$i]{rpms}}) {
169            my ($rpm) = m,([^/]+)$,;
170            log_("installation: sorting rpms $rpm ($id{$rpm})\n", $verbose, $LOG, 5);
171            push @chunk, [ $id{$rpm}, $nolive ? $_ : "$dir/$repname/$rpm" ]
172        }
173        unshift @{$sort->{$cd}}, [ map { $_->[1] } sort { $b->[0] <=> $a->[0] } @chunk ]
174    }
175}
176
177sub packageOutOfRpmsrate {
178    my ($rpmsrate) = @_;
179    my $rate = cleanrpmsrate($rpmsrate);
180    print join("\n", sort(keys %$rate)), "\n";
181    1
182}
183
184sub check_rpmsrate {
185    my ($rpmsrate, @rpms) = @_;
186    my %rpm_name;
187    my %dir;
188    foreach (@rpms) {
189        if (-d $_) { 
190            opendir my $dir, $_;
191            foreach my $rpm (readdir $dir) {
192              if ($rpm =~ /((.*)-[^-]+-[^-]+\.[^.]+)\.rpm/) {
193                push @{$dir{$_}}, $1;
194                push @{$rpm_name{$2}}, $rpm
195              }
196            }
197            closedir $dir
198        }       
199    }
200    my ($rate, undef, $keyword) = @{cleanrpmsrate($rpmsrate, 0, 0, \%dir)};
201    foreach (keys %$rate) {
202        if (!$rpm_name{$_} && !$keyword->{$_}) { print "$_\n" }
203    }
204    1
205}
206
207sub getLeaves {
208    my ($depslist) = @_;
209    open DEP, $depslist or die "Could not open $depslist\n";
210    my @name;
211    my %pkg;
212    my $i = 0;
213    foreach (<DEP>){
214        chomp;
215        my ($name, undef, @de) = split " ", $_; 
216        ($name, my $version, my $release) = $name =~ /(.*)-([^-]*)-([^-]*)/;
217        if ($name){
218            foreach my $d (@de) {
219                if ($d !~ s/^NOTFOUND_//) {
220                    my @t = split '\|',$d ;
221                    foreach my $t (@t) { if ($t !~ s/NOTFOUND_//) { $pkg{$name[$t]}++ }}
222                }else { $pkg{$name[$d]}++}
223            }
224        }
225        $name[$i] = $name;
226        $pkg{$name[$i]}++;
227        $i++;
228    }
229    foreach (sort keys %pkg){
230        print $pkg{$_} - 1, " $_\n";
231    }
232    1
233}
234
235sub getRpmsrate{
236    print "ERROR: this function is deprecated\n";
237    return 0;
238
239    my ($rpmsrate,$reps,$tmp,$name,$VERBOSE) = @_;
240    my $TMP = $tmp || $ENV{TMPDIR};
241    my $tmprpmsrate = "$TMP/$name/rpmsrate";
242    local *R; open R, ">$tmprpmsrate" or print "ERROR: cannot open temporary rpmsrate file $tmprpmsrate\n";
243    my $rate = Mkcd::Tools::cleanrpmsrate($rpmsrate,*R,@$reps);
244    close R;
245    unlink "$rpmsrate" and copy "$tmprpmsrate", "$rpmsrate";
246    local *R; open R, "$rpmsrate" or print "ERROR: cannot open rpmsrate file $rpmsrate\n";
247    [$rate->[0],$rate->[1]];
248}
249
250sub list_hdlist {
251    my ($hdlist, $verbose, $extract, $dir) = @_;
252    print "list_hdlist: hdlists @$hdlist\n";
253    my $package_list;
254    foreach (@$hdlist){
255        my $packer = new packdrake($_);
256        my $count = scalar keys %{$packer->{data}};
257        $verbose and print qq($count files in archive, uncompression method is "$packer->{uncompress}"\n);
258        my @to_extract;
259        foreach my $file (@{$packer->{files}}){
260            if (! -f "$dir/$file") {
261                push @to_extract, $file
262            }
263            $file =~ /(.*-[^-]+-[^-]+\.[^.]+):(.*)/ and $file = $2;
264            push @$package_list, $file;
265        }
266        if ($extract) {
267            $packer->extract_archive($dir, @to_extract)
268        } else {
269            packdrake::list_archive($_);
270        }
271        if (0) {
272            my %extract_table;
273            foreach my $file (@{$packer->{files}}) {
274                push @$package_list, $file;
275                if ($verbose || $extract) { 
276                    my $newfile = "$dir/$file";
277                    for ($packer->{data}{$file}[0]) {
278                        if (/l/) { 
279                            $verbose and printf "l %13c %s -> %s\n", ' ', $file, $packer->{data}{$file}[1]; 
280                            $extract and packdrake::symlink_ $packer->{data}{$file}[1], $newfile; 
281                        } elsif (/d/) { 
282                            $verbose and printf "d %13c %s\n", ' ', $file;
283                            $extract and $dir and packdrake::mkdir_ $newfile; 
284                        } elsif (/f/) { 
285                            $verbose and printf "f %12d %s\n", $packer->{data}{$file}[4], $file;
286                            if ($extract) { 
287                                $dir and packdrake::mkdir_ dirname $newfile;
288                                my $data = $packer->{data}{$file};
289                                $extract_table{$data->[1]} ||= [ $data->[2], [] ];
290                                push @{$extract_table{$data->[1]}[1]}, [ $newfile, $data->[3], $data->[4] ];
291                                $extract_table{$data->[1]}[0] == $data->[2] or die "packdrake: mismatched relocation in toc\n";
292                            }
293                        }
294                    }
295                }
296            }
297        }
298    }
299    $package_list
300}
301
302sub getSize{
303    my ($group,$config,$VERBOSE) = @_;
304    my $max;
305    my $redeps;
306    foreach my $listnumber (keys %{$group->{list}}){
307        print "getSize list $listnumber\n";
308        my $repnb;
309        #$group->{nodeps}{$listnumber} and next;
310        ref $group->{rep}{$listnumber} or next;
311        for (my $repnb; $repnb < @{$group->{rep}{$listnumber}}; $repnb++) {
312            my $rep = $group->{rep}{$listnumber}[$repnb];
313           
314            foreach my $dir (keys %{$rep->{rpm}}){
315                #$VERBOSE and print "getSize rep $dir\n";
316                foreach (@{$rep->{rpm}{$dir}}){
317                    my $rpm = $group->{urpm}{rpmkey}{key}{$_} or print "getSize ERROR: $_ has no key, ignored\n" and next; #return 2;
318                    my $b = Mkcd::Tools::du("$dir/$_.rpm") if !$config->{list}[$listnumber]{nosize};
319                    $b or print "WARNING getSize: $rpm has a zero size\n";
320                    ref $group->{size}{$rpm}{$listnumber} and print "ERROR getSize: duplicate $rpm in list $listnumber, ignoring\n" and next;
321                    $group->{size}{$rpm}{$listnumber} = [$b, $dir, $repnb];
322                    push @{$group->{listrpm}{$listnumber}}, $rpm;
323                    $group->{listsize}{$listnumber}{rpm} += $b;
324                    $b > $max and $max = $b;
325                }
326            }
327            foreach my $dir (keys %{$rep->{srpm}}){
328                #$VERBOSE and print "getSize DIRECTORY $dir\n";
329                foreach (@{$rep->{srpm}{$dir}}){
330                    my ($srpm,$srpmname,$key);
331                    if (($srpm,$srpmname) = /((.*)-[^-]*-[^-]*\.src)$/){
332                        $key = $srpm;
333                    } else {
334                        ($key) = /(.*)$/;
335                        # FIXME not tested
336                        my $urpm = new URPM;
337                        my $id = $urpm->parse_rpm("$dir/$_.rpm") or print "ERROR getSize: parse_rpm $dir/$_.rpm failed\n" and next;
338                        my $pkg = $urpm->{depslist}[$id];
339                        my $srpm = $pkg->sourcerpm or next;
340                        (undef, $srpmname) = $srpm =~ s/((.*)-[^-]+-[^-]+\.src)\.rpm/$1/
341                    }
342                    $group->{urpm}{rpmkey}{key}{$key} = $srpm; 
343                    $group->{urpm}{rpmkey}{rpm}{$srpm} = $key; 
344                    my $b = Mkcd::Tools::du("$dir/$_.rpm") if !$config->{list}[$listnumber]{nosize};
345                    $b or print "WARNING getSize: $srpm has a zero size\n";
346                    ref $group->{size}{$srpm}{$listnumber} and print "ERROR getSize: duplicate $srpm in list $listnumber, ignoring\n" and next;
347                    $group->{size}{$srpm}{$listnumber} = [$b,$dir,$repnb];
348                    $group->{srpmname}{$srpmname} = $srpm;
349                }
350            }
351        }
352    }
353    $group->{maxsize} = $max;
354    1
355}
356
357sub rpmVersionCompare{
358    my ($pkg1, $pkg2) = @_;
359    my ($n1,$v1,$a1) = $pkg1 =~ /^(.*)-([^-]+-[^-]+)\.([^.]+)(\.rpm)?$/;
360    my ($n2,$v2,$a2) = $pkg2 =~ /^(.*)-([^-]+-[^-]+)\.([^.]+)(\.rpm)?$/;
361    die "ERROR rpmVersionCompare: trying to compare version of two differently named packages ($pkg1,$pkg2)\n" if (!($n1 eq $n2)) ;
362    my $ret = URPM::ranges_overlap("== $v1","> $v2");
363    if ($ret){
364        return $ret
365    }else{
366        $ret = URPM::ranges_overlap("== $v1","< $v2");
367        if ($ret){
368            return -$ret
369        }
370        if ($ARCH{$a1} < $ARCH{$a2}){
371            return -1 
372        }elsif ($ARCH{$a1} > $ARCH{$a2}){
373            return 1
374        }else{
375            return 0
376        }
377    }
378}
379
380
3811
382
383# Changelog
384#
385# 2002 06 01
386#
387# use perl-URPM
388# add mkcd_build_hdlist function
389#
390# 2002 06 03
391#
392# new perl-URPM API
Note: See TracBrowser for help on using the repository browser.