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