source: soft/build_system/build_system/mkcd/tags/V4_1_2_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: 12.5 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,2002,2003,2004,2005 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    -d $headers_dir or mkpath $headers_dir;
108    my $last;
109    print "mkcd_build_hdlist: first pass\n";
110    foreach (1 .. $num) {
111        if ($hdlist->[$_]{done}) {
112            print "mkcd_build_hdlist: reading existing hdlist $hdlist->[$_]{hdlist} (1st pass)\n";
113            $urpm->parse_hdlist($hdlist->[$_]{hdlist});
114            $hdlist->[$_]{headers} = list_hdlist([$hdlist->[$_]{hdlist}], 0, 1, $headers_dir);
115        } else {
116            $last = $_;
117            $hdlist->[$_]{headers} = 
118            [ $urpm->parse_rpms_build_headers(
119                dir => $headers_dir, 
120                rpms => $hdlist->[$_]{rpms}) ];
121        }
122    }
123
124    print "mkcd_build_hdlist: second pass\n";
125    $urpm->unresolved_provides_clean;
126    foreach (1 .. $num) {
127        my $e = $hdlist->[$_];
128        if ($e->{done} && $_ > $last) {
129            print "mkcd_build_hdlist: reading existing hdlist $e->{hdlist} (2nd pass)\n";
130            $urpm->parse_hdlist($e->{hdlist});
131            $urpm->compute_deps;
132        } else {
133            print "mkcd_build_hdlist: parse header for $e->{hdlist}\n";
134            my ($start, $end) = $urpm->parse_headers(dir => $headers_dir, headers => $e->{headers}, callback => $hdlist->[$_]{callback});
135            if (!@{$e->{headers}}) {
136                print "WARNING mkcd_build_hdlist: $e->{hdlist} and $e->{synthesis} are empty (start $start end $end)\n";
137                next
138            }
139            $urpm->compute_deps;
140            if (length $e->{hdlist}) {
141                print "mkcd_build_hdlist: write $e->{hdlist}\n";
142                $urpm->build_hdlist(start => $start, end => $end, dir => $headers_dir, hdlist => $e->{hdlist}, ratio => 9);
143            }
144            if (length $e->{synthesis}) {
145                print "mkcd_build_hdlist: write $e->{synthesis}\n";
146                $urpm->build_synthesis(start => $start, end => $end, synthesis => $e->{synthesis});
147                print "done\n"
148            }
149        }
150    }
151    $urpm->build_base_files(depslist => $depslist, provides => $provides, compss => $compss);
152
153    return $urpm;
154}
155
156sub get_sorted_packages {
157    my ($urpm, $hdlist, $sort, $cd_rep, $dir, $nolive, $verbose, $LOG) = @_;
158    my %done_rep;
159    $LOG or open $LOG, "&>STDERR";
160    log_("get_sorted_packages\n", $verbose, $LOG, 2);
161    my %id;
162    for (my $i; $i < @{$urpm->{depslist}}; $i++) {
163        $id{$urpm->{depslist}[$i]->filename} = $i
164    }
165    for (my $i = 1; $i < @$hdlist; $i++) {
166        if (! ref $cd_rep->{$i}) {
167            log_("WARNING installation: cdrep $i is emtpy, ignoring\n", $verbose, $LOG, 5);
168            next
169        }
170        my ($cd, $repname) = @{$cd_rep->{$i}};
171        my @chunk;
172        foreach (@{$hdlist->[$i]{rpms}}) {
173            my ($rpm) = m,([^/]+)$,;
174            log_("installation: sorting rpms $rpm ($id{$rpm})\n", $verbose, $LOG, 5);
175            push @chunk, [ $id{$rpm}, $nolive ? $_ : "$dir/$repname/$rpm" ]
176        }
177        unshift @{$sort->{$cd}}, [ map { $_->[1] } sort { $b->[0] <=> $a->[0] } @chunk ]
178    }
179}
180
181sub packageOutOfRpmsrate {
182    my ($rpmsrate) = @_;
183    my $rate = cleanrpmsrate($rpmsrate);
184    print join("\n", sort(keys %$rate)), "\n";
185    1
186}
187
188sub check_rpmsrate {
189    my ($rpmsrate, @rpms) = @_;
190    my %rpm_name;
191    my %dir;
192    foreach (@rpms) {
193        if (-d $_) { 
194            opendir my $dir, $_;
195            foreach my $rpm (readdir $dir) {
196              if ($rpm =~ /((.*)-[^-]+-[^-]+\.[^.]+)\.rpm/) {
197                push @{$dir{$_}}, $1;
198                push @{$rpm_name{$2}}, $rpm
199              }
200            }
201            closedir $dir
202        }       
203    }
204    my ($rate, undef, $keyword) = @{cleanrpmsrate($rpmsrate, 0, 0, \%dir)};
205    foreach (keys %$rate) {
206        if (!$rpm_name{$_} && !$keyword->{$_}) { print "$_\n" }
207    }
208    1
209}
210
211sub getLeaves {
212    my ($depslist) = @_;
213    open DEP, $depslist or die "Could not open $depslist\n";
214    my @name;
215    my %pkg;
216    my $i = 0;
217    foreach (<DEP>){
218        chomp;
219        my ($name, undef, @de) = split " ", $_; 
220        ($name, my $version, my $release) = $name =~ /(.*)-([^-]*)-([^-]*)/;
221        if ($name){
222            foreach my $d (@de) {
223                if ($d !~ s/^NOTFOUND_//) {
224                    my @t = split '\|',$d ;
225                    foreach my $t (@t) { if ($t !~ s/NOTFOUND_//) { $pkg{$name[$t]}++ }}
226                }else { $pkg{$name[$d]}++}
227            }
228        }
229        $name[$i] = $name;
230        $pkg{$name[$i]}++;
231        $i++;
232    }
233    foreach (sort keys %pkg){
234        print $pkg{$_} - 1, " $_\n";
235    }
236    1
237}
238
239sub getRpmsrate{
240    print "ERROR: this function is deprecated\n";
241    return 0;
242
243    my ($rpmsrate,$reps,$tmp,$name,$VERBOSE) = @_;
244    my $TMP = $tmp || $ENV{TMPDIR};
245    my $tmprpmsrate = "$TMP/$name/rpmsrate";
246    local *R; open R, ">$tmprpmsrate" or print "ERROR: cannot open temporary rpmsrate file $tmprpmsrate\n";
247    my $rate = Mkcd::Tools::cleanrpmsrate($rpmsrate,*R,@$reps);
248    close R;
249    unlink "$rpmsrate" and copy "$tmprpmsrate", "$rpmsrate";
250    local *R; open R, "$rpmsrate" or print "ERROR: cannot open rpmsrate file $rpmsrate\n";
251    [$rate->[0],$rate->[1]];
252}
253
254sub list_hdlist {
255    my ($hdlist, $verbose, $extract, $dir) = @_;
256    print "list_hdlist: hdlists @$hdlist\n";
257    my $package_list;
258    foreach (@$hdlist){
259        my $packer = new packdrake($_);
260        my $count = scalar keys %{$packer->{data}};
261        $verbose and print qq($count files in archive, uncompression method is "$packer->{uncompress}"\n);
262        my @to_extract;
263        foreach my $file (@{$packer->{files}}){
264            if (! -f "$dir/$file") {
265                push @to_extract, $file
266            }
267            $file =~ /(.*-[^-]+-[^-]+\.[^.]+):(.*)/ and $file = $2;
268            push @$package_list, $file;
269        }
270        if ($extract) {
271            $packer->extract_archive($dir, @to_extract)
272        } else {
273            packdrake::list_archive($_);
274        }
275        if (0) {
276            my %extract_table;
277            foreach my $file (@{$packer->{files}}) {
278                push @$package_list, $file;
279                if ($verbose || $extract) { 
280                    my $newfile = "$dir/$file";
281                    for ($packer->{data}{$file}[0]) {
282                        if (/l/) { 
283                            $verbose and printf "l %13c %s -> %s\n", ' ', $file, $packer->{data}{$file}[1]; 
284                            $extract and packdrake::symlink_ $packer->{data}{$file}[1], $newfile; 
285                        } elsif (/d/) { 
286                            $verbose and printf "d %13c %s\n", ' ', $file;
287                            $extract and $dir and packdrake::mkdir_ $newfile; 
288                        } elsif (/f/) { 
289                            $verbose and printf "f %12d %s\n", $packer->{data}{$file}[4], $file;
290                            if ($extract) { 
291                                $dir and packdrake::mkdir_ dirname $newfile;
292                                my $data = $packer->{data}{$file};
293                                $extract_table{$data->[1]} ||= [ $data->[2], [] ];
294                                push @{$extract_table{$data->[1]}[1]}, [ $newfile, $data->[3], $data->[4] ];
295                                $extract_table{$data->[1]}[0] == $data->[2] or die "packdrake: mismatched relocation in toc\n";
296                            }
297                        }
298                    }
299                }
300            }
301        }
302    }
303    $package_list
304}
305
306sub getSize{
307    my ($group, $config, $VERBOSE) = @_;
308    my $max;
309    my $redeps; 
310    foreach my $listnumber (keys %{$group->{list}}) {
311        print "getSize list $listnumber\n";
312        my $repnb;
313        my $done = $config->{list}[$listnumber]{pseudo_done} || $config->{list}[$listnumber]{done};
314        print "getSize: list $listnumber done or pseudodone\n" if $done;
315        #$group->{nodeps}{$listnumber} and next;
316        ref $group->{rep}{$listnumber} or next;
317        for (my $repnb; $repnb < @{$group->{rep}{$listnumber}}; $repnb++) {
318            my $rep = $group->{rep}{$listnumber}[$repnb];
319           
320            foreach my $dir (keys %{$rep->{rpm}}){
321                #$VERBOSE and print "getSize rep $dir\n";
322                my $size;
323                foreach (@{$rep->{rpm}{$dir}}){
324                    my $rpm = $group->{urpm}{rpmkey}{key}{$_} or print "getSize ERROR: $_ has no key, ignored\n" and next; #return 2;
325                    my $b = Mkcd::Tools::du("$dir/$_.rpm");
326                    $group->{listsize}{$listnumber}{rpm} += $b;
327                    my $c;
328                    if ($done || $config->{list}[$listnumber]{nosize}) {
329                        $c = $b;
330                        $b = 0
331                    } else {
332                        $b or print "WARNING getSize: $rpm has a zero size\n";
333                    }
334                    ref $group->{size}{$rpm}{$listnumber} and print "ERROR getSize: duplicate $rpm in list $listnumber, ignoring\n" and next;
335                    my $t = [$b, $dir, $repnb];
336                    push @$t, $c if $c;
337                    $group->{size}{$rpm}{$listnumber} = $t;
338                    push @{$group->{listrpm}{$listnumber}}, $rpm;
339                    $b > $max and $max = $b;
340                }
341            }
342            foreach my $dir (keys %{$rep->{srpm}}){
343                #$VERBOSE and print "getSize DIRECTORY $dir\n";
344                foreach (@{$rep->{srpm}{$dir}}){
345                    my ($srpm,$srpmname,$key);
346                    if (($srpm,$srpmname) = /((.*)-[^-]*-[^-]*\.src)$/){
347                        $key = $srpm;
348                    } else {
349                        ($key) = /(.*)$/;
350                        # FIXME not tested
351                        my $urpm = new URPM;
352                        my $id = $urpm->parse_rpm("$dir/$_.rpm") or print "ERROR getSize: parse_rpm $dir/$_.rpm failed\n" and next;
353                        my $pkg = $urpm->{depslist}[$id];
354                        my $srpm = $pkg->sourcerpm or next;
355                        (undef, $srpmname) = $srpm =~ s/((.*)-[^-]+-[^-]+\.src)\.rpm/$1/
356                    }
357                    $group->{urpm}{rpmkey}{key}{$key} = $srpm; 
358                    $group->{urpm}{rpmkey}{rpm}{$srpm} = $key; 
359                    my $b;
360                    if (!$done) { 
361                        $b = Mkcd::Tools::du("$dir/$_.rpm") if !$config->{list}[$listnumber]{nosize};
362                        $b or print "WARNING getSize: $srpm has a zero size\n";
363                    }
364                    ref $group->{size}{$srpm}{$listnumber} and print "ERROR getSize: duplicate $srpm in list $listnumber, ignoring\n" and next;
365                    $group->{size}{$srpm}{$listnumber} = [$b,$dir,$repnb];
366                    $group->{srpmname}{$srpmname} = $srpm;
367                }
368            }
369        }
370    }
371    $group->{maxsize} = $max;
372    1
373}
374
375sub rpmVersionCompare{
376    my ($pkg1, $pkg2) = @_;
377    my ($n1,$v1,$a1) = $pkg1 =~ /^(.*)-([^-]+-[^-]+)\.([^.]+)(\.rpm)?$/;
378    my ($n2,$v2,$a2) = $pkg2 =~ /^(.*)-([^-]+-[^-]+)\.([^.]+)(\.rpm)?$/;
379    die "ERROR rpmVersionCompare: trying to compare version of two differently named packages ($pkg1,$pkg2)\n" if (!($n1 eq $n2)) ;
380    my $ret = URPM::ranges_overlap("== $v1","> $v2");
381    if ($ret){
382        return $ret
383    }else{
384        $ret = URPM::ranges_overlap("== $v1","< $v2");
385        if ($ret){
386            return -$ret
387        }
388        if ($ARCH{$a1} < $ARCH{$a2}){
389            return -1 
390        }elsif ($ARCH{$a1} > $ARCH{$a2}){
391            return 1
392        }else{
393            return 0
394        }
395    }
396}
397
398
3991
400
401# Changelog
402#
403# 2002 06 01
404# use perl-URPM
405# add mkcd_build_hdlist function
406#
407# 2002 06 03
408# new perl-URPM API
409#
410# 2004 07 05
411# getSize check for list done or pseudo_done not to use the size (for the disc build function those rpm has a zero size)
Note: See TracBrowser for help on using the repository browser.