1 | package Mkcd::Package; |
---|
2 | |
---|
3 | our $VERSION = '0.1.2'; |
---|
4 | |
---|
5 | use File::NCopy qw(copy); |
---|
6 | use File::Path; |
---|
7 | use URPM; |
---|
8 | use URPM::Build; |
---|
9 | use Mkcd::Tools qw(du cleanrpmsrate printDiscsFile); |
---|
10 | use strict; |
---|
11 | require Exporter; |
---|
12 | our @ISA = qw(Exporter); |
---|
13 | our @EXPORT = qw(packageOutOfRpmsrate genDeps getLeaves list_hdlist getSize rpmVersionCompare mkcd_build_hdlist %ARCH); |
---|
14 | |
---|
15 | use vars qw(%ARCH); |
---|
16 | |
---|
17 | =head1 NAME |
---|
18 | |
---|
19 | Packages - mkcd module |
---|
20 | |
---|
21 | =head1 SYNOPSYS |
---|
22 | |
---|
23 | require Mkcd::Functions; |
---|
24 | |
---|
25 | =head1 DESCRIPTION |
---|
26 | |
---|
27 | C<Mkcd::Functions> include the mkcd low level packages functions. |
---|
28 | |
---|
29 | =head1 SEE ALSO |
---|
30 | |
---|
31 | mkcd |
---|
32 | |
---|
33 | =head1 COPYRIGHT |
---|
34 | |
---|
35 | Copyright (C) 2000,2001 MandrakeSoft <warly@mandrakesoft.com> |
---|
36 | |
---|
37 | This program is free software; you can redistribute it and/or modify |
---|
38 | it under the terms of the GNU General Public License as published by |
---|
39 | the Free Software Foundation; either version 2, or (at your option) |
---|
40 | any later version. |
---|
41 | |
---|
42 | This program is distributed in the hope that it will be useful, |
---|
43 | but WITHOUT ANY WARRANTY; without even the implied warranty of |
---|
44 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
---|
45 | GNU General Public License for more details. |
---|
46 | |
---|
47 | You should have received a copy of the GNU General Public License |
---|
48 | along with this program; if not, write to the Free Software |
---|
49 | Foundation, 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 | |
---|
65 | sub 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 | |
---|
105 | sub 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 | |
---|
138 | sub packageOutOfRpmsrate { |
---|
139 | my ($rpmsrate) = @_; |
---|
140 | my $rate = cleanrpmsrate($rpmsrate); |
---|
141 | print join("\n", sort(keys %$rate)), "\n"; |
---|
142 | 1 |
---|
143 | } |
---|
144 | |
---|
145 | sub 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 | |
---|
173 | sub 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 | |
---|
188 | sub 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 | |
---|
202 | sub 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 | |
---|
256 | sub 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 | |
---|
280 | 1 |
---|
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 |
---|