File Coverage

blib/lib/MDV/Distribconf/Build.pm
Criterion Covered Total %
statement 54 174 31.0
branch 14 82 17.0
condition 3 30 10.0
subroutine 13 22 59.0
pod 11 12 91.6
total 95 320 29.6


line stmt bran cond sub pod time code
1             package MDV::Distribconf::Build;
2              
3             =head1 NAME
4              
5             MDV::Distribconf::Build - Subclass to MDV::Distribconf to build configuration
6              
7             =head1 METHODS
8              
9             =over 4
10              
11             =cut
12              
13 2     2   69439 use strict;
  2         16  
  2         59  
14 2     2   11 use warnings;
  2         4  
  2         48  
15 2     2   11 use File::Path;
  2         2  
  2         139  
16 2     2   1175 use MDV::Packdrakeng;
  2         27649  
  2         71  
17 2     2   1484 use File::Temp qw(tempfile);
  2         39503  
  2         134  
18 2     2   1071 use File::Copy qw(cp);
  2         4804  
  2         116  
19 2     2   16 use Digest::MD5;
  2         6  
  2         87  
20              
21 2     2   13 use base qw(MDV::Distribconf MDV::Distribconf::Checks);
  2         4  
  2         1215  
22             our $VERSION = (qq$Revision$ =~ /(\d+)/)[0];
23              
24             =item MDV::Distribconf::Build->new($root_of_distrib)
25              
26             Returns a new MDV::Distribconf::Build object.
27              
28             =cut
29              
30             sub new {
31 2     2 1 596 my $class = shift;
32 2         19 my $self = $class->SUPER::new(@_);
33 2         10 bless $self, $class;
34             }
35              
36             =item $distrib->init($flavour)
37              
38             Create initals directories in the distrib tree if missing.
39              
40             $flavour is either 'mandriva' or 'mandrake', depending the tree type
41             you want to create.
42              
43             See also L
44              
45             Return 1 on success, 0 otherwise.
46              
47             =cut
48              
49             sub init {
50 0     0 1 0 my ($self, $flavour) = @_;
51 0 0 0     0 $self->settree($flavour || 'mandriva') unless($self->{infodir});
52 0 0       0 if (!-d $self->getfullpath(undef, 'root')) {
53 0 0       0 if (!mkdir($self->getfullpath(undef, 'root'))) {
54 0         0 warn 'Cannot create ' . $self->getfullpath(undef, 'root') .": $!\n";
55 0         0 return 0;
56             }
57             }
58 0         0 foreach my $dir (map { $self->getfullpath(undef, $_) } qw(mediadir infodir)) {
  0         0  
59 0 0       0 if (!-d $dir) {
60 0         0 eval { mkpath($dir) };
  0         0  
61 0 0       0 if ($@) {
62 0         0 warn "Cannot create $dir: $@\n";
63 0         0 return 0;
64             }
65             }
66             }
67              
68 0         0 foreach my $media ($self->listmedia()) {
69 0 0       0 $self->create_media($media) or return 0;
70             }
71              
72 0         0 1;
73             }
74              
75             =item $distrib->create_media($media)
76              
77             Create a media $media if not exists and its directories if need.
78              
79             See also L
80              
81             Return 1 on success, 0 otherwise
82              
83             =cut
84              
85             sub create_media {
86 0     0 1 0 my ($self, $media) = @_;
87 0         0 $self->setvalue($media, undef, undef);
88 0         0 foreach my $dir (map { $self->getfullmediapath($media, $_) } qw(path infodir)) {
  0         0  
89 0 0       0 if (!-d $dir) {
90 0         0 eval { mkpath($dir) };
  0         0  
91 0 0       0 if ($@) {
92 0         0 warn "Cannot create $dir: $@\n";
93 0         0 $self->delvalue($media, undef);
94 0         0 return 0;
95             }
96             }
97             }
98              
99 0         0 1;
100             }
101              
102             =item $distrib->setvalue($media, $var, $val)
103              
104             Sets or adds $var parameter from $media to $val. If $media doesn't exist,
105             it is implicitly created. If $var is C, a new media is created with
106             no defined parameters.
107              
108             =cut
109              
110             sub setvalue {
111 3     3 1 660 my ($distrib, $media, $var, $val) = @_;
112 3   100     14 $media ||= 'media_info';
113 3         13 $distrib->{cfg}->AddSection($media);
114 3 100       149 if ($var) {
115 2 50 33     14 if ($media && !$distrib->mediaexists($media)) {
116 0         0 $distrib->setvalue($media);
117             }
118 2 50       27 $var =~ /^(?:media|info)dir\z/ and do {
119 0         0 $distrib->{$var} = $val;
120 0         0 return 1;
121             };
122 2 50       4 if ($val) {
123 2 50       7 $distrib->{cfg}->newval($media, $var, $val)
124             or warn "Can't set value [$var=$val] for $media\n";
125             } else {
126 0         0 $distrib->{cfg}->delval($media, $var);
127             }
128             }
129 3 50       193 $distrib->_post_setvalue($media, $var, $val) if ($media);
130             }
131              
132             sub _post_setvalue {
133 3     3   7 my ($distrib, $cmedia, $cvar, $cval) = @_;
134 3 100       9 if ($cvar) {
135 2         7 my $vsettings = MDV::Distribconf::MediaCFG::_value_info($cvar);
136 2 50       9 if ($vsettings->{cross}) {
137 0         0 my %pointed_media = map { $_ => 1 } split(/\s/, $cval);
  0         0  
138 0         0 foreach my $media ($distrib->listmedia()) {
139 0         0 my %ml = map { $_ => 1 }
140 0         0 split(/\s/, $distrib->getvalue($media, $vsettings->{cross}));
141              
142 0 0       0 if (exists($pointed_media{$media})) {
143 0 0       0 exists($ml{$cmedia}) and next;
144 0         0 $ml{$cmedia} = 1;
145             } else {
146 0 0       0 exists($ml{$cmedia}) or next;
147 0         0 delete($ml{$cmedia});
148             }
149             $distrib->setvalue(
150             $media,
151             $vsettings->{cross},
152 0         0 join(" ", keys %ml),
153             );
154             }
155             }
156             } else {
157 1         7 foreach my $media ($distrib->listmedia()) {
158 1         4 foreach my $val ($distrib->{cfg}->Parameters($media)) {
159 0         0 my $vsettings = MDV::Distribconf::MediaCFG::_value_info($val);
160 0 0       0 if ($vsettings->{cross}) {
161 0 0       0 if (grep { $_ eq $cmedia }
  0         0  
162             split(/\s/, $distrib->getvalue($media, $val))) {
163 0         0 my %ml = map { $_ => 1 }
164 0         0 split(/\s/, $distrib->getvalue($cmedia, $vsettings->{cross}));
165 0 0       0 exists($ml{$media}) and next;
166 0         0 $ml{$media} = 1;
167             $distrib->setvalue(
168             $cmedia,
169             $vsettings->{cross},
170 0         0 join(" ", keys %ml),
171             );
172             }
173             }
174             }
175             }
176             }
177 3         32 1;
178             }
179              
180             =item $distrib->delvalue($media, $var)
181              
182             Delete $var parameter from $media. If $var is not specified, the media is
183             is deleted. If $media is not specified, $var is remove from global settings.
184              
185             =cut
186              
187             sub delvalue {
188 2     2 1 6 my ($distrib, $media, $var) = @_;
189 2 100       5 if ($var) {
190 1         5 $distrib->{cfg}->delval($media, $var);
191             } else {
192 1         5 $distrib->{cfg}->DeleteSection($media);
193             }
194 2         133 $distrib->_post_delvalue($media, $var);
195             }
196              
197             sub _post_delvalue {
198 2     2   5 my ($distrib, $cmedia, $cvar) = @_;
199 2         6 foreach my $media ($distrib->listmedia()) {
200 1 50       3 if ($cvar) {
201 1         4 my $vsettings = MDV::Distribconf::MediaCFG::_value_info($cvar);
202 1 50       14 if ($vsettings->{cross}) {
203 0 0       0 if($distrib->getvalue($media, $vsettings->{cross})) {
204 0         0 my %ml = map { $_ => 1 } split(/\s/, $distrib->getvalue($media, $vsettings->{cross}));
  0         0  
205 0 0       0 exists($ml{$cmedia}) or next;
206 0         0 delete($ml{$cmedia});
207              
208             $distrib->setvalue(
209             $media,
210             $vsettings->{cross},
211 0         0 join(" ", keys %ml)
212             );
213             }
214             }
215             } else {
216 0         0 foreach my $val ($distrib->{cfg}->Parameters($media)) {
217 0         0 my $vsettings = MDV::Distribconf::MediaCFG::_value_info($val);
218 0 0 0     0 if ($vsettings->{ismedialist} && $distrib->getvalue($media, $val)) {
219 0         0 my %ml = map { $_ => 1 } split(/\s/, $distrib->getvalue($media, $val));
  0         0  
220 0 0       0 exists($ml{$cmedia}) or next;
221 0         0 delete($ml{$cmedia});
222 0         0 $distrib->setvalue(
223             $media,
224             $val,
225             join(" ", keys %ml)
226             );
227             }
228             }
229             }
230             }
231 2         8 1;
232             }
233              
234             =item $distrib->write_hdlists($hdlists)
235              
236             Writes the F file to C<$hdlists>, or if no parameter is given, in
237             the media information directory. C<$hdlists> can be a file path or a file
238             handle. Returns 1 on success, 0 on error.
239              
240             =cut
241              
242             sub write_hdlists {
243 0     0 1   my ($distrib, $hdlists) = @_;
244 0           my $h_hdlists;
245 0 0         if (ref $hdlists eq 'GLOB') {
246 0           $h_hdlists = $hdlists;
247             } else {
248 0   0       $hdlists ||= "$distrib->{root}/$distrib->{infodir}/hdlists";
249 0 0         open $h_hdlists, ">", $hdlists
250             or return 0;
251             }
252 0           foreach my $media ($distrib->listmedia) {
253             printf($h_hdlists "%s%s\t%s\t%s\t%s\n",
254 0 0 0       join('', map { "$_:" } grep { $distrib->getvalue($media, $_) } qw/askmedia suppl noauto/) || "",
    0          
255             $distrib->getvalue($media, 'hdlist'),
256             $distrib->getpath($media, 'path'),
257             $distrib->getvalue($media, 'name'),
258             $distrib->getvalue($media, 'size') ? '('.$distrib->getvalue($media, 'size'). ')' : "",
259             ) or return 0;
260             }
261 0           return 1;
262             }
263              
264             =item $distrib->write_mediacfg($mediacfg)
265              
266             Write the media.cfg file into the media information directory, or into the
267             $mediacfg given as argument. $mediacfg can be a file path, or a glob reference
268             (\*STDOUT for example).
269              
270             Returns 1 on success, 0 on error.
271              
272             =cut
273              
274             sub write_mediacfg {
275 0     0 1   my ($distrib, $hdlistscfg) = @_;
276 0   0       $hdlistscfg ||= "$distrib->{root}/$distrib->{infodir}/media.cfg";
277 0           $distrib->{cfg}->WriteConfig($hdlistscfg);
278             }
279              
280             =item $distrib->write_version($version)
281              
282             Write the VERSION file. Returns 0 on error, 1 on success.
283              
284             =cut
285              
286             sub write_version {
287 0     0 1   my ($distrib, $version) = @_;
288 0           my $h_version;
289 0 0         if (ref($version) eq 'GLOB') {
290 0           $h_version = $version;
291             } else {
292 0   0       $version ||= $distrib->getfullpath(undef, 'VERSION');
293 0 0         open($h_version, ">", $version) or return 0;
294             }
295              
296 0           my @gmt = gmtime(time);
297              
298 0 0 0       printf($h_version "Mageia %s %s-%s-%s%s %s\n",
      0        
      0        
299             $distrib->getvalue(undef, 'version') || 'cauldron',
300             $distrib->getvalue(undef, 'branch') || 'cauldron',
301             $distrib->getvalue(undef, 'arch') || 'noarch',
302             $distrib->getvalue(undef, 'product'),
303             $distrib->getvalue(undef, 'tag') ? '-' . $distrib->getvalue(undef, 'tag') : '',
304             sprintf("%04d%02d%02d %02d:%02d", $gmt[5] + 1900, $gmt[4]+1, $gmt[3], $gmt[2], $gmt[1])
305             );
306              
307 0 0         if (ref($version) ne 'GLOB') {
308 0           close($h_version);
309             }
310 0           return 1;
311             }
312              
313             =item $distrib->write_productid($productid)
314              
315             Write the productid file. Returns 0 on error, 1 on success.
316              
317             =cut
318              
319             sub write_productid {
320 0     0 1   my ($distrib, $productid) = @_;
321 0           my $h_productid;
322 0 0         if (ref($productid) eq 'GLOB') {
323 0           $h_productid = $productid;
324             } else {
325 0   0       $productid ||= $distrib->getfullpath(undef, 'product.id');
326 0 0         open($h_productid, ">", $productid) or return 0;
327             }
328              
329 0           print $h_productid $distrib->getvalue(undef, 'productid') . "\n";
330              
331 0 0         if (ref($productid) ne 'GLOB') {
332 0           close($h_productid);
333             }
334              
335 0           return 1;
336             }
337              
338             =item $distrib->list_existing_medias()
339              
340             List media which really exists on the disk
341              
342             =cut
343              
344             sub list_existing_medias {
345 0     0 1   my ($self) = @_;
346 0           grep { -d $self->getfullmediapath($_, 'path') } $self->listmedia();
  0            
347             }
348              
349             =item $distrib->set_medias_size($media)
350              
351             Set media size into media.cfg for $media
352              
353             =cut
354              
355             sub set_media_size {
356 0     0 0   my ($self, $media) = @_;
357 0           my $size = 0;
358 0           foreach (glob($self->getfullmediapath($media, 'path') . '/*.rpm')) {
359 0           $size += (stat($_))[7];
360             }
361 0           my $blk = 1;
362 0           my $showsize = $size;
363 0           my @unit = (' ', qw(k m g));
364 0           while (@unit) {
365 0           my $u = shift(@unit);
366 0 0         if ($size / $blk < 1) {
367 0           last;
368             }
369 0           $showsize = sprintf('%d%s', $size / $blk, $u);
370 0           $blk *= 1024;
371             }
372 0           $self->setvalue($media, 'size', $showsize);
373             }
374              
375             =item $distrib->set_all_medias_size()
376              
377             Set media size into media.cfg
378              
379             =cut
380              
381             sub set_all_medias_size {
382 0     0 1   my ($self) = @_;
383 0           foreach my $media ($self->list_existing_medias()) {
384 0           $self->set_media_size($media);
385             }
386             }
387              
388             1;
389              
390             __END__