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