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