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