source: soft/build_system/build_system/mkcd/tags/v2-9-3/pm/Mkcd/Package.pm @ 1

Last change on this file since 1 was 1, checked in by fasma, 13 years ago

Initial Import from Mandriva's soft revision 224062 and package revision 45733

File size: 10.0 KB
Line 
1package Mkcd::Package;
2
3our $VERSION = '0.0.4';
4
5use File::NCopy qw(copy);       
6use File::Path;       
7use rpmtools;
8use Mkcd::Tools qw(du cleanrpmsrate printDiscsFile);
9require Exporter;
10our @ISA = qw(Exporter);
11our @EXPORT = qw(packageOutOfRpmsrate genDeps getLeaves getRPMsKeys getSize rpmVersionCompare);
12
13=head1 NAME
14
15Packages - mkcd module
16
17=head1 SYNOPSYS
18
19    require Mkcd::Functions;
20
21=head1 DESCRIPTION
22
23C<Mkcd::Functions> include the mkcd low level packages functions.
24
25=head1 SEE ALSO
26
27mkcd
28
29=head1 COPYRIGHT
30
31Copyright (C) 2000,2001 MandrakeSoft <warly@mandrakesoft.com>
32
33This program is free software; you can redistribute it and/or modify
34it under the terms of the GNU General Public License as published by
35the Free Software Foundation; either version 2, or (at your option)
36any later version.
37
38This program is distributed in the hope that it will be useful,
39but WITHOUT ANY WARRANTY; without even the implied warranty of
40MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
41GNU General Public License for more details.
42
43You should have received a copy of the GNU General Public License
44along with this program; if not, write to the Free Software
45Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
46
47=cut
48
49my %ARCH = ( 
50    i586 => 1,
51    noarch => 1,
52    k7 => 1,
53    ppc => 1,
54    ia64 => 1,
55    i686 => 2,
56    i486 => 2,
57    i386 => 3
58);
59
60sub genDeps{
61    my ($top,$reps,$deps,$VERBOSE,$TMP) = @_;
62    $top or print "ERROR: no top dir defined\n" and return 0;
63    -d $top or mkpath $top or die "Could not create $top\n";
64    $VERBOSE and print "REPS @$reps ($top/depslist.ordered)\n";
65    my $params = new rpmtools("sourcerpm");
66    my @reps = @$reps;
67    if ($deps || ! -f "$top/depslist.ordered") {
68        map { $_ and $_ .= "/*.rpm"} @reps;
69        $VERBOSE and print "MAP : @reps\n";
70        my @rpms;
71        my %done;
72        foreach (map glob, @reps){
73            /src.rpm$/ and next;
74            m,([^/]+)$,;
75            $done{$1} and next;
76            push @rpms, $_;
77            $done{$1} = 1
78        }
79        $params->build_hdlist(1, 9,"$TMP/.mkcd_build_hdlist", "$top/hdlist.cz", @rpms);
80        $params->clean();
81        print "generating base files\n";
82        if (-r "$top/provides") {
83            open F, "$top/provides";
84            $params->read_provides_files(\*F);
85            close F;
86        }
87
88        $params->read_hdlists("$top/hdlist.cz");
89        $params->compute_depslist();
90
91        my @unresolved = $params->get_unresolved_provides_files();
92        if (@unresolved > 0) {
93            $params->clean();
94
95            $params->read_hdlists("$top/hdlist.cz");
96            $params->keep_only_cleaned_provides_files();
97            $params->read_hdlists("$top/hdlist.cz");
98            $params->compute_depslist();
99        }
100        # reorder the hdlist not needed for this
101        # $params->build_hdlist(1, "$tmp/.mkcd_build_hdlist", "$top/hdlist.cz", map (glob, map( { $_ and $_ .= "/*.rpm"}  map( {ref and @$_ } @$reps))));
102        print "writing $top/depslits.ordered\n";
103        open F, ">$top/depslist.ordered" or die "unable to write depslist file $top/depslist.ordered\n";
104        $params->write_depslist(\*F);
105        close F;
106        print "writing $top/provides\n";
107        open F, ">$top/provides" or die "unable to write provides file $top/provides\n";
108        $params->write_provides(\*F);
109        close F;
110    } else {
111        # TODO must create a real read_depslist function that really recreate a depslist with a file.
112        $params->read_provides_files("$top/provides");
113        $params->read_hdlists("$top/hdlist.cz");
114        #
115        # FIXME read_hdlist is not enough and cannot be user to set params deps
116        #       $params->read_depslist("$top/depslist.ordered");
117        $params->compute_depslist();
118        my @unresolved = $params->get_unresolved_provides_files();
119        if (@unresolved > 0) {
120            $params->clean();
121            $params->read_hdlists("$top/hdlist.cz");
122            $params->keep_only_cleaned_provides_files();
123            $params->read_hdlists("$top/hdlist.cz");
124            $params->compute_depslist();
125        }
126    }
127    return $params
128}
129
130sub packageOutOfRpmsrate{
131    my ($rpmsrate) = @_;
132    my $rate = cleanrpmsrate($rpmsrate);
133    print join("\n",sort(keys %$rate)),"\n";
134    1
135}
136
137sub getLeaves {
138    my ($depslist) = @_;
139    open DEP, "$depslist" or die "Could not open $depslist\n";
140    my @name;
141    my %pkg;
142    my $i = 0;
143    foreach (<DEP>){
144        chomp;
145        my ($name, undef, @de) = split " ", $_; 
146        ($name, my $version, my $release) = $name =~ /(.*)-([^-]*)-([^-]*)/;
147        if ($name){
148            foreach my $d (@de) {
149                if ($d !~ s/^NOTFOUND_//) { 
150                    my @t = split '\|',$d ; 
151                    foreach my $t (@t) { if ($t !~ s/NOTFOUND_//) { $pkg{$name[$t]}++ }}
152                }else { $pkg{$name[$d]}++}
153            }
154        }
155        $name[$i] = $name;
156        $pkg{$name[$i]}++;
157        $i++;
158    }
159    foreach (sort keys %pkg){
160        print $pkg{$_} - 1, " $_\n";
161    }
162    1
163}
164
165sub getRpmsrate{
166    print "ERROR: this function is deprecated\n";
167    return 0;
168
169    my ($rpmsrate,$reps,$tmp,$name,$VERBOSE) = @_;
170    my $TMP = $tmp || $ENV{TMPDIR};
171    my $tmprpmsrate = "$TMP/$name/rpmsrate";
172    local *R; open R, ">$tmprpmsrate" or print "ERROR: cannot open temporary rpmsrate file $tmprpmsrate\n";
173    my $rate = Mkcd::Tools::cleanrpmsrate($rpmsrate,*R,@$reps);
174    close R;
175    unlink "$rpmsrate" and copy "$tmprpmsrate", "$rpmsrate";
176    local *R; open R, "$rpmsrate" or print "ERROR: cannot open rpmsrate file $rpmsrate\n";
177#    my $rate;
178#    my $data;
179#    my $current;
180#   my $max;
181#    while (<R>){
182#       s/#.*//; # comments
183#       /^\s*$/ and next;
184#       if (/^(\S+)/) {
185#           $current = $1;
186#           next
187#       }
188#       my ($indent,$r,$flags,$data) = /^(\s*)([1-5]?)(\s*(?:(?:!\s*)?[0-9A-Z_]+(?:"[^"]*")?(?:\s+(?:\|\|\s+)?)*)*\s*)(.*)$/;
189#       $rate = $r > 0 ? $r : $rate;
190#       $VERBOSE and print "getRpmsrate: current $current ($flags)\n";
191#       $data or next;
192#       my @k = split ' ', $data;
193#       $VERBOSE and print "getRpmsrate @k ($rate)\n";
194#       $rate > $max and $max = $rate;
195#       @rate{@k} = map $rate, @k;
196#       print "DEBUG @k\n";
197#       push @{$section{$current}}, @k
198#    }
199    [$rate->[0],$rate->[1]];
200}
201
202# sub getreps{
203#     my ($lists) = @_;
204#    my @reps;
205#    foreach my $i (@{$lists}){
206#       my (undef,undef,undef,undef,@list) = @{$config[2][$i][0]};
207#       foreach (@list){
208#           my $t = $config[1][$i];
209#           ref $t or next;
210#           foreach (@{$t->[1]}) {
211#               $VERBOSE and print "REPOSITORY $_->[1] -- $_->[2]\n";
212#               push @{$reps[$i]} , $_->[0] }
213#       }
214#    }
215#    return (\@reps)
216#}
217
218sub getRPMsKeys{
219    my ($list,@hdlist) = @_;
220    my %keys;
221    foreach (@hdlist){
222        my $packer = new packdrake($_);
223        my $count = scalar keys %{$packer->{data}};
224        print "$count files in archive, uncompression method is \"$packer->{uncompress}\"\n";
225        foreach my $file (@{$packer->{files}}) {
226            if ($file =~ /(.*):(.*)/){
227                $keys{rpm}{$1} = $2;
228                $keys{key}{$2} = $1
229            }else{
230                $keys{rpm}{$file} = $file;
231                $keys{key}{$file} = $file
232            }
233            $list and printf "l %13c %s -> %s\n", ' ', $file, $packer->{data}{$file}[1]
234        }
235    }
236    return \%keys
237}
238
239sub getSize{
240    my ($group,$config,$VERBOSE) = @_;
241    my $max;
242    my $redeps;
243    foreach my $listnumber (keys %{$group->{list}}){
244        print "getSize list $listnumber\n";
245        my $repnb;
246        $group->{nodeps}{$listnumber} and next;
247        #$config[1][$listnumber][2]{done} and next;
248        my $testarch = join '|', keys %ARCH;
249        foreach (@{$config->{list}[$listnumber]{packages}}) {
250            $repnb++;
251            my ($dir, @srpms) = @{$_};
252            $VERBOSE and print "getSize DIRECTORY $dir\n";
253            local *RPMS; opendir RPMS, $dir or print "WARNING: getSize: cannot open $dir\n" and next;
254            foreach (readdir RPMS){
255                /(.*)\.rpm$/ or next;
256                /src\.rpm$/ and next;
257                my $rpm = $group->{rpmkey}{key}{$1} or print "$1 not in depslist, forcing rebuilt\n" and return 2;
258                # 2002 03 19 links has zero size and must be keep like that for buildDisc to work correctly
259                #my $b;
260                #if (-l "$dir/$_"){
261                #    my $pkg = readlink "$dir/$_";
262                #    -f $pkg or $pkg = "$dir/$pkg";
263                #    $b = Mkcd::Tools::du($pkg);
264                #}else{
265                #    $b = Mkcd::Tools::du("$dir/$_");
266                #}
267                my $b = Mkcd::Tools::du("$dir/$_");
268                $b or print "WARNING getSize: $rpm has a zero size\n";
269                ref $group->{size}{$rpm}{$listnumber} and print "ERROR getSize: duplicate $rpm in list $listnumber, ignoring\n" and next;
270                $group->{size}{$rpm}{$listnumber} = [$b,$dir,$repnb];
271                push @{$group->{listrpm}{$listnumber}}, $rpm;
272                $group->{listsize}{$listnumber}{rpm} += $b;
273                $b > $max and $max = $b;
274            }
275            foreach $dir (@srpms){
276                $VERBOSE and print "getSize DIRECTORY $dir\n";
277                local *SRPMS; opendir SRPMS, $dir or print "WARNING: getSize: cannot open $dir\n" and next;
278                foreach (readdir SRPMS){
279                    /\.rpm$/ or next;
280                    /($testarch)\.rpm$/ and next;
281                    my ($srpm,$srpmname,$key);
282                    if (($srpm,$srpmname) = /((.*)-[^-]*-[^-]*\.src)\.rpm$/){
283                        $key = $srpm;
284                    }else {
285                        ($key) = /(.*)\.rpm$/;
286                        my %header;
287                        tie %header, "RPM::Header", "$dir/$_" or print "ERROR getSize: $RPM::err" and next;
288                        $header{'SOURCERPM'} eq "(none)" or next;
289                        $srpmname = $header{'NAME'};
290                        $srpm = "$srpmname-$header{'VERSION'}-$header{'RELEASE'}.src";
291                    }
292                    $group->{rpmkey}{key}{$key} = $srpm; 
293                    $group->{rpmkey}{rpm}{$srpm} = $key; 
294                    # 2002 03 19 links has zero size and must be keep like that for buildDisc to work correctly
295                    #my $b;
296                    #if (-l "$dir/$_"){
297                        #my $pkg = readlink "$dir/$_";
298                        #-f $pkg or $pkg = "$dir/$pkg";
299                        #$b = Mkcd::Tools::du($pkg);
300                        #}else{
301                        #$b = Mkcd::Tools::du("$dir/$_");
302                        #}
303                    my $b = Mkcd::Tools::du("$dir/$_");
304                    $b or print "WARNING getSize: $srpm has a zero size\n";
305                    ref $group->{size}{$srpm}{$listnumber} and print "ERROR getSize: duplicate $srpm in list $listnumber, ignoring\n" and next;
306                    $group->{size}{$srpm}{$listnumber} = [$b,$dir,$repnb];
307                    $group->{srpmname}{$srpmname} = $srpm;
308                }
309            }
310        }
311    }
312    $group->{maxsize} = $max;
313    1
314}
315
316sub rpmVersionCompare{
317    my ($pkg1, $pkg2) = @_;
318    my ($n1,$v1,$r1,$a1) = $pkg1 =~ /^(.*)-([^-]+)-([^-]+)\.([^.]+)(\.rpm)?$/;
319    my ($n2,$v2,$r2,$a2) = $pkg2 =~ /^(.*)-([^-]+)-([^-]+)\.([^.]+)(\.rpm)?$/;
320    die "ERROR rpmVersionCompare: trying to compare version of two differently named packages ($pkg1,$pkg2)\n" if (!($n1 eq $n2)) ;
321    my $ret = rpmtools::version_compare($v1,$v2);
322    if ($ret){
323        return $ret
324    }else{
325        $ret = rpmtools::version_compare($r1,$r2);
326        if ($ret){
327            return $ret
328        }else{
329            if($ARCH{$a1} < $ARCH{$a2}){
330                return -1 
331            }elsif($ARCH{$a1} > $ARCH{$a2}){
332                return 1
333            }else{
334                return 0
335            }
336        }
337    }
338}
339
340
3411
Note: See TracBrowser for help on using the repository browser.