source: soft/build_system/build_system/mkcd/tags/V3_3_6_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: 8.6 KB
Line 
1package Mkcd::Package;
2
3our $VERSION = '0.1.2';
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(packageOutOfRpmsrate genDeps getLeaves list_hdlist getSize rpmVersionCompare mkcd_build_hdlist %ARCH);
14
15use vars qw(%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 URPM does not bring a read_hdlist function
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 getLeaves {
146    my ($depslist) = @_;
147    open DEP, "$depslist" or die "Could not open $depslist\n";
148    my @name;
149    my %pkg;
150    my $i = 0;
151    foreach (<DEP>){
152        chomp;
153        my ($name, undef, @de) = split " ", $_; 
154        ($name, my $version, my $release) = $name =~ /(.*)-([^-]*)-([^-]*)/;
155        if ($name){
156            foreach my $d (@de) {
157                if ($d !~ s/^NOTFOUND_//) { 
158                    my @t = split '\|',$d ; 
159                    foreach my $t (@t) { if ($t !~ s/NOTFOUND_//) { $pkg{$name[$t]}++ }}
160                }else { $pkg{$name[$d]}++}
161            }
162        }
163        $name[$i] = $name;
164        $pkg{$name[$i]}++;
165        $i++;
166    }
167    foreach (sort keys %pkg){
168        print $pkg{$_} - 1, " $_\n";
169    }
170    1
171}
172
173sub getRpmsrate{
174    print "ERROR: this function is deprecated\n";
175    return 0;
176
177    my ($rpmsrate,$reps,$tmp,$name,$VERBOSE) = @_;
178    my $TMP = $tmp || $ENV{TMPDIR};
179    my $tmprpmsrate = "$TMP/$name/rpmsrate";
180    local *R; open R, ">$tmprpmsrate" or print "ERROR: cannot open temporary rpmsrate file $tmprpmsrate\n";
181    my $rate = Mkcd::Tools::cleanrpmsrate($rpmsrate,*R,@$reps);
182    close R;
183    unlink "$rpmsrate" and copy "$tmprpmsrate", "$rpmsrate";
184    local *R; open R, "$rpmsrate" or print "ERROR: cannot open rpmsrate file $rpmsrate\n";
185    [$rate->[0],$rate->[1]];
186}
187
188sub list_hdlist{
189    my (@hdlist) = @_;
190    print "list_hdlist: hdlists @hdlist\n";
191    foreach (@hdlist){
192        my $packer = new packdrake($_);
193        my $count = scalar keys %{$packer->{data}};
194        print "$count files in archive, uncompression method is \"$packer->{uncompress}\"\n";
195        foreach my $file (@{$packer->{files}}) {
196            printf "l %13c %s -> %s\n", ' ', $file, $packer->{data}{$file}[1]
197        }
198    }
199    1
200}
201
202sub getSize{
203    my ($group,$config,$VERBOSE) = @_;
204    my $max;
205    my $redeps;
206    foreach my $listnumber (keys %{$group->{list}}){
207        print "getSize list $listnumber\n";
208        my $repnb;
209        #$group->{nodeps}{$listnumber} and next;
210        ref $group->{rep}{$listnumber} or next;
211        for (my $repnb; $repnb < @{$group->{rep}{$listnumber}}; $repnb++) {
212            my $rep = $group->{rep}{$listnumber}[$repnb];
213           
214            foreach my $dir (keys %{$rep->{rpm}}){
215                #$VERBOSE and print "getSize rep $dir\n";
216                foreach (@{$rep->{rpm}{$dir}}){
217                    my $rpm = $group->{urpm}{rpmkey}{key}{$_} or print "getSize ERROR: $_ has no key, ignored\n" and next; #return 2;
218                    my $b = Mkcd::Tools::du("$dir/$_.rpm") if !$config->{list}[$listnumber]{nosize};
219                    $b or print "WARNING getSize: $rpm has a zero size\n";
220                    ref $group->{size}{$rpm}{$listnumber} and print "ERROR getSize: duplicate $rpm in list $listnumber, ignoring\n" and next;
221                    $group->{size}{$rpm}{$listnumber} = [$b,$dir,$repnb];
222                    push @{$group->{listrpm}{$listnumber}}, $rpm;
223                    $group->{listsize}{$listnumber}{rpm} += $b;
224                    $b > $max and $max = $b;
225                }
226            }
227            foreach my $dir (keys %{$rep->{srpm}}){
228                #$VERBOSE and print "getSize DIRECTORY $dir\n";
229                foreach (@{$rep->{srpm}{$dir}}){
230                    my ($srpm,$srpmname,$key);
231                    if (($srpm,$srpmname) = /((.*)-[^-]*-[^-]*\.src)$/){
232                        $key = $srpm;
233                    }else {
234                        ($key) = /(.*)\.rpm$/;
235                        my %header;
236                        tie %header, "RPM::Header", "$dir/$_.rpm" or print "ERROR getSize: $RPM::err" and next;
237                        $header{'SOURCERPM'} eq "(none)" or next;
238                        $srpmname = $header{'NAME'};
239                        $srpm = "$srpmname-$header{'VERSION'}-$header{'RELEASE'}.src";
240                    }
241                    $group->{urpm}{rpmkey}{key}{$key} = $srpm; 
242                    $group->{urpm}{rpmkey}{rpm}{$srpm} = $key; 
243                    my $b = Mkcd::Tools::du("$dir/$_.rpm") if !$config->{list}[$listnumber]{nosize};
244                    $b or print "WARNING getSize: $srpm has a zero size\n";
245                    ref $group->{size}{$srpm}{$listnumber} and print "ERROR getSize: duplicate $srpm in list $listnumber, ignoring\n" and next;
246                    $group->{size}{$srpm}{$listnumber} = [$b,$dir,$repnb];
247                    $group->{srpmname}{$srpmname} = $srpm;
248                }
249            }
250        }
251    }
252    $group->{maxsize} = $max;
253    1
254}
255
256sub rpmVersionCompare{
257    my ($pkg1, $pkg2) = @_;
258    my ($n1,$v1,$a1) = $pkg1 =~ /^(.*)-([^-]+-[^-]+)\.([^.]+)(\.rpm)?$/;
259    my ($n2,$v2,$a2) = $pkg2 =~ /^(.*)-([^-]+-[^-]+)\.([^.]+)(\.rpm)?$/;
260    die "ERROR rpmVersionCompare: trying to compare version of two differently named packages ($pkg1,$pkg2)\n" if (!($n1 eq $n2)) ;
261    my $ret = URPM::ranges_overlap("== $v1","> $v2");
262    if ($ret){
263        return $ret
264    }else{
265        $ret = URPM::ranges_overlap("== $v1","< $v2");
266        if ($ret){
267            return -$ret
268        }
269        if ($ARCH{$a1} < $ARCH{$a2}){
270            return -1 
271        }elsif ($ARCH{$a1} > $ARCH{$a2}){
272            return 1
273        }else{
274            return 0
275        }
276    }
277}
278
279
2801
281
282# Changelog
283#
284# 2002 06 01
285#
286# use perl-URPM
287# add mkcd_build_hdlist function
288#
289# 2002 06 03
290#
291# new perl-URPM API
Note: See TracBrowser for help on using the repository browser.