source: soft/build_system/build_system/mkcd/tags/V3_0_1_1mdk/pm/Mkcd/Tools.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: 23.5 KB
Line 
1package Mkcd::Tools;
2
3our $VERSION = '0.5.1';
4
5use strict;
6use File::NCopy qw(copy);       
7use Image::Size qw(:all);
8use Mkcd::Commandline qw(parseCommandLine usage);
9use Digest::MD5;
10require Exporter;
11use rpmtools;
12our @ISA = qw(Exporter);
13our @EXPORT = qw(printTable getTracks du cpal checkcds checkDiscs cleanrpmsrate imageSize printDiscsFile readBatchFile printBatchFile config compute_md5 log_);
14
15=head1 NAME
16
17tools - mkcd tools
18
19=head1 SYNOPSYS
20
21    require mkcd::tools;
22
23=head1 DESCRIPTION
24
25<mkcd::tools> includes mkcd tools.
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
51sub printTable {
52    my ($a,$log) = @_;
53    my $LOG; if ($log) { my $LOG = $log } else { open $LOG, ">&STDERR"}
54    #
55    # iterative version of a recursive scanning of a table.
56    # ex: @config = [[[1,3],3,[1,3,[1,3]]],3,4,[4,[4,4]]]
57    #   
58    my @A;
59    my @i;
60    my @tab;
61    my $i = 0;
62    while ($a){
63        my $u = ref $a;
64        if ($u eq 'ARRAY') {
65            while ($i < @$a){
66                my $b = $a->[$i];
67                my $t = ref $b;
68                if ($t eq 'ARRAY'){
69                    push @tab, "\t";
70                    push @i, $i+1;
71                    push @A, $a;
72                    $i = 0;
73                    $a = $b;
74                    next
75                } elsif ($t eq 'HASH') { 
76                    $i++; print {$LOG} "@tab", join ' ',keys %$b,"\n"
77                } else { $i++; print {$LOG} "@tab$b\n" }
78            }
79        } else { print {$LOG} "$a\n" }
80        pop @tab;
81        $i = pop @i;
82        $a = pop @A;
83    }
84
85}
86
87sub getTracks{
88    my ($tracks,$log) = @_;
89    my $LOG; if ($log) { my $LOG = $log } else { open $LOG, ">&STDERR"}
90    my @tracks = split ',',$tracks;
91    my @t;
92    foreach (@tracks){
93        /(\d+)/ and push @t, $1;
94        /(\d+)-(\d+)/ and push @t, $1..$2       
95    }
96    my @tracks;
97    my %done;
98    for(my $i = $#t; $i >= 0; $i-- ){
99        push @tracks, $t[$i] if !$done{$t[$i]};
100        $done{$t[$i]}=1
101    }
102    \@tracks;
103}
104
105sub du {
106    my ($path,$size) = @_;
107    my $size;
108    if (-d $path){
109        opendir O, $path;
110        foreach (readdir O){
111            /^\.{1,2}$/ and next;
112            -l "$path/$_" or $size += du("$path/$_")
113        }
114    } else {
115        -l $path or $size = (stat $path)[7] + 2048;
116    }
117    $size
118}
119
120sub cpal{
121    my ($source,$dest,$exclude,$verbose,$log) = @_;
122    my $LOG; if ($log) { my $LOG = $log } else { open $LOG, ">&STDERR"}
123    if ($exclude && "$source/$_" =~ /$exclude/) {return 0}
124    if (!-l $source && -d $source){
125        mkdir "$dest";
126        opendir O, $source; 
127        foreach (readdir O){
128            /^\.{1,2}$/ and next;
129            cpal("$source/$_","$dest/$_",$exclude,$verbose)
130        }
131    }else {
132        my $err;
133        if (-d $dest){ my ($filename) = $source =~ /([^\/]*)$/; $dest .= "/$filename"}
134        $err = link "$source","$dest" ;
135        $verbose and print {$LOG} "cpal: link $source -> $dest\n" ; 
136        if (!$err) { 
137            print {$LOG} "Linking failed $source -> $dest: $!, trying to copy\n" ; 
138            $err = copy "$source", "$dest"; 
139            if (!$err) { print {$LOG} "Copying failed $source -> $dest: $!,\n"; return 0}
140        }
141    }
142    1
143}
144
145sub checkDiscs{
146    my ($hdlists,$depslist,$discsFiles,$check,$log) = @_;
147    my $LOG; if ($log) { $LOG = $log } else { open $LOG, ">&STDOUT"}
148    local *A; open A, $depslist or print {$LOG} "ERROR: unable to open $depslist" and return 0;
149
150    #
151    # depslist hdlist consistency -> error   ok (not the same as instal one, but duplicate will break anyway)
152    #
153    # in hdlist, not in depslist -> error    ok
154    #
155    # in hdlist, not in dir -> error         ok
156    #
157    # in depslist, not in hdlist -> error    ok
158    #
159    # in depslist, not in dir -> error       ok
160    #
161    # in dir, not in hdlist -> warning       ok
162    #
163    # in dir, not in depslist -> warning     ok
164    #
165    # multiple version in depslist -> error  ok
166    #
167    # multiple version in hdlist -> error    ok
168    #
169    # multiple in dir -> warning             ok
170    #
171   
172    my $ok = 1;
173    my $OK = 1;
174    my %depslist;
175    my %depslistname;
176    my $i = 1;
177    print {$LOG} "checkDiscs: duplicate version in $depslist:";
178    while (<A>){
179        my ($pkg,$name) = ((split)[0]) =~ /((.*)-[^-]+-[^-]+\.[^:]+)/;
180        $depslist{$pkg} and do { print {$LOG} "\n$pkg"; $ok=0};
181        $depslistname{$name} and do { print {$LOG} "\n$name"; $ok=0};
182        $depslist{$pkg} = $i;
183        $depslistname{$name} = $i++;
184    }
185    close A;
186    $ok or $OK=0;
187    $ok ? print {$LOG} " OK\n" : print {$LOG} "\nFAILED\n";
188    my %hdlist;
189    print {$LOG} "\ncheckDiscs: duplicate version in hdlists:";
190    my $maxidx;
191    my %rpm;
192    my (@rnh,@hnd,@duprep,@rnd,@hnr,%rpmKeys);
193    my $ok = 1;
194    for (my $i = 1; $i < @$hdlists; $i++){
195        my $packer = new packdrake($hdlists->[$i]);
196        my $j;
197        foreach my $file (@{$packer->{files}}) {
198            my ($rpm,$key) = $file =~ /([^:]*)(?::(.*))?/;
199            $rpmKeys{key}{$rpm} = $key ? $key : $rpm;
200            $rpmKeys{rpm}{$rpmKeys{key}{$rpm}} = $rpm;
201            my $sok;
202            foreach my $c (@{$check->[$i]}){
203                my ($cd,$rep,$list) = @$c;
204                $discsFiles->[$cd]{$rep}{$list}{$rpmKeys{key}{$rpm}} and $sok = 1;
205            }
206            $sok or push @hnr, [ $i, $rpm ];
207            $depslist{$rpm} or push @hnd, $rpm;
208            $hdlist{all}{$rpm} and do { print {$LOG} "\n$rpm"; $ok = 0 };
209            $hdlist{all}{$rpm} = 1;
210            $hdlist{cd}{$i}{$rpm}  = 1;
211            $depslist{$rpm} > $j and $j = $depslist{$rpm};
212            $depslist{$rpm} < $maxidx and print {$LOG} "ERROR checkDiscs: inconsistency in position between hdlist $i rpm $rpm and depslist.ordered\n"
213        }
214        foreach my $c (@{$check->[$i]}){
215            my ($cd,$rep,$list) = @$c;
216            foreach my $rpm (keys %{$discsFiles->[$cd]{$rep}{$list}}){
217                $rpm{$rpmKeys{rpm}{$rpm}} and push @duprep, $rpm;
218                $rpm{$rpmKeys{rpm}{$rpm}} = 1;
219                $depslist{$rpmKeys{rpm}{$rpm}} or push @rnd,  [ $i, $cd, $rep, $rpm ];
220                $hdlist{cd}{$i}{$rpmKeys{rpm}{$rpm}} or push @rnh, [ $i, $rpm ]
221            }
222        }
223        $maxidx = $j;
224    }
225    $ok or $OK=0;
226    $ok ? print {$LOG} " OK\n" : print {$LOG} "\nFAILED\n";
227
228    my @dnh;
229    my $ok = 1;
230    print {$LOG} "\ncheckDiscs: in depslist, not on discs:";
231    foreach my $rpm (keys %depslist){
232        $hdlist{all}{$rpm} or do { push @dnh, $rpm };
233        $rpm{$rpm} or do { $ok = 0; print {$LOG} "\n$rpm"};
234    }
235    $ok or $OK=0;
236    $ok ? print {$LOG} " OK\n" : print {$LOG} "\nFAILED\n";
237
238    print {$LOG} "\ncheckDiscs: in depslist, not in hdlists:";
239    @dnh ? do { print {$LOG} " FAILED\n" and $OK = 0 } : print {$LOG} " OK\n";
240    foreach (@dnh){
241        print {$LOG} "$_\n"
242    }
243    print {$LOG} "\ncheckDiscs: in hdlists, not on discs:";
244    @hnr ? do { print {$LOG} " FAILED\n" and $OK = 0 } : print {$LOG} " OK\n";
245    foreach (@hnr){
246        print {$LOG} "hdlist $_->[0] rpm $_->[3]\n"
247    }
248    print {$LOG} "\ncheckDiscs: in hdlists, not in depslist:";
249    @hnd ? do { print {$LOG} " FAILED\n" and $OK = 0 } : print {$LOG} " OK\n";
250    foreach (@hnd){
251        print {$LOG} "$_\n"
252    }
253    print {$LOG} "\ncheckDiscs: on discs, not in hdlist:";
254    @rnh ? print {$LOG} " WARNING\n": print {$LOG} " OK\n";
255    foreach (@rnh){
256        print {$LOG} "hdlist $_->[0] rpm $_->[1]\n"
257    }
258    print {$LOG} "\ncheckDiscs: on discs, not in depslist:";
259    @rnd ? print {$LOG} " WARNING\n": print {$LOG} " OK\n";
260    foreach (@rnd){
261        print {$LOG} "hdlist $_->[0] cd $_->[1] rep $_->[2] missing rpm $_->[3]\n"
262    }
263    print {$LOG} "\ncheckDiscs: duplicate version on discs:";
264    @duprep ? print {$LOG} " WARNING\n": print {$LOG} " OK\n";
265    foreach (@duprep){
266        print {$LOG} "$_\n"
267    }
268    return $OK
269}
270
271#
272# check depslist, depslists.ordered and hdlists
273#
274sub checkcds{
275    my (@tops) = @_;
276   
277    my $top = "$tops[0]/";
278    my $depslist = "$tops[0]/Mandrake/base/depslist.ordered";
279    -f $depslist or print "ERROR: could not find depslist $depslist file\n" and return 0;
280    my $hdlists = "$top/Mandrake/base/hdlists";
281    local *A; open A, $hdlists or die "unable to open $hdlists";
282    my @hdlist = (0);
283    my @discsFiles;
284    my @check = (0);
285    while (<A>){
286        my ($hdlist, $dir, undef) = split;
287        my ($hdid) = $hdlist =~ /(\d*).cz/;
288        my $hdfile = "$tops[0]/Mandrake/base/$hdlist";
289        push @hdlist, $hdfile;
290        push @check, [[ $hdid, $dir, 1 ]];
291        -f $hdfile or print "ERROR: could not find $hdfile file\n" and return 0;
292        local *C;
293        if (! opendir C, "$top/$dir"){
294            foreach (@tops){
295                opendir C, "$_/$dir" or next;
296                last
297            }
298        }
299        foreach (readdir C){
300            /(.*)\.rpm/ or next;
301            $discsFiles[$hdid]{$dir}{1}{$1} = 1
302        }
303
304    }
305    checkDiscs(\@hdlist,$depslist,\@discsFiles,\@check)
306}
307
308sub checkcds_old{
309    my ($tops,$first,$log) = @_;
310    my $LOG; if ($log) { my $LOG = $log } else { open $LOG, ">&STDERR" }
311    my $i;
312    my $top;
313
314    if ($first) { $top = $tops->[$first]} else { while (!$tops->[$i]){$i++}; $top = $tops->[$i]} ;
315
316    local *A; open A, "$top/Mandrake/base/depslist.ordered" or print {$LOG} "ERROR: unable to open $top/Mandrake/base/depslist.ordered" and return 0;
317    my %depspackages;
318    my %dup;
319    my $ok = 1;
320    my $OK=1;
321    print {$LOG} "Duplicate version: ";
322    while (<A>){
323        my ($pkg,$name) = ((split)[0]) =~ /((.*)-[^-]+-[^-]+\.[^:]+)/;
324        $dup{$pkg} and do { print {$LOG} "\n$pkg"; $ok=0 ; $OK=0};
325        $dup{$name} and do { print {$LOG} "\n$name"; $ok=0 ; $OK=0};
326        $depspackages{$pkg} = 1;
327        $dup{$pkg} = 1;
328        $dup{$name} = 1;
329    }
330    $ok ? print {$LOG} " OK\n" : print {$LOG} " FAILED\n";
331
332    my %hdlist;
333    my %rep;
334    my $num;
335    local *A; open A, "$top/Mandrake/base/hdlists" or die "unable to open $top/Mandrake/base/hdlists";
336    while (<A>){
337        my ($hdlist, $dir, undef) = split;
338        $num++;
339        local $_;
340        local *B; open B, "packdrake -l $top/Mandrake/base/$hdlist|" or die "unable to open packdrake $top/Mandrake/base/$hdlist|";
341        <B>;
342        print {$LOG} "\nIn $hdlist, not in depslist:";
343        my $ok = 1;
344        my $p;
345        my $k;
346        my %key;
347        while (<B>){
348            $p = (split)[2];
349            if ($p =~ /(.*):(.*)/){
350                $p = $1;
351                $k = $2;
352                $key{$2} = $1
353            }else { $key{$p} = $p } 
354            # $p =~ s/(\.(i386|i486|i586|i686|noarch))?$//;
355            $hdlist{$p} = 1;
356            if (!$depspackages{$p}) {print {$LOG} "\n$p"; $ok=0; $OK=0}
357        }
358        $p or do { print {$LOG} "$hdlist is empty\n" ; $OK=0};
359        $ok and print {$LOG} " OK\n";
360        local *C;
361        opendir C, "$tops->[$num]/$dir" or opendir C, "$top/$dir";
362        my $ok = 1;
363        print {$LOG} "\n\nIn $tops->[$num]/$dir, not in depslist:";
364        readdir C;
365        readdir C;
366        foreach (readdir C){
367            s/\.rpm// or next;
368            $rep{$key{$_}} = 1;
369            if (!$depspackages{$key{$_}}) {print {$LOG} "\n$_"; $ok=0; $OK = 0}
370        }       
371        $ok ? print {$LOG} " OK\n" : print {$LOG} " FAILED\n";
372    }
373
374    print {$LOG} "\n\nIn depslist, not in hdlist*.cz:";
375    my $ok = 1;
376    foreach (keys %depspackages){ 
377        if (!($hdlist{$_})) {print {$LOG} "\n$_"; $ok=0; $OK=0}
378    }
379    $ok ? print {$LOG} " OK\n" : print {$LOG} " FAILED\n";
380
381    print {$LOG} "\n\nIn depslist, not in RPMS*:";
382    my $ok = 1;
383    foreach (keys %depspackages){ 
384        if (!$rep{$_}) {print {$LOG} "\n$_"; $ok=0; $OK=0}
385    }
386    $ok ? print {$LOG} " OK\n" : print {$LOG} " FAILED\n";
387    print {$LOG} "\n";
388    $OK
389}
390
391#
392# regexp version
393#
394sub cleanrpmsrate2 {
395    my ($rpmsrate,@rpms) = @_;
396    my $LOG; open $LOG, ">&STDERR";
397    my @rpm;
398    foreach (@rpms){
399        -d or print {$LOG} "ERROR: $_ is not a directory\n" and next;
400        local *A; opendir A, $_;
401        push @rpm, grep { s/-[^-]+-[^-]+\.[^.]+\.rpm// } readdir A;
402    }
403    my %done;
404    my (@flags,@c);
405    my ($mod,$text,$prev,$rate,$current);
406    my (%rate,%section);
407    local *A; open A, $rpmsrate or print {$LOG} "ERROR: cannot open $rpmsrate\n";
408    while (<A>){
409        s/#.*//;
410        /^\s*$/ and $text .= "\n" and next;
411        if (/^(\S+)/) {
412            $text .= "$1\n";
413            $current = $1;
414            @flags = ($current);
415            next
416        }
417        my ($indent,$r,$flags,$data) = /^(\s*)([1-5]?)((?:\s+(?:(?:!\s*)?[0-9A-Z_]+(?:"[^"]*")?(?:\s+(?:\|\|\s+)?)*)+\s+)|\s+)(.*)$/;
418        if ($r) {
419            $rate = $r
420        }elsif ($prev){
421            chop $indent;
422            $r = $prev
423        }
424        push @flags, split ' ', $flags; 
425        $data or $text .= "$indent$r$flags" and next;
426        my ($postfix) = $data =~ /(\s*)$/;
427        my @k;
428        foreach my $n (split ' ', $data) {
429            @c = grep { /^$n$/ } @rpm;
430            map { if ((!$done{$_}[1] || $current eq "INSTALL") && $done{$_}[0] ne $current ) { push @k, $_; @{$done{$_}} = @flags }} @c
431        } 
432        if (@k) { $text .= "$indent$r$flags@k$postfix\n"; $prev = '' } else { $prev = $r};
433        @rate{@k} = ($rate) x @k;
434        push @{$section{$current}}, @k
435    }
436    close A;
437    if (@rpms){
438        if (open A, ">$rpmsrate") {
439            print A $text;
440            close A
441        }else{
442            @rpms and print {$LOG} "ERROR: cannot open $rpmsrate for writing\n";
443            print $text
444        }
445    }
446    [\%rate,\%section];
447}
448
449
450sub cleanrpmsrate {
451    my ($rpmsrate,$output,$norpmsrate,@rpms) = @_;
452    $norpmsrate ||= [];
453    my $LOG; open $LOG, ">&STDERR";
454    local *A; open A, $rpmsrate or print {$LOG} "ERROR: cannot open $rpmsrate\n";
455    my @rpmsrate;
456    my %potloc;
457    # must preread to get locale guessed packages
458    # postfix is just used not to break the diff when checking if the result is correct
459    while (<A>){
460        chomp;
461        s/#.*//;
462        #s/\s*$//;
463        /^(\s*)$/ and push @rpmsrate, [ 0, 0, 0, []] and next;
464        if (/^(\S+)(.*)$/) {
465            push @rpmsrate, [ 0, 0, $1, [$1], $2];
466            next
467        }
468        # FIXME hack because entry like "  GNOME" were not matched by the following regexp
469        if (/^(\s*)([0-9A-Z_]+)$/) {
470            push @rpmsrate, [ $1, '', $2, []];
471            next
472        }
473        my ($indent,$r,$flags,$data) = /^(\s*)([1-5]?|\s*)((?:\s*(?:(?:!\s*)?[0-9A-Z_]+(?:"[^"]*")?(?:\s+(?:\|\|\s+)?)*)+\s+)|\s+)(.*)$/;
474        my ($postfix) = $data =~ /(\s*)$/;
475        my @data;
476        my $i;
477        foreach ([$data =~ /(?:^|\s)(\S+)-(?:\S+)\s+\1-(?:\S+)(?:\s|$)/g],[split ' ', $data]){
478            $data[$i++] = [ @$norpmsrate ? grep { my $r = $_; $r if (!grep { $r =~ /$_/ } @$norpmsrate) } @$_ : @$_ ]
479        }
480        map $potloc{$_} = [], @{$data[0]};
481        push @rpmsrate, [ $indent,$r, $flags, $data[1], $postfix ];
482    }
483    my (%rpms,$text);
484    my (%rate,%section);
485    my %locale;
486    foreach my $dir (@rpms){
487        -d $dir or print {$LOG} "ERROR cleanrpmsrate: $dir is not a directory\n" and next;
488        local *A; opendir A, $dir;
489        foreach (readdir A) { 
490            my $rpm = $_;
491            s/-[^-]+-[^-]+\.[^.]+\.rpm$// or next;
492            grep { $rpm =~ /$_/ } @$norpmsrate and next;
493            if (/(.*?)([_-]*[\d._]*)-devel$/ || /(kernel.*)(-[^.]+\.[^.]+\.[^.]+\.[^.]+mdk)$/){ 
494                if (!$rpms{$1}){ $rpms{$1} = $2 }
495                elsif (rpmtools::version_compare($2,$rpms{$1}) > 0){ $rpms{$1} = $2 }
496            }elsif (my ($pg,$loc) = /^(.*)-([^-+]+)$/){
497                if ($potloc{$pg}){
498                    my %header; 
499                    tie %header, "RPM::Header", "$dir/$rpm" or print "ERROR: $RPM::err\n" and next;
500                    grep { s/locales-// && $loc =~ /^$_(_|$)/ } @{$header{REQUIRENAME}} and push @{$locale{$pg}}, $loc
501                }
502            }
503        }
504    }
505    my %done;
506    my $current;
507    my @flags;
508    my $rate;
509    my $prev;
510    foreach (@rpmsrate){
511        if (!$_->[0]){
512            $text .= "@{$_->[3]}$_->[4]\n";
513            if ($_->[2]){
514                $current = $_->[2];
515                @flags = ($current)
516            }
517            next
518        }
519        my ($indent,$r,$flags,$data,$postfix) = @$_;
520        if ($r) {
521            $rate = $r
522        }elsif ($prev){
523            chop $indent;
524            $r = $prev;
525        }
526        push @flags, split ' ', $flags; 
527        my $ct = "$flags$postfix";
528        @$data or $ct =~ /\S/ and $text .= "$indent$r$ct\n" and next;
529        my @k;
530        foreach (@$data) {
531            my $c = $_;
532            if (($done{$_}[1] && $current ne "INSTALL") || $done{$_}[0] eq $current ) { next }
533            my ($d) = /(.*)-[^-]+/;
534            my ($a,$b); 
535            if (((($current ne "INSTALL") && (s/(-devel)//)) ? $b = "-devel" : /^kernel/) && ($rpms{$_} || ($rpms{"lib$_"} and $a = "lib"))) { 
536                my $d = "$a$_" . $rpms{"$a$_"} . "$b"; 
537                if ($done{$d}[0] ne $current) { @{$done{$d}} = @flags; push @k, $d }
538            }
539            if ($locale{$d}){
540                push @k, map { if (!$done{"$d-$_"}[1] && $done{"$d-$_"}[0] ne $current){ @{$done{"$d-$_"}} = @flags; "$d-$_"} else { next } } sort @{$locale{$d}}
541            }else{
542                push @k, $c;
543                @{$done{$c}} = @flags
544            }
545        } 
546        if (@k) { $text .= "$indent$r$flags@k$postfix\n"; $prev = 0 } else { $prev = $r };
547        @rate{@k} = ($rate) x @k;
548        push @{$section{$current}}, @k
549    }
550    close A;
551    if (%rpms || $output){
552        if (@rpms || $output){
553            $output ||= $rpmsrate;
554            if (open A, ">$output") { 
555                print A $text;
556                close A
557            } else { 
558                print {$LOG} "ERROR cleanrpmsrate: cannot open $rpmsrate for writing\n";
559                print $text
560            }
561        }
562    }
563    [\%rate,\%section];
564}
565
566sub imageSize {
567    my ($file) = @_;
568    my ($width, $height, $err) = imgsize($file);
569
570    return ((defined $width) ?
571    [ $width, $height ] :
572    "error: $err")
573}
574
575sub printDiscsFile{
576    my ($config,$discsFiles,$PRINT,$metagroups) = @_;
577    local *A;
578    my $a;
579    if ($PRINT) { open A, ">$PRINT"; $a = \*A } else { $a = $config->{LOG}}
580    my %done;
581    for(my $cd; $cd < @$discsFiles; $cd++){
582        $discsFiles->[$cd] or next;
583        print {$config->{LOG}} "discsFiles: $cd\n";
584        my $cdname = $config->{disc}[$cd]{name} ? "Disc$config->{disc}[$cd]{name}" : $config->{disc}[$cd]{serial};
585        foreach my $rep (keys %{$discsFiles->[$cd]}){
586            foreach my $list (keys %{$discsFiles->[$cd]{$rep}}){
587                foreach my $rpm (sort keys %{$discsFiles->[$cd]{$rep}{$list}}){
588                    $done{$rpm} = 1;
589                    #$rpm =~ /src$/ and next;
590                    print {$a} "$cdname $rpm\n";
591                }
592            }
593        }
594    }
595    if (!$metagroups) { $a = $config->{LOG} }
596    foreach (@$metagroups){
597        my $groups = $_->[0];
598        for(my $i; $i < @$groups; $i++){
599            foreach (@{$groups->[$i]{buildlist}}){
600                $done{$groups->[$i]{urpm}{rpmkey}{rpm}{$_}} and next;
601                if ($groups->[$i]{brokendeps}{$_} == 2){
602                    ref $groups->[$i]{missingdeps}{$_} or print {$a} "ERROR printDiscsFile: this should not happen, missingdeps is not a table for $_ (group $i)\n" and next;
603                    print {$a} "MISSING_DEPENDENCIES $_ @{$groups->[$i]{missingdeps}{$_}}\n"
604                } else {
605                    print {$a} "SELECTED REJECTED $_\n"
606                }
607                $done{$groups->[$i]{urpm}{rpmkey}{rpm}{$_}} = 1
608            }
609            foreach (keys %{$groups->[$i]{urpm}{rpm}}){
610                $done{$groups->[$i]{urpm}{rpmkey}{rpm}{$_}} and next;
611                if ($groups->[$i]{brokendeps}{$_} == 2){
612                    ref $groups->[$i]{missingdeps}{$_} or print {$a} "ERROR printDiscsFile: this should not happen, missingdeps is not a table for $_ (group $i)\n" and next;
613                    print {$a} "MISSING_DEPENDENCIES $_ @{$groups->[$i]{missingdeps}{$_}}\n"
614                }else{
615                    print {$a} "REJECTED $_\n"
616                }
617            }
618        }
619    }
620    close A;
621}
622
623sub printBatchFile{
624    my ($config,$discsFiles,$PRINTSCRIPT) = @_;
625    if (-f $PRINTSCRIPT) {
626        my $err = unlink $PRINTSCRIPT;
627        if (!$err) { print {$config->{LOG}} "Unlinking failed $PRINTSCRIPT: $!\n"; return};
628    }
629    my $err = copy $config->{configfile}, $PRINTSCRIPT;
630    if (!$err) { print {$config->{LOG}} "Linking failed $PRINTSCRIPT: $!\n"; return};
631    local *A; open A, ">>$PRINTSCRIPT";
632    print A "END\n";
633    for(my $cd; $cd < @$discsFiles; $cd++){
634        $discsFiles->[$cd] or next;
635        print {$config->{LOG}} "discsFiles: $cd\n";
636        print A "CD $cd\n";
637        foreach my $rep (keys %{$discsFiles->[$cd]}){
638            print A " REP $rep\n";
639            foreach my $list (keys %{$discsFiles->[$cd]{$rep}}){
640                print A "  LIST $list\n";
641                foreach my $rpm (keys %{$discsFiles->[$cd]{$rep}{$list}}){
642                    $rpm and print A "   $rpm $discsFiles->[$cd]{$rep}{$list}{$rpm}\n";
643                }
644            }
645        }
646    }
647}
648
649sub readBatchFile{
650    my ($file) = @_;
651    local *A; open A, "$file" or print "ERROR readBatchFile: could not open $file for reading\n" and return 0;
652    my @discsFiles;
653    my @cd;
654    while (<A>){ /^END/ and last }
655    my ($cd,$rep,$list);
656    while (<A>){
657        if (/^CD (\d+)/){ $cd = $1; next }
658        if (/^ REP (\S+)/){ $rep = $1; next }
659        if (/^  LIST (\d+)/){ $list = $1; next }
660        if (/^   (\S+) (\S+)/){ 
661            $discsFiles[$cd]{$rep}{$list}{$1} = $2;
662            push @{$cd[$cd]{$rep}{$list}{$2}}, [ 1, "$1.rpm" ];
663            next 
664        }
665    }
666    return (\@discsFiles, \@cd)
667}
668
669sub config{
670    my ($file,$config,$functions) = @_;
671    open F,$file or die "ERROR config: cannot open $file\n";
672    while (<F>){ chomp ; /^#/ or !$_ or last}
673    chomp;
674    $config->{name} = (split)[0];
675    my $cd;
676    my $fn;
677    my $nk;
678    my $type;
679    my @todo;
680    my $discMax;
681    while (<F>){
682        /^#/ and next;
683        chomp;
684        $_ or next;
685        s/#.*//;
686        if (/^LIST /){
687            if (/^LIST (\d+)(?:\s+(\S.*))*/) {
688                $cd = $1;
689                push @{$config->{list}[$cd]{filelist}},  (split ' ',$2);
690                $type = 1;
691                print LOG "LIST $1 $2\n"
692            }else {
693                $nk = 1;
694                print LOG  "WARNING: LIST syntax error ($_)\n";
695                print LOG "         LIST <list number> <file list 1> <file list 2> ... <file list n>\n"
696            }
697        } elsif (/^DISC /){
698            if (/^DISC (\d+)\s+(\d+)\s+(\S+)\s+DISC\s+(\d+)\s+(.*)/) { 
699                $config->{disc}[$1]{size} = $2;
700                $config->{disc}[$1]{serial} = $3;
701                $config->{disc}[$1]{name} = $4;
702                $config->{disc}[$1]{longname} = $5;
703                $cd = $1;
704                $type = 2;
705                $fn = 0;
706                $4 > $discMax and $discMax=$4;
707                print LOG "DISC $1 $2 $3 $4\n"
708            }elsif(/^DISC (\d+)\s+(\d+)\s+(\S+)\s+(.*)/){ 
709                $config->{disc}[$1]{size} = $2;
710                $config->{disc}[$1]{serial} = $3;
711                $config->{disc}[$1]{name} = 0;
712                $config->{disc}[$1]{longname} = $4;
713                $cd = $1;
714                $type = 2;
715                $fn = 0;
716                $4 > $discMax and $discMax=$4;
717                print LOG "DISC $1 $2 $3 $4\n"
718            }else{
719                $nk = 1;
720                print LOG "WARNING: DISC syntax error ($_)\n";
721                print LOG "         DISC <cd number> <cd size> <cd serial name> DISC <real cd number> <disc name>\n";
722            }
723        } elsif (/^END/){
724            last       
725        }else {
726            $type == 1 and do {
727                push @{$config->{list}[$cd]{packages}}, [split];
728                next
729            };
730            $type == 2 and do {
731                my ($prog,@args) = split;
732                print LOG "CALLING $prog -- @args\n";
733                push @todo, [$prog, \@args, $cd, $fn];
734                $fn++;
735                next
736            }
737        }
738    }
739    $config->{configfile} = $file;
740    $config->{discMax} = $discMax;
741    foreach (@todo){
742        my ($prog,$args,$cd,$fn) = @$_;
743        $functions->{$prog} and do {
744            print LOG "FUNCTION $prog\n";
745            my $todo = parseCommandLine($prog,$args,$functions->{$prog});
746            @$args and usage($prog,$functions->{$prog},"disc $cd, function $fn, @$args, too many arguments");
747            foreach (@$todo){
748                print LOG "$_->[2]\n";
749                &{$_->[0]}($cd,$fn,@{$_->[1]}) or print LOG "ERROR: $_->[2]\n" and $nk = 1;
750            }
751        }
752    }
753    $nk and return 0;
754    printTable($config);
755    1
756}
757
758sub compute_md5{
759    my ($to_check,$ignore) = @_;
760    my @files;
761    md5_add_tree($to_check,\@files,$ignore);
762    my $md5 = new Digest::MD5;
763    foreach (sort { $a->[0] cmp $b->[0] } @files){
764        my $f = $_->[1];
765        local *A, open A, "$f";
766        $md5->addfile(*A);
767        #my $tmpmd5 = new Digest::MD5;
768        #local *A, open A, "$f";
769        #$tmpmd5->addfile(*A);
770        #print "MD5: $_->[0] (", $tmpmd5->hexdigest() ,")\n";
771    }
772    my $digest = $md5->hexdigest();
773    # print "IGNORE " , join " ",keys %$ignore ,"\n";
774    return $digest
775}
776
777sub md5_add_tree{
778    my ($to_check,$files,$ignore) = @_;
779    foreach (@$to_check){
780        my ($dest,$f) = @$_;
781        $f =~ /\/?\.{1,2}$/ and next;
782        $f =~ /~$/ and next;
783        $f =~ s/\/\/+/\//g;
784        $dest =~ s/\/\/+/\//g;
785        $ignore->{$dest} and next;
786        if (-d $f){
787            local *A; opendir A, $f;
788            md5_add_tree([ map { [ "$dest/$_", "$f/$_" ]} readdir A ], $files, $ignore)
789        }else{
790            push @$files, [ $dest, $f ]
791        }
792    }
793}
794
795sub log_ {
796    my ($msg,$verbose,$log) = @_;
797    #print "message $msg verbose $verbose\n";
798    my $LOG;
799    if (!$log){ open $LOG, ">&STDERR"}
800    else { $LOG=$log}
801    $verbose and print {$LOG} $msg;
802}
803
8041
805
806#
807# Changelog
808#
809# 2002 02 27
810#
811# make the locale constraint free on the right for cleanrpmsrate locale addition (kde-i18n-zh_BG and such)
812#
813# 2002 03 03
814#
815# fix typo in checkdiscs
816#
817# 2002 03 04
818#
819# fix checkcds pb with check[0] used.
820#
821# 2002 03 07
822#
823# add possibility to remove package from rpmsrate
824#
825# 2002 03 12
826#
827# add all .*kernel- in rpmsrate
828#
829# 2002 03 17
830#
831# add serial name instead of cdnumber when name is not know
832#
833# 2002 05 07
834#
835# add check_discs, compute_md5, write_graft, md5_add_tree
836#
837# 2002 05 22
838#
839# fix a pb in md5
840#
841# 2002 05 25
842#
843# add log function
844#
845# 2002 06 05
846#
847# fix md5 for isolinux
Note: See TracBrowser for help on using the repository browser.