source: soft/build_system/build_system/mkcd/tags/V3_8_6_1mdk/mkcd2.1 @ 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: 116.1 KB
Line 
1#!/usr/bin/perl -I /home/warly/files/cvs/mdk/soft/mkcd/pm/
2#
3# to prepare, create and burn iso images
4# version 2
5#
6
7my $version = "2.5.7";
8
9use strict;
10use File::Path;
11use File::NCopy qw(copy);       
12use rpmtools;
13use mkcd::commandline qw(parseCommandLine usage);
14use packdrake;
15use RPM::Header;
16
17my @config;
18my $lists;
19my $fast = 0;
20my @func;
21my $NODEPS;
22my $DEPS;
23my $VERBOSE;
24my $PRINT;
25my $PRINTSCRIPT;
26my $NOLIVE;
27my $NOISO;
28my $NOSRCFIT;
29my $product;
30my $bugzilla;
31my $builddir;
32my $topdir = `pwd`;
33chop $topdir;
34my $DISCSIZE = 681000000;
35my $ISODIR;
36my $filetag;
37my $log=0;
38my $MKISOOPT = "-r -J -hide-rr-moved -nobak -cache-inodes";
39
40my $TMP = $ENV{TMPDIR} || "$topdir/tmp" ;
41
42my %ARCH = ( 
43    i586 => 1,
44    i686 => 2,
45    i486 => 2,
46    i386 => 3
47);
48
49my @params;
50my %FUNCTIONS;
51my %functions;
52my @params = ( 
53    [ "","mkcd2", 0, "<options>","mkcd2 Mandrake Linux CD maker", sub { 1 }, ""],
54    [ "a", "auto", [
55        ["", "auto", -1, "<repository> <extra RPMS directory 1> <extra RPMS directory 2> ... <extra RPMS directory n>","Auto mode configuration", 
56        sub {   my ($tmp,@arg) = @_;
57            $tmp->[0] ||= {};
58            push @$tmp, @arg;
59            1
60        },"Setting auto mode arguments"],
61        ["c", "cd", 1, "<number of discs>","Max number of discs", sub { my ($tmp, $cd) = @_; if ($cd =~ /\d+/) { $tmp->[0]{cd} = $cd } else { return 0 }; 1 },"Setting max number of discs"]
62], "[options] <repository> <extra RPMS directory 1> <extra RPMS directory 2> ... <extra RPMS directory n>", "Automated mode, build discs from a repository.", \&autoMode, "Auto mode"],
63    [ "", "bugzilla", 0, "","Use bugzilla as information source.", sub { $bugzilla = 1 }, "Using Bugzilla"],
64    [ "b", "builddir", 1, "<build dir>", "Where live iso image are created (default current dir).",  sub { $builddir = pop @_ }, "Setting the build directory"],
65    [ "", "batch", 2, "<discs list> <batch file>", "batch mode to rebuilt discs from a previous session.",  \&batchMode, "Batch mode"],
66    [ "c", "catto", 1, "<log file>", "Log file.", sub {$log = pop @_; open LOG,">$log" or die "unable to open $log\n"}, "Log file"],
67    [ "", "listrpmsrate", 1,"<rpmsrate file>", "List the package in the rpmsrate file", \&packageOutOfRpmsrate, "Listing rpmsrate file"],
68    [ "d", "depslist-creation", 0 , "", "rebuild the desplist.ordered file before checking the list.", sub {$DEPS=1}, "Depslist creation switch"],
69    [ "", "discsize", 1 , "<disc size in bytes>", "Select a custom disc size (default $DISCSIZE).", sub {$DISCSIZE = pop}, "Custom disc size selection"],
70    [ "f", "fast", 0 , "", "fast mode.", sub {$fast = 1}, "Fast mode"],
71    [ "g", "getdeps", -2, "<depslist.ordered directory> <package 1> <package 2> ... <package n>","Generate the dependencies list of a list of packages.", sub { getdeps(shift,[@_])}, "Generating dependencies list of the packages"],
72    [ "", "getleaves", 1, "<depslist file>", "Getting leaves from a depslist.ordered file",\&getLeaves,"Getting leaves from a depslist.ordered"],
73# FIXME function help should take 0 or one argument, but this is not possible with this structure
74    [ "h", "help", -1, "<path> <to> <the> <function>", "Display help, eg. mkcd2 -h installation fixed. Type mkcd2 -h config for configuration files options.", sub { my (@function) = @_; if (@function) { my $key = join '/', @function; usage($key,$FUNCTIONS{$key}) } else { usage("mkcd2",\@params)} 1}, ""],
75    [ "", "check", -1, "<dir 1> <dir 2> ... <dir n>", "Check the hdlists, depslist and RPMS coherency.", sub { checkcds([0,@_])}, "Checking the hdlists, depslist and RPMs coherency"],
76    [ "i", "isodir", 1, "<iso dir>", "Where ISOs are built (default ./iso/product_name/).",  sub { $ISODIR = pop @_ }, "Setting the iso directory"],
77    [ "k", "checkcu", -1, "<dir 1> <dir 2> ... <dir n>", "Checking the compssUser.", sub { checkcompssUser([0,@_])}, "Checking the compssUser"],
78    [ "l", "lists", 1 , "","lists of discs taken into account.", sub { $lists = getTracks(pop @_) }, "Using given disc list"],
79    [ "m", "make", 1, "<cds number>", "Build the discs.", \&make , "Building the discs"],
80    [ "", "nodeps", 0, "", "Do not include automatically dependencies of packages", sub { $NODEPS = 1 }, "Setting nodeps flag"],
81    [ "", "nolive", 0, "", "Do not create live image of the discs.", sub {$NOLIVE = 1}, "Setting nolive option"],
82    [ "", "noiso", 0, "", "Do not create iso images of the discs.", sub {$NOISO = 1}, "Setting noiso option"],
83    [ "", "nosrcfit", 0, "", "Do not stop if sources discs are full", sub {$NOSRCFIT = 1}, "Setting nosrcfit option"],
84    [ "p", "printscript", 1, "<script file>", "Print the script that can be use to rebuild the discs", sub {$PRINTSCRIPT = shift}, "Printing script"],
85    [ "", "printdiscsfiles", 1, "<file>", "Print the contains of each disc", sub {$PRINT = shift}, "Printing disc contains"],
86    [ "", "pl", -1, "<hdlist 1> <hdlist 2> ... <hdlist n>", "Do a packdrake -l on the hdlists", sub { getRPMsKeys(1,@_) }, "Printing hdlist contents"],
87    [ "s","spec", 1, "<config file>","Configuration file", \&config , "Loading configuration file"],
88    [ "t", "topdir", 1, "<top dir>", "Where files are created (default current dir).",  sub { $topdir = pop @_ }, "Setting the top directory"],
89    [ "", "update-rpmsrate", -2, "<rpmsrate> <rpms directory 1> <rpms directory 2> ... <rpms directory n>", "Add major to libraries in rpmsrate",  sub { cleanrpmsrate(shift,*STDOUT,@_) }, "Adding major to libraries in rpmsrate"],
90    [ "", "verbose", 0 , "", "Print more messages", sub {$VERBOSE = 1}, "Setting the verbose flag"],
91    [ "v", "version", 0, "", "Print program version",  sub { print LOG "\nmkcd2 version $version\n"; 1}, ""]
92);
93
94%functions = (
95    # [ function name, matching regexp, [arguments list (same as above)]]
96    "dir" =>
97        [
98            ["","dir",2,"<directory name> <directory location>", "Set directory name",
99            sub {       my ($cd,$fn,$repname,$reploc) = @_;
100                my @a = ("dir", { repname => $repname, reploc => $reploc});
101                $config[2][$cd][2]{dir}{$repname} and print LOG "WARNING: disc $cd: duplicate directory $repname ($reploc)\n";
102                $config[2][$cd][1][$fn] = \@a;
103                $config[2][$cd][2]{dir}{$repname} = $reploc;
104                print LOG "dir: $repname ($reploc)\n";
105                push @{$config[2][$cd][3]}, \@a;
106                1
107            }, "Setting directory" ]
108]
109,
110
111#
112# generic options
113#
114# source => source dir
115#
116# done  => done
117#
118
119    "generic" =>
120        [ 
121            ["","generic", 2, "<directory name> <list name>","Copy rpms from a list to a directory", 
122                sub {   my ($cd,$fn,$repname,$list) = @_; 
123                    my @a = ("generic", { repname => $repname, list => $list});
124                    $config[2][$cd][2]{dir}{$repname} or print LOG "ERROR: disc $cd: $repname not defined\n";
125                    $config[1][$list] or print LOG "ERROR: lists $list does not exist, ignoring\n" and return 0;
126                    $config[2][$cd][1][$fn] = \@a;
127                    push @{$config[2][$cd][2]{generic}{$repname}}, \@a ;
128                    push @{$config[2][$cd][0]}, \@a; # [$a[1],$repname,$list];
129                    push @{$config[2][$cd][3]}, \@a;
130                    1
131                }, "Copying rpms to directory"],
132            ["s","source", [
133            [ "", "source", 0, "","Source mode configuration", 
134                sub {   my ($tmp) = @_;
135                    $tmp->[0]{source} = 1;
136                }, "Source mode"],
137            [ "p", "priority", 1, "<priority>","Set the repository priority", sub { my ($tmp,$prio) = @_; $tmp->[0]{priority} = $prio}, "Setting source repository priority"]
138            ], "[options]","Source mode setting", 
139                sub { my ($cd,$fn,$options) = @_; 
140                    foreach (keys %$options){ $config[2][$cd][1][$fn][1]{$_} = $options->{$_}}
141                    1
142                }, "Source mode option configuration"],
143            [ "", "synthesis", 0, "","Add synthesis file in the repository", sub { my ($cd,$fn) = @_; $config[2][$cd][1][$fn][1]{synthesis} = 1 }, "Setting synthesis tag"]
144            ],
145        #
146        # installation data
147        #
148        #       install => install source path
149        #
150        #       rpmsdir => rpm repositories list
151        #
152        #       bootimg => boot image
153        #
154        #       tag => tag
155        #
156        #       lang  => langage list
157        #
158        #       rpmsrate => rpmsrate file to use
159        #
160        #       compssUsers => compssUsers file to use
161        #
162        #       score => score weights
163        #
164        # Installation options
165        #
166        #       nosources
167        #
168        #       nosrcfit
169        #
170    "installation" => 
171        [ 
172        # 0
173            [ "", "installation", -1, "<rpms directory name 1> <rpms directory name 2> ... <rpms directory name n>","Preparing the installation directory and dependencies files", 
174                sub {   my ($cd,$fn,@rpms) = @_; 
175                    my @rpmsdir;
176                    foreach (@rpms){
177                        my ($cdrep,$repname) = /(\d+)\/(.*)/;
178                        push @rpmsdir, [$cdrep,$repname]       
179                    }
180                    my @a = ('installation', { rpmsdir => \@rpmsdir});
181                    ref $config[2][$cd][2]{installation} and print LOG "ERROR: disc $cd: duplicate installation procedure, ignored\n" and return 0;
182                    $config[2][$cd][1][$fn] = \@a;
183                    $config[2][$cd][2]{installation} = \@a;
184                    push @{$config[2][$cd][3]}, \@a;
185                    1
186                }, "Setting up installation files"],
187    # 1
188            [ "b", "bootimg", 1, "<boot image>","boot image for the cd", sub { my ($cd,$fn,$img) = @_; $config[2][$cd][1][$fn][1]{bootimg} = $img; 1}, "Setting boot image"],
189    # 2
190            [ "c", "compss", 1, "<compsUser file>", "Choose alternative compssUser file", sub { my ($cd,$fn,$compss) = @_; $config[2][$cd][1][$fn][1]{compssUsers} = $compss; 1 }, "Setting alternative compssUser file"],
191    # 3
192            [ "f", "fixed", [
193                ["", "fixed", -1, "<repository> <extra RPMS directory 1> <extra RPMS directory 2> ... <extra RPMS directory n>","Fixed repository option configuration", 
194                    sub {       my ($tmp,@arg) = @_;
195                        $tmp->[0]{fixed} = 1;
196                        push @$tmp, @arg;
197                        1
198                    },"Setting fixed option arguments"],
199                ["d", "dup", 0, "","Duplicate mode, accept to put package present in already done discs", sub { my ($tmp) = @_; $tmp->[0]{dup} = 1; 1 },"Setting duplicate mode"],
200                ["", "nodeps", 0, "","Do not handle other discs dependencies", sub { my ($tmp) = @_; $tmp->[0]{nodeps} = 1; 1 },"Setting nodeps mode"],
201                ["", "update", 0, "","Update mode, update already done packages", sub { my ($tmp) = @_; $tmp->[0]{update} = 1; 1 },"Setting update mode"]
202                ], "<options> <fixed coma separated repositories>","repositories that must not be computed but integrated in the installation group", 
203                    sub { my ($cd,$fn,$options,@fixed) = @_; 
204                    foreach (@fixed){
205                        my ($cdrep,$repname) = /(\d+)\/(.*)/;
206                        push @{$config[2][$cd][1][$fn][1]{rpmsdir}}, [ $cdrep, $repname, $options ]
207                    }
208                    $config[2][$cd][1][$fn][1]{fixed} = 1;
209                    1}, "Setting boot image"],
210            # 4 
211            [ "l", "lang", 1, "<languages to include>","languages that are conisdered by the install", sub { my ($cd,$fn,$lang) = @_; my @l = split ',',$lang; push @{$config[2][$cd][1][$fn][1]{lang}},  @l; 1}, "Setting language supported"],
212            # 5
213            [ "i", "installdir", 1, "<installation directory source>","Installation directory source", sub { my ($cd,$fn,$dir) = @_; $config[2][$cd][1][$fn][1]{install} = $dir; 1}, "Setting install source directory"],
214            # 6
215            [ "", "nosources", 0, "","Do not add source rpm for this installation group", sub { my ($cd,$fn) = @_; $config[2][$cd][1][$fn][1]{nosources} = 1; 1}, "Setting nosources tag for this installation group"],
216            # 7
217            [ "", "nosrcfit", 0, "","Do not stop if sources discs are full", sub { my ($cd,$fn) = @_; $config[2][$cd][1][$fn][1]{nosrcfit} = 1; 1}, "Setting nosourcefit tag for this installation group"],
218            # 8
219            [ "o", "sortweight", 1, "<list of respective ordering weight (size,dependencies,rpmsrate)>","Set the weight for automatic sorting rules", sub { my ($cd,$fn,$weight) = @_; $config[2][$cd][1][$fn][1]{score} = [split ',', $weight]; 1}, "Setting sorting weights"],
220            # 9
221            [ "r", "rpmsrate", 1, "<rpmsrate file>", "Choose alternative rpmsrate", sub { my ($cd,$fn,$rpmsrate) = @_; $config[2][$cd][1][$fn][1]{rpmsrate} = $rpmsrate }, "Setting alternative rpmsrate file"],
222            # 10
223            [ "t", "tag name", 1, "<tag name>", "Tag added to the VERSION file", sub { my ($cd,$fn,$tag) = @_; $config[2][$cd][1][$fn][1]{tag} = $tag }, "Setting the tag name"],
224            # 11
225            [ "", "dup", 0, "", "Authorize duplicate version for this install", sub { my ($cd,$fn) = @_; $config[2][$cd][1][$fn][1]{dup} = 1 }, "Setting the tag name"],
226            # 12
227            [ "", "nodeps", 0, "", "Do not include deps", sub { my ($cd,$fn) = @_; $config[2][$cd][1][$fn][1]{nodeps} = 1 }, "Setting nodeps flag for this installation"],
228            # 13
229            [ "", "isolinux", 0, "", "Isolinux mode", sub { my ($cd,$fn) = @_; $config[2][$cd][1][$fn][1]{isolinux} = 1 }, "Build an isolinux install"],
230            # 14
231            [ "", "synthesis", 0, "","Add synthesis file in the repository", sub { my ($cd,$fn) = @_; $config[2][$cd][1][$fn][1]{synthesis} = 1 }, "Setting synthesis tag"],
232        ],
233#
234#
235# advertising data
236#
237#    ing
238#
239# advertising options
240#
241#    lang
242
243    "advertising" =>
244        [
245            [ "", "advertising", -1, "<picture 1> <picture 2> ... <picture n>", "Setting the advertising pictures used by the installation", 
246                sub { my ($cd,$fn,@img) = @_;
247                    my @a = ('advertising',{ img => \@img});   
248                    $config[2][$cd][1][$fn] = \@a;
249                    push @{$config[2][$cd][2]{advertising}}, \@a;
250                    push @{$config[2][$cd][3]}, \@a
251                }, "Setting the advertising pictures"],
252         [ "l", "lang", 1, "<language>", "Set the advertising picture language", sub { my ($cd,$fn,$lang) = @_; $config[2][$cd][1][$fn][1]{lang} = $lang; 1}, "Setting the picture language"]
253        ],
254
255#
256# cdcom data
257#
258#      dir
259#
260#      source
261#
262    "cdcom" =>
263         [
264            [ "", "cdcom", 2, "<directory name> <disc directory location>", "Commercial disc",
265                sub { my ($cd,$fn,$dir,$source) = @_;
266                    my @a = ('cdcom',{ dir => $dir, source => $source});
267                    $config[2][$cd][1][$fn] = \@a;
268                    push @{$config[2][$cd][2]{cdcom}}, \@a;
269                    my $list = @{$config[1]};
270                    print LOG "cdcom: adding list $list for $source/Mandrake/RPMS\n";
271                    $config[1][$list][1] = [[ "$source/Mandrake/RPMS" ]];
272                    $config[1][$list][2] = { cdcom => 1 };
273                    push @{$config[2][$cd][0]}, [ '', { repname => $dir ,list => $list}];
274                    push @{$config[2][$cd][3]}, \@a;
275                    1
276                }, "Configuring a commercial disc"],
277            [ "d", "dest", 1, "<destination on the disc>", "Select the destination directory on the disc", sub { my ($cd,$fn,$dest) = @_; $config[2][$cd][1][$fn][1]{dest} = $dest; 1}, "Selecting destination directory"]
278        ],
279#
280# cp
281#
282    "cp" =>
283        [
284            [ "", "cp", 2, "<file source> <file destination>", "Copy",
285                sub { my ($cd,$fn,$src,$dest) = @_;
286                    my @a = ('cp',{ src => $src, dest => $dest});
287                    $config[2][$cd][1][$fn] = \@a;
288                    push @{$config[2][$cd][2]{cp}}, \@a;
289                    push @{$config[2][$cd][3]}, \@a;
290                    1
291        }, "Copying files"]
292    ],
293 #
294 # isolinux
295 #
296 "isolinux" => 
297    [ 
298    # 0
299        [ "", "isolinux", 1, "<source dir of the isolinux files","Create an isolinux bootable disc", 
300            sub {   my ($cd,$fn,$source) = @_; 
301                    my @a = ('isolinux', { isolinux => $source});
302                    ref $config[2][$cd][2]{isolinux} and print LOG "ERROR: disc $cd: duplicate isolinux procedure, ignored\n" and return 0;
303                    $config[2][$cd][1][$fn] = \@a;
304                    $config[2][$cd][2]{isolinux} = \@a;
305                    push @{$config[2][$cd][3]}, \@a;
306                    1
307          }, "Setting an isolinux boot disc"],
308          # 1
309        [ "b", "bootimg", 1, "<isolinux boot file>","boot file for isolinux", sub { my ($cd,$fn,$img) = @_; $config[2][$cd][1][$fn][1]{bootimg} = $img; 1}, "Setting isolinux boot file"],
310        ],
311 #
312 # boot
313 #
314 "boot" => 
315    [ 
316    # 0
317        [ "", "boot", 0, "<options> <files or dir to copy 1> <files or dir to copy 2> .. <files or dir to copy 3>","Boot parameters and files", 
318            sub {   my ($cd,$fn) = @_; 
319                    my @a = ('boot', {});
320                    $config[2][$cd][1][$fn] = \@a;
321                    push @{$config[2][$cd][2]{boot}}, \@a;
322                    push @{$config[2][$cd][3]}, \@a;
323                    1
324          }, "Setting boot parameters"
325        ],
326          # 1
327        [ "", "isolinux", [
328                ["", "isolinux", 1, "<isolinux directory>", "Create an isolinux bootable disc", 
329                    sub {       my ($tmp,@args) = @_;
330                        $tmp->[0]{isolinux} = 1;
331                        push @$tmp, @args
332                    },"Setting an isolinux boot disc"],
333                ], "<options> <isolinux directory>","isolinux boot disc", 
334                    sub { my ($cd,$fn,$options,$dir) = @_; 
335                        foreach (@{ $config[2][$cd][2]{boot}}){
336                                ref $_->[1]{isolinux} and print LOG "ERROR: disc $cd: duplicate isolinux boot image, ignored\n" and return 0;
337                        }
338                        $config[2][$cd][1][$fn][1]{isolinux} =  [$dir,$options]
339                    }, "Setting isolinux image"
340        ],
341        [ "b", "bootimg", [
342            [ "", "bootimg", 1, "<boot image name>","set boot image name",
343                    sub {my ($tmp,@args) = @_;
344                        $tmp->[0]{bootimg} = 1;
345                        push @$tmp, @args
346                    }, "setting boot image name"
347            ],
348            [ "d", "dir", 1, "<directory>", "duplicate the boot image in directory and put it first in the ISO",
349               sub { my ($tmp,$dir) = @_; $tmp->[0]{dir} = $dir }, ""   
350            ]
351                ], "<options> <boot image>", "Create a bootable iso with given image", 
352                    sub { my ($cd,$fn,$options,$img) = @_;
353                        foreach (@{ $config[2][$cd][2]{boot}}){
354                                ref $_->[1]{bootimg} and print LOG "ERROR: disc $cd: duplicate boot image, ignored\n" and return 0;
355                        }
356                        $config[2][$cd][1][$fn][1]{bootimg} = [$img,$options]
357                    },"Setting boot image options"
358        ],
359        [ "d", "dest", [
360                [ "", "dest", -2, "<destination> <file 1> <file 2> .. <file n>","Set options for files copied to a given destination",
361                    sub{ my ($tmp, @args) = @_;
362                        $tmp->[0]{dest} = $args[0];
363                        push @$tmp, @args
364                   
365                    },"Setting dest options"],
366                [ "f", "first", 0 , "", "Put this files first in the ISO", sub { my ($tmp) = @_; $tmp->[0]{first} = 1}, "Setting first flag for files"]
367            ], "<options> <destination> <files 1> <files 2> .. <files n>","Copy files to a special destination", 
368                sub { my ($cd,$fn,$options, @files) = @_; 
369                    foreach (@files){
370                        push @{$config[2][$cd][1][$fn][1]{files}}, [ $_, $options ]
371                    }
372                }, 
373            "Setting isolinux boot file"],
374        [ "f", "files", -1, "<file 1> <file 2> <file 3>","Files to copy", 
375            sub { my ($cd,$fn,@files) = @_; 
376                foreach (@files){
377                    push @{$config[2][$cd][1][$fn][1]{files}}, [ $_ ]
378                }
379            }, "Setting first flag"
380        ],
381        [ "", "first", -1, "<file 1> <file 2> <file 3>","Set first flag to put files in the beginning of the ISO", 
382            sub { my ($cd,$fn,@files) = @_; 
383                foreach (@files){
384                    push @{$config[2][$cd][1][$fn][1]{files}}, [ $_, { first => 1 } ]
385                }
386            }, "Setting first flag"
387        ]
388    ]
389);
390
391# FIXME this permit to have specific help
392foreach (@params){
393    $FUNCTIONS{"$_->[1]"} = [ $_ ]
394}
395$FUNCTIONS{mkcd2} = \@params;
396foreach my $k (keys %functions){
397    $FUNCTIONS{$k} = $functions{$k};
398    foreach (@{$functions{$k}}){
399        $FUNCTIONS{"$k/$_->[1]"} = ref $_->[2] ? $_->[2] : [ $_ ]
400    }
401    push @{$FUNCTIONS{"config"}} , $functions{$k}->[0]
402}
403
404local *LOG;
405open LOG,">&STDERR";   
406
407my $todo = parseCommandLine("mkcd2",\@ARGV,\@params);
408@ARGV and usage("mkcd2",\@params,10);
409foreach (@$todo){
410    print LOG "mkcd2: $_->[2]\n";
411    &{$_->[0]}(@{$_->[1]}) or print LOG "ERROR: $_->[2]\n";
412}
413
414#
415# config structure
416#
417# $config[0][0] = name for the product
418#
419# $config[1] = list
420#   $config[1][list number][0] = (list name, file list location 1, file list location 2, ..., file list location n )
421#
422#   $config[1][list number][1][location i] = (RPMS location i. SRPMS location i)
423#
424#   $config[1][list number][2] = { list option }
425#
426#        List options:
427#   
428#            done
429#
430#            empty
431#
432#            auto
433#
434#   $config[1][list number][3] = { cd => { rep => { options }}  }
435#
436# $config[2] = cd
437#   $config[2][cd number][0] = (size in bytes, serial number, name, [{generic options}, rep name 1, list 1], [{generic options}, rep name 2,list 2], ..., [{generic options}, rep name n,list n])
438#
439#   $config[2][cd number][1][function number] = (function name, [flags], [data])
440#
441#   $config[2][cd number][2]{dir}{repository identifier} = $config[2][cd number][1][function number]
442#
443#   $config[2][cd number][2]{'installation'} = $config[2][cd number][1][function number]  it should have only one installation by disc, anyway
444#
445#   $config[2][cd number][2]{'advertising'} = $config[2][cd number][1][function number]
446#
447#   $config[2][cd number][3] = function to execute to build the disc
448#
449#
450# $config[3] = { option/parameter }
451#
452#        discMax => higher real disc number
453#
454#        configfile => config file use for this session
455#
456# Availaible functions
457#
458#   see above @functions
459#
460
461sub config{
462    my ($file) = @_;
463    open F,$file or die "ERROR config: cannot open $file\n";
464    while (<F>){ chomp ; /^#/ or !$_ or last}
465    chomp;
466    $config[0][0] = (split)[0];
467    my $cd;
468    my $fn;
469    my $nk;
470    my $type;
471    my @todo;
472    my $discMax;
473    while (<F>){
474        /^#/ and next;
475        chomp;
476        $_ or next;
477        s/#.*//;
478        if (/^LIST /){
479            if (/^LIST (\d+)(?:\s+(\S.*))*/) { 
480                push @{$config[1][$1][0]},(split ' ',$2);
481                $cd = $1;
482                $type = 1;
483                print LOG "LIST $1 $2\n"
484            }else {
485                $nk = 1;
486                print LOG  "WARNING: LIST syntax error ($_)\n";
487                print LOG "         LIST <list number> <file list 1> <file list 2> ... <file list n>\n"
488            }
489        } elsif (/^DISC /){
490            if (/^DISC (\d+)\s+(\d+)\s+(\S+)\s+DISC\s+(\d+)\s+(.*)/) { 
491                push @{$config[2][$1][0]},$2,$3,$4,$5;
492                $cd = $1;
493                $type = 2;
494                $fn = 0;
495                $4 > $discMax and $discMax=$4;
496                print LOG "DISC $1 $2 $3 $4\n"
497            }elsif(/^DISC (\d+)\s+(\d+)\s+(\S+)\s+(.*)/){ 
498                push @{$config[2][$1][0]},$2,$3,0,$4;
499                $cd = $1;
500                $type = 2;
501                $fn = 0;
502                $4 > $discMax and $discMax=$4;
503                print LOG "DISC $1 $2 $3 $4\n"
504            }else{
505                $nk = 1;
506                print LOG "WARNING: DISC syntax error ($_)\n";
507                print LOG "         DISC <cd number> <cd size> <cd serial name> DISC <real cd number> <disc name>\n";
508            }
509        } elsif (/^END/){
510            last       
511        }else {
512            $type == 1 and do {
513                push @{$config[1][$cd][1]}, [split];
514                next
515            };
516            $type == 2 and do {
517                my ($prog,@args) = split;
518                print LOG "CALLING $prog -- @args\n";
519                push @todo, [$prog, \@args, $cd, $fn];
520                $fn++;
521                next
522            }
523        }
524    }
525    $config[3]{configfile} = $file;
526    $config[3]{discMax} = $discMax;
527    foreach (@todo){
528        my ($prog,$args,$cd,$fn) = @$_;
529        $functions{$prog} and do {
530            print LOG "FUNCTION $prog\n";
531            my $todo = parseCommandLine($prog,$args,$functions{$prog});
532            @$args and usage($prog,$functions{$prog},11);
533            foreach (@$todo){
534                print LOG "$_->[2]\n";
535                &{$_->[0]}($cd,$fn,@{$_->[1]}) or print LOG "ERROR: $_->[2]\n" and $nk = 1;
536            }
537        }
538    }
539    $nk and return 0;
540    printTable(\@config);
541    1;
542}
543
544sub printTable {
545    my ($a) = @_;
546    #
547    # iterative version of a recursive scanning of a table.
548    # ex: @config = [[[1,3],3,[1,3,[1,3]]],3,4,[4,[4,4]]]
549    #   
550    my @A;
551    my @i;
552    my @tab;
553    my $i = 0;
554    while ($a){
555        my $u = ref $a;
556        if ($u eq 'ARRAY') {
557            while ($i < @$a){
558                my $b = $a->[$i];
559                my $t = ref $b;
560                if ($t eq 'ARRAY'){
561                    push @tab, "\t";
562                    push @i, $i+1;
563                    push @A, $a;
564                    $i = 0;
565                    $a = $b;
566                    next
567                } elsif ($t eq 'HASH') { 
568                    $i++; print LOG "@tab", join ' ',keys %$b,"\n"
569                } else { $i++; print LOG "@tab$b\n" }
570            }
571        } else { print LOG "$a\n" }
572        pop @tab;
573        $i = pop @i;
574        $a = pop @A;
575    }
576
577}
578
579sub getTracks{
580    my ($tracks) = @_;
581    print LOG "getTracks: $tracks\n";
582    my @tracks = split ',',$tracks;
583    my @t;
584    foreach (@tracks){
585        /(\d+)/ and push @t, $1;
586        /(\d+)-(\d+)/ and push @t, $1..$2       
587    }
588    my @tracks;
589    my %done;
590    for(my $i = $#t; $i >= 0; $i-- ){
591        push @tracks, $t[$i] if !$done{$t[$i]};
592        $done{$t[$i]}=1
593    }
594    \@tracks;
595}
596
597sub genDeps{
598    my ($top,$reps,$deps) = @_;
599    $top or print "ERROR: no top dir defined\n" and return 0;
600    -d $top or mkpath $top or die "Could not create $top\n";
601    $VERBOSE and print LOG "REPS @$reps ($top/depslist.ordered)\n";
602    my $params = new rpmtools("sourcerpm");
603    my @reps = @$reps;
604    $deps ||= $DEPS;
605    if ($deps || ! -f "$top/depslist.ordered") {
606        map { $_ and $_ .= "/*.rpm"} @reps;
607        $VERBOSE and print LOG "MAP : @reps\n";
608        my @rpms;
609        my %done;
610        foreach (map glob, @reps){
611            m,([^/]+)$,;
612            $done{$1} and next;
613            push @rpms, $_;
614            $done{$1} = 1
615        }
616        $params->build_hdlist(1, 9,"$TMP/.mkcd_build_hdlist", "$top/hdlist.cz", @rpms);
617        print LOG "generating base files\n";
618        if (-r "$top/provides") {
619            open F, "$top/provides";
620            $params->read_provides_files(\*F);
621            close F;
622        }
623
624        $params->read_hdlists("$top/hdlist.cz");
625        $params->compute_depslist();
626
627        my @unresolved = $params->get_unresolved_provides_files();
628        if (@unresolved > 0) {
629            $params->clean();
630
631            $params->read_hdlists("$top/hdlist.cz");
632            $params->keep_only_cleaned_provides_files();
633            $params->read_hdlists("$top/hdlist.cz");
634            $params->compute_depslist();
635        }
636        # reorder the hdlist not needed for this
637        # $params->build_hdlist(1, "$tmp/.mkcd_build_hdlist", "$top/hdlist.cz", map (glob, map( { $_ and $_ .= "/*.rpm"}  map( {ref and @$_ } @$reps))));
638        print LOG "writing $top/depslits.ordered\n";
639        open F, ">$top/depslist.ordered" or die "unable to write depslist file $top/depslist.ordered\n";
640        $params->write_depslist(\*F);
641        close F;
642        print LOG "writing $top/provides\n";
643        open F, ">$top/provides" or die "unable to write provides file $top/provides\n";
644        $params->write_provides(\*F);
645        close F;
646    } else {
647        # TODO must create a real read_depslist function that really recreate a depslist with a file.
648        $params->read_depslist("$top/depslist.ordered");
649        $params->read_provides_files("$top/provides");
650        $params->read_hdlists("$top/hdlist.cz");
651        $params->compute_depslist();
652        my @unresolved = $params->get_unresolved_provides_files();
653        if (@unresolved > 0) {
654            $params->clean();
655            $params->read_hdlists("$top/hdlist.cz");
656            $params->keep_only_cleaned_provides_files();
657            $params->read_hdlists("$top/hdlist.cz");
658            $params->compute_depslist();
659        }
660    }
661    return $params
662}
663
664sub packageOutOfRpmsrate{
665    my ($rpmsrate) = @_;
666    my $rate = getRpmsrate($rpmsrate);
667    print LOG join("\n",sort(keys %$rate)),"\n";
668    1
669}
670
671sub getLeaves {
672    my ($depslist) = @_;
673    open DEP, "$depslist" or die "Could not open $depslist\n";
674    my @name;
675    my %pkg;
676    my $i = 0;
677    foreach (<DEP>){
678        chomp;
679        my ($name, undef, @de) = split " ", $_; 
680        ($name, my $version, my $release) = $name =~ /(.*)-([^-]*)-([^-]*)/;
681        if ($name){
682            foreach my $d (@de) {
683                if ($d !~ s/^NOTFOUND_//) { 
684                    if ($d =~ /\|/){ 
685                        my @t = split '\|',$d ; 
686                        foreach my $t (@t) { if ($t !~ s/NOTFOUND_//) { $pkg{$name[$t]}++ }}
687                    }else { $pkg{$name[$d]}++}
688                }
689            }
690            $name[$i] = $name;
691            $pkg{$name[$i]}++;
692            $i++;
693        }
694    }
695    foreach (sort keys %pkg){
696        print LOG $pkg{$_} - 1, " $_\n";
697    }
698    1
699}
700
701#
702# TODO must add group parsing and special scoring for System or like group
703#
704
705sub getRpmsrate{
706    my ($rpmsrate,$reps) = @_;
707    my (%rate,%section);
708    my $tmprpmsrate = "$TMP/$config[0][0]/rpmsrate";
709    local *R; open R, ">$tmprpmsrate" or print LOG "ERROR: cannot open temporary rpmsrate file $tmprpmsrate\n";
710    cleanrpmsrate($rpmsrate,*R,@$reps);
711    close R;
712    unlink "$rpmsrate" and copy "$tmprpmsrate", "$rpmsrate";
713    local *R; open R, "$rpmsrate" or print LOG "ERROR: cannot open rpmsrate file $rpmsrate\n";
714    my $rate;
715    my $data;
716    my $current;
717    my $max;
718    while (<R>){
719        s/#.*//; # comments
720        /^\s*$/ and next;
721        if (/^(\S+)/) {
722            $current = $1;
723            next
724        }
725        (undef, my $sect, $data) = /(?:\s+([\s1-5]) )((?:[!0-9A-Z_]+ )*)(.*)/;
726        $rate = $1 > 0 ? $1 : $rate;
727        $data or next;
728        my ($flags,$dt) = $data =~ /((?:(?:[!0-9A-Z_])+"(?:[^"]*)"(?:\s+\|\|\s+)?)*)(.*)/;
729        $VERBOSE and print LOG "getRpmsrate: current $current ($sect - $flags)\n";
730        $dt or next;
731        my @k = split ' ', $dt;
732        $VERBOSE and print LOG "getRpmsrate @k ($rate)\n";
733        $rate > $max and $max = $rate;
734        @rate{@k} = map $rate, @k;
735        push @{$section{$current}}, @k
736    }
737    [\%rate,\%section];
738}
739
740sub getreps{
741    my ($lists) = @_;
742    my @reps;
743    foreach my $i (@{$lists}){
744        my (undef,undef,undef,undef,@list) = @{$config[2][$i][0]};
745        foreach (@list){
746            my $t = $config[1][$i];
747            ref $t or next;
748            foreach (@{$t->[1]}) { 
749                $VERBOSE and print LOG "REPOSITORY $_->[1] -- $_->[2]\n";
750                push @{$reps[$i]} , $_->[0] }
751        }
752    }
753    return (\@reps)
754}
755
756#
757# group structure
758#
759# $group[group number]{list} = { list => [[cd, repname, {options}],[], ...,[]] }
760#
761# $group[group number]{sourcerep} = { list => [[ srpm cd, srpm repname], [srpm cd 2, srpm repname 2], ..., [srpm cd n, srpm repname n]] }
762#
763# $group[group number]{params} = rpmtools::params
764#
765# $group[group number]{rpmsratepath} = rpmsrate path
766#
767# $group[group number]{rpmsrate} = { rpmsrate }
768#
769# $group[group number]{size} = { rpm_name => [filesize, list number, directory], ... }
770#
771# $group[group number]{listsize} = { list => total rpm size, ... }
772#
773# $group[group number]{score} = [ score weight ]
774#
775# $group[group number]{scoredlist} = { rpm_name => score }
776#
777# $group[group number]{maxsize} = rpm maxsize
778#
779# $group[group number]{depsrep} = deps repository name
780#
781# $group[group number]{depslistid} = [ depslist id ]
782#
783# $group[group number]{pkgdeps} = { package_name => [depslist dependencies ] }
784#
785# $group[group number]{revdeps} = [ reversed depslist ]
786#
787# $group[group number]{lang} = { locale1 => 1, locale2 => 1}
788#
789# $group[group number]{filelist} = [FILELIST]
790#
791# $group[group number]{listrpm} = { list => [ rpm ] }
792#
793# $group[group number]{brokendeps} = { rpm_depending_on_non_listed_locales => 1 , rpm_which_deps_are_broken => 2 }
794#
795# $group[group number]{installDisc} = install disc for this group
796#
797# $group[group number]{discdeps} = { cd => [ cds it depends on ] }
798#
799# $group[group number]{missingdeps} = { rpm => [ missing dependencies ] }
800#
801# $group[group number]{pkgrate} = { rpm => rpmsrate_increase }
802#
803# $group[group number]{done} = { rpm => rep number }
804#
805# $group[group number]{globrpm} = [ "path1/rpm1" ... "pathn/rpmq" ]
806#
807# $group[group number]{srpmname} = srpm-version-release
808#
809# $group[group number]{orderedrep} = { "rep_name" => num }
810#
811# $group[group number]{maxrep} = max ordered rep_name number
812#
813# $group[group number]{nodeps} = { list => 1}
814#
815# 0  {list}
816# 1  {sourcerep}
817# 2  {params}
818# 3  {rpmsratepath}
819# 4  {rpmsrate}
820# 5  {size}
821# 6  {score}
822# 7  {scoredlist}
823# 8  {maxsize}
824# 9  {depsrep}
825# 10
826# 11 {depslistid}
827# 12 {pkgdeps}
828# 13 {revdeps}
829# 14 {lang}
830# 15 {filelist}
831# 16 {listrpm}
832# 17 {brokendeps}
833# 18 {installDisc}
834# 19 {discdeps}
835# 20 {missingdeps}
836#
837#
838#  FIXME
839#
840# Weigh should be put in the first loop with list so that generic
841# groups without installation can get scoring. At present the implementation
842# prevent from using the -o option with generic and as a consequence
843# generic groups will be sorted with (1,1,0) (no install means no rpmsrate)
844#
845
846sub getGroups {
847    my ($lists) = @_;
848    my @list;
849    my %cd;
850    my %done;
851    my %list;
852    my %repname;
853    print LOG "getGroups\n";
854    foreach my $i (keys %{$lists}){
855        $VERBOSE and print LOG "getGroups 1: disc $i\n";
856        $cd{$i} = 1;
857        my (undef,undef,undef,undef,@l) = @{$config[2][$i][0]};
858        foreach (@l){
859            $VERBOSE and print LOG "LIST $_->[1]{list} -- $_->[1]{repname} options (", keys %{$_->[1]} ,")\n";
860            my $idx;
861            if ($_->[1]{source}) { 
862                $_->[1]{score} = $_->[1]{priority} ? $_->[1]{priority} + $config[3]{discMax} : $config[2][$i][0][2];   
863                push @{$list[$_->[1]{list}][1]}, [$i, $_->[1]{repname}, $_->[1], {}]
864            } else { 
865                $idx = push @{$list[$_->[1]{list}][0]}, [$i, $_->[1]{repname}, $_->[1], {}]
866            }
867            push @{$repname{$i}{$_->[1]{repname}}}, [ $_->[1]{list}, $idx - 1 ];
868            $VERBOSE and print LOG "REPNAME $i -- $_->[2]{repname} -- $_->[2]{list}\n";
869            $list{$_->[1]{list}} = 1
870        }
871    }
872    my @group;
873    my $g;
874    my %donerep;
875    foreach my $i (keys %{$lists}){
876        my $t = $config[2][$i][2]{installation};
877        $VERBOSE and print LOG "getGroups 2: disc $i ($t)\n";
878        ref $t and do {
879            print LOG "getGroups: install disc for group $g => ($i)\n";
880            $group[$g]{installDisc} = $i;
881            $group[$g]{options} = $t->[1];
882            my $depsname;
883            my $num = 1;
884            my $lnsort = 1;
885            foreach (@{$t->[1]{rpmsdir}}){
886                my ($cd,$name) = ($_->[0],$_->[1]);
887                my $opt = $_->[2] || {};
888                $VERBOSE and print LOG "Group: $g -- $cd -- $name -- $cd{$cd} -- opt $opt\n";
889                $donerep{$g}{$cd}{$name} and print LOG "ERROR: $cd/$name is defined multiple time for group $g, ignoring\n" and next;
890                $donerep{$g}{$cd}{$name} = 1;
891                $cd{$cd} or print LOG "ERROR: disc $cd not in list, ignoring\n" and next;
892                my $ln = $repname{$cd}{$name};
893                $ln or print LOG "ERROR getGroups: $name on disc $cd does not exist\n" and next;
894                $group[$g]{orderedrep}{"$cd/$name"} = $num++;
895                $group[$g]{score} ||= $t->[1]{score} || [1,1,1];
896                $VERBOSE and print LOG "GROUPS TEST SCORE @{$group[$g]{score}}\n";
897                $VERBOSE and print LOG "TEST LIST  [$cd, $name]\n";
898                $cd != $i and push @{$group[$g]{discdeps}{$i}}, $cd;
899                $cd != $i and print LOG "Group $g handle disc $i (@{$group[$g]{discdeps}{$i}})\n";
900                foreach my $l (@$ln){
901                    my ($list,$idx) = @$l;
902                    if (!$group[$g]{listsort}{$list}) { $group[$g]{listsort}{$list} = $lnsort++ };
903                    print LOG "List $list ($group[$g]{listsort}{$list})\n";
904                    push @{$group[$g]{list}{$list}}, [$cd, $name, $list[$list][0][$idx][2], $opt];
905                    if ($opt->{fixed}){
906                        push @{$config[1][$list][3]{$cd}{$name}{master}}, $g           
907                    }else{
908                        # this group is the master for this rep
909                        unshift @{$config[1][$list][3]{$cd}{$name}{master}}, $g
910                    }
911                    $list{$list}++;
912                    if ($list[$list][1]) { $group[$g]{sourcerep}{$list} ||= [sort { $b->[2]{score} <=> $a->[2]{score} } @{$list[$list][1]}]}
913                    else { $group[$g]{sourcerep}{$list} = [] }
914                    $done{$_->[0]}{$_->[1]} foreach (@{$list[$list][1]}) 
915                }       
916                $done{$cd}{$name}++;
917            }
918            $group[$g]{discdeps}{$i} ||= [];
919            $group[$g]{rpmsratepath} ||= $t->[1]{rpmsrate} || "$t->[1]{install}/Mandrake/base/rpmsrate";
920            print LOG "Using $group[$g]{rpmsratepath} as rpmsrate file\n";
921
922            $group[$g]{list} and $group[$g]{depsrep} = join '-', keys %{$group[$g]{list}};
923            print LOG "getGroups: $group[$g]{depsrep} defined as deps file directory\n";
924            if (ref $t->[1]{lang}) { 
925                foreach (@{$t->[1]{lang}}) {$group[$g]{lang}{$_} = 1 }
926            }
927            $group[$g]{maxrep} = $num;
928            $group[$g]{maxlist} = $lnsort;
929            $g++;
930        }
931    }
932    # complete the groups
933    for (my $i; $i < @group; $i++){
934        $VERBOSE and print LOG "getGroups 3: $group[$i] -- $group[$i]{list}\n";
935        foreach my $l (keys %{$group[$i]{list}}){
936            # add srpm cds as belonging to this group
937            foreach (@{$group[$i]{sourcerep}{$l}}){ print LOG "Group $i handle disc $_->[0]\n";$group[$i]{discdeps}{$_->[0]} ||= []}
938            foreach (@{$list[$l][0]}){
939                $VERBOSE and print LOG "$l -- $_->[0] -- $_->[1] -- $_->[2]\n";
940                if (!$done{$_->[0]}{$_->[1]}){
941                    $group[$i]{discdeps}{$_->[0]} ||= [];
942                    print LOG "Group $i handle disc $_->[0] (@{$group[$i]{discdeps}{$_->[0]}})\n";
943                    push @{$config[1][$l][3]{$_->[0]}{$_->[1]}{master}}, $g;
944                    push @{$group[$i]{list}{$l}}, $_;
945                    $done{$_->[0]}{$_->[1]}++
946                }
947            }
948        }
949    }
950    foreach (keys %list){
951        $VERBOSE and print LOG "getGroups 4: list $_\n";
952        if ($list{$_} == 1){ 
953            print LOG "WARNING: list $_ does not belong to any installation disc, setting alone groups\n";
954            my $num = 1;
955            foreach my $l (@{$list[$_][0]}){
956                $VERBOSE and print LOG "LIST @$l (list $_)\n";
957                push @{$config[1][$_][3]{$l->[0]}{$l->[1]}{master}}, $g;
958                push @{$group[$g]{list}{$_}}, $l;
959                $group[$g]{orderedrep}{"$l->[0]/$l->[1]"} = $num++;
960                $done{$l->[0]}{$l->[1]}++;
961                print LOG "Group $g handle disc $l->[0]\n";
962                $group[$g]{discdeps}{$l->[0]} ||= [];
963            }
964            $group[$g]{sourcerep}{$_} = $list[$_][1];
965            $group[$g]{score} = [1,1,1];
966            $group[$g]{depsrep} = $_;
967            foreach my $l (@{$group[$g]{sourcerep}{$_}}){ $group[$g]{discdeps}{$l->[0]} ||= []}
968            $VERBOSE and print LOG "LIST $_ -- $list[$_][1] -- GROUP $group[$g]{sourcerep}{$_}\n";
969            $list{$_}++;
970            $g++
971        }
972    }
973    foreach my $i (keys %{$lists}){
974        $VERBOSE and print LOG "getGroups 5: disc $i\n";
975        $done{$i} and next;
976        $VERBOSE and print LOG "getGroups 5: disc $i does not handled by any group, setting alone group\n";
977        $group[$g]{discdeps}{$i} ||= [];
978        $g++
979    }
980    for (my $i; $i < @group; $i++){
981        foreach my $listnumber (keys %{$group[$i]{list}}){
982            print LOG "                         GroupList 2 group $i list $listnumber\n";
983        }
984    }
985
986    $VERBOSE and printTable(\@group);
987    \@group
988}
989
990sub preCheck{
991    # TODO
992    # may not be necessary
993}
994
995sub batchMode{
996    my ($cds,$file) = @_;
997    config($file);
998    my ($discsFiles,$cd) = readBatchFile($file);
999    my ($lists,$cds) = getDiscsList($cds);
1000    my @mkisos;
1001    my @size;
1002    makeDiscs(0,$lists,$cds,\@size,\@mkisos,$discsFiles);
1003    makeDiscs(1,$lists,$cds,\@size,\@mkisos,$discsFiles,$cd);
1004}
1005
1006sub getDiscsList {
1007    my ($cds) = @_;
1008    my $cds = getTracks($cds);
1009    print LOG "getDiscList: discs @$cds\n";
1010    my %list;
1011    $cds = [grep { ref $config[2][$_] and do { $list{$_} = 2; push @$lists, $_} or print LOG "WARNING: disc $_ not defined\n" and 0} @$cds];
1012    $lists ||= $cds;
1013    $lists = [grep { $list{$_} or ref $config[2][$_] and $list{$_} = 1 or print LOG "WARNING: disc $_ not defined\n" and 0} @$lists];
1014    return (\%list,$cds)
1015}
1016
1017sub autoMode{
1018    my ($opt,$repository, @rpms) = @_;
1019    $NOLIVE = 1;
1020    $NOSRCFIT = 1;
1021    $DEPS = 1;
1022    -d "$repository/Mandrake" or print "ERROR: $repository/Mandrake does not exist\n" and return 0;
1023    my $dir = "$repository/Mandrake";
1024    local *DIR; opendir DIR, $dir;
1025    my $size;
1026    foreach (readdir DIR){
1027        -d "$dir/$_" or next;
1028        /RPMS(\d*)$/ or next;
1029        print LOG "autoMode: adding $dir/$_\n";
1030        unshift @rpms, "$dir/$_"
1031    }
1032    my ($name,$tag);
1033    if (-f "$repository/VERSION"){
1034        local *A; open A, "$repository/VERSION";
1035        <A>;
1036        /^Mandrake Linux (.*) \d{8} \d{2}:\d{2}$/;
1037        ($name,$tag) = split ' ', $1
1038    }
1039    $name ||= "Cooker";
1040    $config[0][0] = $name;
1041    $config[1][1][0] = 0;
1042    $config[1][1][2] = $opt;
1043    $config[1][1][2]{auto} = 1;
1044    foreach (keys %{$config[1][1][2]}) { print LOG "autoMode: list options $_ -> $config[1][1][2]{$_}\n"}
1045    foreach (@rpms){
1046        #       $size += du($_);
1047        push @{$config[1][1][1]}, [$_]
1048    }
1049    #print LOG "Total RPMS $size\n";
1050    $config[2][1][0] = [$DISCSIZE,"${name}-disc1",1,"MandrakeLinux $name"];
1051    &{$functions{dir}[0][5]}(1,1,"rpms","Mandrake/RPMS");
1052    &{$functions{generic}[0][5]}(1,2,"rpms",1);
1053    &{$functions{installation}[0][5]}(1,3,"1/rpms");
1054    &{$functions{installation}[5][5]}(1,3,"$repository");
1055    &{$functions{installation}[6][5]}(1,3);
1056    &{$functions{installation}[10][5]}(1,3,"$tag");
1057    printTable(\@config);
1058    makeWithGroups({ 1 => 2 },[ 1 ]);
1059    1   
1060}
1061
1062sub make {
1063    my ($cds) = @_;
1064    makeWithGroups(getDiscsList($cds));
1065    1
1066}               
1067
1068sub orderGroups{
1069    my ($groups,$lists,$acds) = @_;
1070    my @metagroups;
1071    my @groupmeta;
1072    my $ok;
1073    # FIXME This algo can create empty metagroups
1074    while (!$ok){
1075        print LOG "orderGroups: ordering metagroups\n";
1076        $ok = 1;
1077        for (my $i; $i < @$groups; $i++){
1078            if ($groups->[$i]{installDisc}){
1079                $lists->{$groups->[$i]{installDisc}} == 2 or next
1080            }
1081            print LOG "Group $i (install disc $groups->[$i]{installDisc})\n";
1082            foreach my $list (keys %{$groups->[$i]{list}}){
1083                foreach my $rep (@{$groups->[$i]{list}{$list}}){
1084                    my ($cd,$r) = ($rep->[0],$rep->[1]);
1085                    $lists->{$cd} == 2 or next;
1086                    my $og = $config[1][$list][3]{$cd}{$r}{master}[0];
1087                    print LOG "Master of disc $cd/$r = $og\n";
1088                    if ($og != $i && $groupmeta[$i] == $groupmeta[$og]){ $ok = 0;$groupmeta[$i] = $groupmeta[$og] + 1 }
1089                }
1090            }
1091        }
1092    }
1093    for (my $i; $i < @$groups; $i++){
1094        if ($groups->[$i]{installDisc}){
1095            $lists->{$groups->[$i]{installDisc}} == 2 or next
1096        }
1097        print LOG "orderGroups: group $i metagroup $groupmeta[$i]\n";
1098        push @{$metagroups[$groupmeta[$i]][0]}, $groups->[$i];
1099    }
1100    my %donedisc;
1101    foreach (@metagroups){
1102        my %cd;
1103        my %cdg;
1104        my $i = 1;
1105        foreach (@$acds) { $cd{$_} = $i++ }
1106        my $grps = $_->[0];
1107        my $loop;
1108        my $ok = 0;
1109        $_->[1] = [];
1110        while (!$ok && !$loop){
1111            $ok = 1;
1112            foreach my $g (@{$grps}){
1113                print LOG "orderGroups: discs ", keys %{$g->{discdeps}},"\n";
1114                foreach my $cd (keys %{$g->{discdeps}}){
1115                    $donedisc{$cd} and next;
1116                    print LOG "orderGroups: disc $cd\n";
1117                    $lists->{$cd} >= 1 or next;
1118                    $cdg{$cd} = {};
1119                    if (ref $g->{discdeps}{$cd}){
1120                        foreach (@{$g->{discdeps}{$cd}}){
1121                            $donedisc{$_} and next;
1122                            print LOG "orderGroups: disc $cd => $_\n";
1123                            $cdg{$cd}{$_} and print LOG "ERROR: orderGroups: loop in discs dependencies, taking manual order\n" and $loop = 1;
1124                            $cdg{$cd}{$_} = 1;
1125                            $cdg{$_} = {};
1126                            if ($cd{$cd} <= $cd{$_}){ 
1127                                $cd{$cd} = $cd{$_} + 1;
1128                                $ok = 0
1129                            }
1130                        }
1131                    }
1132                }
1133            }
1134        }
1135        if ($loop){
1136            foreach my $c (@$acds) { $cdg{$c} and $lists->{$c} == 2 and push @{$_->[1]}, $c and $donedisc{$c} = 1} 
1137        }else{
1138            my @scds = sort { $cd{$a} <=> $cd{$b} }  keys %cdg;
1139            foreach my $c (@scds) { $lists->{$c} == 2 and push @{$_->[1]}, $c and $donedisc{$c} = 1}   
1140        }
1141        print LOG "orderGroup: disc sorting @{$_->[1]}\n"
1142    }
1143    # add alone discs
1144    my @cd;
1145    foreach (keys %donedisc){
1146        $donedisc{$_} or push @cd, $_ 
1147    }
1148    @cd and push @metagroups, [0,\@cd];
1149    \@metagroups
1150}
1151
1152sub getRPMsKeys{
1153    my ($list,@hdlist) = @_;
1154    my %keys;
1155    foreach (@hdlist){
1156        my $packer = new packdrake($_);
1157        my $count = scalar keys %{$packer->{data}};
1158        print LOG "$count files in archive, uncompression method is \"$packer->{uncompress}\"\n";
1159        foreach my $file (@{$packer->{files}}) {
1160            for ($packer->{data}{$file}[0]) {
1161                if ($file =~ /(.*):(.*)/){
1162                    $keys{rpm}{$1} = $2;
1163                    $keys{key}{$2} = $1
1164                }else{
1165                    $keys{rpm}{$file} = $file;
1166                    $keys{key}{$file} = $file
1167                }
1168                $list and printf LOG "l %13c %s -> %s\n", ' ', $file, $packer->{data}{$file}[1]
1169            }
1170        }
1171    }
1172    return \%keys
1173}
1174
1175sub makeWithGroups{
1176    my ($lists, $acds) = @_;
1177    my $metagroups = orderGroups(getGroups($lists),$lists,$acds);
1178
1179    foreach (keys %{$lists}){
1180        print LOG "LIST $_ => $lists->{$_}\n"
1181    }
1182
1183    my @discsFiles;
1184    my (@cdsize,@size);
1185    for(my $i; $i < @{$config[2]}; $i++) { $cdsize[$i] = $config[2][$i][0][0] }
1186    foreach (@{$metagroups}){
1187        my $groups = $_->[0];
1188        print LOG "makeWithGroups: Group listing $_ (@{$_->[1]} -- $groups)\n"
1189    }
1190    foreach my $g (@{$metagroups}){
1191        my $cds = $g->[1];
1192        my $groups = $g->[0];
1193        print LOG "Group: $g (@{$g->[1]} -- $groups)\n";
1194        # FIXME ordering metagroups can lead to empty groups with the -l option
1195        $groups or next;
1196
1197        my @buildlist;
1198        my @rpmlist;
1199        my (@log,@groupok,@mkisos);
1200        makeDiscs(0,$lists,$cds,\@size,\@mkisos,\@discsFiles);
1201
1202        for (my $i; $i < @$groups; $i++){
1203            print LOG "Get already built discs lists\n";
1204            $groups->[$i]{done} = {};
1205            getBuiltDiscs($lists, $groups->[$i], \@discsFiles);
1206            $VERBOSE and print LOG "GROUP $i\n";
1207            my ($reps,$sreps) = getGroupReps($groups->[$i]);
1208            @$reps or next;
1209            $VERBOSE and print LOG "genDeps\n";
1210            $groups->[$i]{params} = genDeps("$TMP/$config[0][0]/$groups->[$i]{depsrep}",$reps) or print LOG "ERROR: genDeps failed\n" and return 0;
1211
1212            $VERBOSE and print LOG "getRPMsKey\n";     
1213            $groups->[$i]{rpmkey} = getRPMsKeys(0,"$TMP/$config[0][0]/$groups->[$i]{depsrep}/hdlist.cz");
1214            $VERBOSE and print LOG "getSize", keys %{$groups->[$i]{list}},"\n";
1215            my $redeps = getSize($groups->[$i]) or print LOG "ERROR: getSize failed\n" and return 0;
1216            if ($redeps == 2){ 
1217                print LOG "Rebuilding depslist\n" and $groups->[$i]{params} = genDeps("$TMP/$config[0][0]/$groups->[$i]{depsrep}",$reps,1);
1218                $groups->[$i]{rpmkey} = getRPMsKeys(0,"$TMP/$config[0][0]/$groups->[$i]{depsrep}/hdlist.cz");
1219                getSize($groups->[$i]) or print LOG "ERROR: getSize failed\n" and return 0;
1220            }   
1221
1222            guessHdlistSize($groups->[$i],\@size,\@cdsize,$lists,\@discsFiles);
1223
1224            $groups->[$i]{revdeps} = reverseDepslist($groups->[$i]);
1225
1226            $groups->[$i]{filelist} = getList($groups->[$i],\@discsFiles);
1227
1228            $VERBOSE and print LOG "getRpmsrate $groups->[$i]{rpmsratepath}\n";
1229            if ($groups->[$i]{rpmsratepath}){ $groups->[$i]{rpmsrate} = getRpmsrate($groups->[$i]{rpmsratepath},$reps) or print LOG "ERROR: getRpmsrate failed\n" }
1230
1231            print LOG "buildList group $i\n";
1232            $rpmlist[$i] = buildList($groups->[$i]) or return 0;
1233
1234            scoreList($groups->[$i]) or return 0;
1235            autodeps($groups->[$i],$rpmlist[$i]);
1236
1237            foreach my $l (keys %{$rpmlist[$i]}) { 
1238                my @force;
1239                my @superforce;
1240                my @limit;
1241                my @b;
1242                foreach (keys %{$rpmlist[$i]{$l}}){
1243                    $_ or print LOG "ERROR: empty rpmlist key ($rpmlist[$i]{$l}{$_}) KEYS ", keys %{$rpmlist[$i]{$l}{$_}}," \n";
1244                    if (!$NODEPS && !$groups->[$i]{options}{nodeps} && /basesystem/) { 
1245                        push @superforce, [$_, $rpmlist[$i]{$l}{$_}, $groups->[$i]{scorelist}{$_}]
1246                    }elsif ($rpmlist[$i]{$l}{$_}{force}) { 
1247                        push @force, [$_, $rpmlist[$i]{$l}{$_}, $groups->[$i]{scorelist}{$_}]
1248                    }elsif ($rpmlist[$i]{$l}{$_}{limit}){
1249                        push @limit, [$_, $rpmlist[$i]{$l}{$_}, $groups->[$i]{scorelist}{$_}]
1250                    }else { push @b, [$_, $rpmlist[$i]{$l}{$_}, $groups->[$i]{scorelist}{$_}]}
1251                }
1252                $buildlist[$i]{$l} = [sort { $a->[2] <=> $b->[2] } @b];
1253                unshift @{$buildlist [$i]{$l}}, @limit;
1254                push @{$buildlist[$i]{$l}}, @force;
1255                push @{$buildlist[$i]{$l}}, @superforce
1256            }
1257        }
1258
1259        # FIXME it must have a cleaner manner to keep buildlist and do not have
1260        # to copy it.
1261        my @cb;
1262        for(my $i; $i < @buildlist; $i++){ 
1263            foreach my $l (keys %{$buildlist[$i]}){ foreach (@{$buildlist[$i]{$l}}){ $VERBOSE and print LOG "MakeWithGroups: copying buildlist group $i list $l package $_->[0] ($_->[2])\n";push @{$cb[$i]{$l}}, $_}}}
1264
1265        my ($diff,$rejected) = buildDiscs($groups,\@cb,\@rpmlist,\@log,\@groupok,\@size,\@cdsize,$lists,$cds);
1266        my $logi;
1267        my $cd = processDiff($groups,$diff,\@log,\@discsFiles);
1268        my $ok;
1269        makeDiscs(1,$lists,$cds,\@size,\@mkisos,\@discsFiles,$cd) or return 0;
1270        my $ok = checkSize(0,\@size,\@cdsize,$rejected);
1271        my $n;
1272        $ok = 1;
1273        while (!$ok){
1274            $n++;
1275            $ok = 1;
1276            my @cb;
1277            for(my $i; $i < @buildlist; $i++){ 
1278                foreach my $l (keys %{$buildlist[$i]}){ foreach (@{$buildlist[$i]{$l}}){push @{$cb[$i]{$l}}, $_}}}
1279                ($diff,$rejected) = buildDiscs($groups,\@cb,\@rpmlist,\@log,\@groupok,\@size,\@cdsize,$lists,$cds);
1280                my $cd = processDiff($groups,$diff,\@log,\@discsFiles);
1281                makeDiscs(2,$lists,$cds,\@size,\@mkisos,\@discsFiles,$cd) or return 0;
1282                $ok = checkSize($n,\@size,\@cdsize,$rejected);
1283                !$ok and print LOG "ERROR: one or more disc are too big or too small, rebuilding lists\n";
1284                $n > 2 and print LOG "ERROR: could not manage to build discs of correct size, exiting\n" and last
1285        }
1286        for (my $i; $i < @$groups; $i++){
1287            foreach my $list (keys %{$groups->[$i]{list}}){
1288                foreach (@{$groups->[$i]{list}{$list}}){
1289                    $config[1][$list][3]{$_->[0]}{$_->[1]}{done} = 1
1290                }
1291            }   
1292        }
1293    }
1294    $PRINT and printDiscsFile($metagroups,\@discsFiles,$PRINT);
1295    $PRINTSCRIPT and printBatchFile(\@discsFiles,$PRINTSCRIPT);
1296    1
1297}
1298
1299# FIXME must add space for synthesis, however they are negligeable compared to hdlist. Only
1300# a pb with very small CD.
1301
1302sub guessHdlistSize{
1303    my ($group,$size,$cdsize,$lists,$discsFiles) = @_;
1304    my $depsRep = "$TMP/$config[0][0]/$group->{depsrep}";
1305    # FIXME heuristic for hdlist size on installation disc, (RPMS size / 100) per discs
1306    my $depsSize = du("$depsRep");
1307    my $instdisc = $group->{installDisc};
1308    my $sz;
1309    # keeping curdone outside the list loop could correct the mis value if multiple reps on one discs
1310    my %curdone;
1311    my @notdone;
1312    foreach my $list (keys %{$group->{list}}){
1313        if ($config[1][$list][2]{auto}){
1314            $sz += $depsSize
1315        }else {
1316            my $ok;
1317            my $listsize = $group->{listsize}{$list};
1318            foreach my $rd (@{$group->{list}{$list}}){
1319                my ($cdrep,undef,undef,$opt) = @$rd;
1320                if ($opt->{nodeps}) { $ok = 1; next }
1321                $curdone{$cdrep} and next;
1322                $curdone{$cdrep} = 1;
1323                if ($lists->{$cdrep}){
1324                    if ($listsize > $cdsize->[$cdrep]){
1325                        $lists->{$cdrep} and $sz += $cdsize->[$cdrep] / 130;
1326                        $listsize -= $cdsize->[$cdrep];
1327                    }else{
1328                        $lists->{$cdrep} and $sz += $listsize / 130;
1329                        last
1330                    }
1331                }
1332            }
1333            $ok and push @notdone, $list       
1334        }
1335    }
1336    print LOG "guessHdlistSize: reserving ";
1337    if ($depsSize < $sz){ print LOG "$depsSize" ;$size->[$instdisc] += $depsSize } else { print LOG "$sz"; $size->[$instdisc] += $sz }
1338    print LOG " (new size $size->[$instdisc]) on disc $instdisc ($depsSize/$sz) for dependencies files\n";
1339    @notdone or return 1;
1340    my $sz;
1341    foreach my $list (@notdone){
1342        foreach my $rd (@{$group->{list}{$list}}){
1343            my ($cd,$rep,$repopt,$opt) = @$rd;
1344            if ($lists->{$cd} == 1){
1345                $sz += du("$topdir/build/$config[0][0]/$cd/$config[2][$cd][2]{dir}{$rep}")
1346            }elsif ($lists->{$cd} == 2){
1347                foreach my $rpm (keys %{$discsFiles->[$cd]{$rep}}){
1348                    $sz += du("$discsFiles->[$cd]{$rep}{$rpm}/$rpm.rpm")
1349                }
1350            }
1351        }
1352    }
1353    $sz /= 130;
1354    print LOG "guessHdlistSize: reserving ";
1355    print LOG "$sz"; $size->[$instdisc] += $sz;
1356    print LOG " (new size $size->[$instdisc]) on disc $instdisc ($sz) for extra dependencies files\n"
1357}               
1358
1359sub processDiff {
1360    my ($groups, $diff, $log, $discsFiles) = @_;
1361    my @cd;
1362    for(my $cd; $cd < @$diff; $cd++){
1363        my $dc = $diff->[$cd];
1364        $dc or next;
1365        for(my $grp; $grp < @$dc; $grp++){
1366            my $dcg = $dc->[$grp];
1367            $dcg or next;
1368            for (my $list; $list < @{$dcg}; $list++){
1369                my $dcgl = $dcg->[$list];
1370                $dcgl or next;
1371                for (my $rep ; $rep < @{$dcgl}; $rep++){
1372                    my $dcglr = $dcgl->[$rep];
1373                    $dcglr or next;
1374                    for (my $type ; $type < @{$dcglr}; $type++){
1375                        my $dcglrt = $dcglr->[$type];
1376                        $dcglrt or next;
1377                        for (my $i; $i < @{$dcglrt}; $i++){
1378                            my $ent = $dcglrt->[$i];
1379                            $log and push @{$log->[$cd][$grp][$list][$rep][$type]}, $ent;
1380                            my $rpm = $ent->[0];
1381                            my $curdir = $ent->[3];
1382                            $VERBOSE and print LOG "LOG disc $cd group $grp: $rpm ($groups->[$grp]{size}{$rpm}{$list}[1])\n";
1383                            my $source = $groups->[$grp]{size}{$rpm}{$list}[1];
1384                            push @{$cd[$cd]{$curdir->[1]}{$source}}, [$ent->[1],"$groups->[$grp]{rpmkey}{rpm}{$rpm}.rpm"];
1385                            if ($ent->[1] == 1) { $discsFiles->[$cd]{$curdir->[1]}{$groups->[$grp]{rpmkey}{rpm}{$rpm}} = $source }
1386                            # FIXME may need to delete upper hash if empty
1387                            elsif ($ent->[1] == 2) { delete $discsFiles->[$cd]{$curdir->[1]}{$groups->[$grp]{rpmkey}{rpm}{$rpm}} }
1388                        }
1389                    }
1390                }
1391            }
1392        }
1393    }
1394    return \@cd
1395}
1396
1397sub printBatchFile{
1398    my ($discsFiles,$PRINTSCRIPT) = @_;
1399    if (-f $PRINTSCRIPT) {
1400        my $err = unlink $PRINTSCRIPT;
1401        if (!$err) { print LOG "Unlinking failed $PRINTSCRIPT: $!\n"; return};
1402    }
1403    my $err = copy $config[3]{configfile}, $PRINTSCRIPT;
1404    if (!$err) { print LOG "Linking failed $PRINTSCRIPT: $!\n"; return};
1405    local *A; open A, ">>$PRINTSCRIPT";
1406    print A "END\n";
1407    for(my $cd; $cd < @$discsFiles; $cd++){
1408        $discsFiles->[$cd] or next;
1409        print LOG "discsFiles: $cd\n";
1410        print A "CD $cd\n";
1411        foreach my $rep (keys %{$discsFiles->[$cd]}){
1412            print A " REP $rep\n";
1413            foreach my $rpm (keys %{$discsFiles->[$cd]{$rep}}){
1414                $rpm and print A "  $rpm $discsFiles->[$cd]{$rep}{$rpm}\n";
1415            }
1416        }
1417    }
1418}
1419
1420sub readBatchFile{
1421    my ($file) = @_;
1422    print LOG "readBatchFile: $file\n";
1423    local *A; open A, "$file" or print "ERROR readBatchFile: could not open $file for reading\n" and return;
1424    my @discsFiles;
1425    my @cd;
1426    while (<A>){ /^END/ and last }
1427    my ($cd,$rep);
1428    while (<A>){
1429        if (/^CD (\d+)/){ $cd = $1; print LOG "CD $cd\n"; next }
1430        if (/^ REP (\S+)/){ $rep = $1; print LOG " REP $rep\n";next }
1431        if (/^  (\S+) (\S+)/){ 
1432            $discsFiles[$cd]{$rep}{$1} = $2;
1433            push @{$cd[$cd]{$rep}{$2}}, [ 1, "$1.rpm" ];
1434            next 
1435        }
1436    }
1437    return (\@discsFiles, \@cd)
1438}
1439
1440sub printDiscsFile{
1441    my ($metagroups,$discsFiles,$PRINT) = @_;
1442    local *A; open A, ">$PRINT";
1443    my %done;
1444    for(my $cd; $cd < @$discsFiles; $cd++){
1445        $discsFiles->[$cd] or next;
1446        print LOG "discsFiles: $cd\n";
1447        my $cdname = $config[2][$cd][0][2];
1448        foreach my $rep (keys %{$discsFiles->[$cd]}){
1449            foreach my $rpm (keys %{$discsFiles->[$cd]{$rep}}){
1450                $done{$rpm} = 1;
1451                $rpm =~ /src$/ and next;
1452                print A "CD$cdname $rpm\n";
1453            }
1454        }
1455    }
1456    foreach (@$metagroups){
1457        my $groups = $_->[0];
1458        for(my $i; $i < @$groups; $i++){
1459            foreach (keys %{$groups->[$i]{params}{info}}){
1460                $done{$groups->[$i]{rpmkey}{rpm}{$_}} and next;
1461                if ($groups->[$i]{brokendeps}{$_} == 2){
1462                    print A "MISSING_DEPENDENCIES $_ @{$groups->[$i]{missingdeps}{$_}}\n"
1463                }else{
1464                    print A "REJECTED $_\n"
1465                }
1466            }
1467        }
1468    }
1469    close A;
1470}
1471
1472sub getDoneList{
1473    my ($group, $listnumber, $discsFiles) = @_;
1474    if (@{$group->{list}{$listnumber}} > 1) { print "WARNING: getDoneList: $listnumber appears in several directories, getting only the first one\n"}
1475    if (@{$group->{sourcerep}{$listnumber}} > 1) { print "WARNING: getDoneList: $listnumber appears in several sources directories, getting only the first one\n"}
1476    my $r = $group->{list}{$listnumber}[0];
1477    my $rs = $group->{sourcerep}{$listnumber}[0];
1478    my ($cd,$rep) = ($r->[0],$r->[1]);
1479    my ($scd,$srep) = ($rs->[0],$rs->[1]);
1480    foreach my $r (@{$config[1][$listnumber][1]}){
1481        local *A; opendir A, $r->[0];
1482        foreach (readdir A){
1483            /(.*)\.rpm/ or next; 
1484            my $rpm = $group->{rpmkey}{key}{$1};
1485            $group->{done}{$rpm} = $group->{orderedrep}{"$cd/$rep"};
1486            $discsFiles->[$cd]{$rep}{$1} = $r->[0]
1487        }
1488        local *A; opendir A, $r->[1];
1489        foreach (readdir A){
1490            /(.*)\.rpm/ or next; 
1491            my $srpm = $group->{rpmkey}{key}{$1};
1492            $group->{done}{$srpm} = 1;
1493            $discsFiles->[$scd]{$srep}{$1} = $r->[1]
1494        }
1495    }
1496    #
1497    # FIXME this may be better placed in the function setting the list as done, that is to say
1498    # for example in cdcom or like.
1499    #
1500    $config[1][$listnumber][3]{$cd}{$rep}{done} = 1;
1501    $config[1][$listnumber][3]{$scd}{$srep}{done} = 1;
1502}
1503
1504sub getList{
1505    my ($group,$discsFiles) = @_;
1506    my %filelist;
1507    foreach my $listnumber (keys %{$group->{list}}){
1508        my $done = $config[1][$listnumber][2]{done};
1509        $done and getDoneList($group, $listnumber,$discsFiles);
1510        if ($config[1][$listnumber][0]){
1511            foreach (@{$config[1][$listnumber][0]}){
1512                print LOG "getList: FILE LIST listnumber $listnumber ($_)\n";
1513                local *A; open A, $_ or print LOG "ERROR: cannot open $_, ignoring\n" and next;
1514                local $_;
1515                while (<A>){
1516                    s/#.*//;
1517                    $_ or next;
1518                    my ($name, $options) = /(\S*)\s*(.*)/;
1519                    my @options = split ',',$options;
1520                    print LOG "FILESLIST: $_ -> $name options @options\n";
1521                    my %opt;
1522                    foreach (@options){
1523                        s/^\s*//;
1524                        /^(?:(?:nosrc|noalternatives|regexp|ignore|nodeps|force|limit|section|exclude)|(rate|notondisc) (\d+))$/ or print LOG "WARNING: getList: $_: unknown option\n" and next;
1525                        $_ = $1 || $_; 
1526                        $opt{$_} = $2 || 1;
1527                    }
1528                    print LOG "Adding $name -- ", join ' ', keys %opt, "\n";
1529                    push @{$filelist{$listnumber}}, [$name,\%opt];     
1530                }
1531            }
1532        }else{
1533            if (!$done && $config[1][$listnumber][2]{auto}){
1534                push @{$filelist{$listnumber}}, ["INSTALL",{ section=>1, force => 1 }];
1535                push @{$filelist{$listnumber}}, [".*",{ regexp => 1 }]
1536            }
1537            #   else{
1538            #           push @{$filelist{$listnumber}}, [".*",{ done => $done, regexp => 1, force => $done }]
1539            #   }
1540            }
1541            my $listdone = 1;
1542            foreach my $r (@{$group->{list}{$listnumber}}){
1543                my ($cd,$rep,$repopt,$opt) = @$r;
1544                if ($config[1][$listnumber][3]{$cd}{$rep}{done}){
1545                    if (!$opt->{dup}){
1546                        foreach my $rpmkey (keys %{$discsFiles->[$cd]{$rep}}){
1547                            my $rpm = $group->{rpmkey}{key}{$rpmkey};
1548                            $group->{done}{$rpm} = $group->{orderedrep}{"$cd/$rep"};
1549                            print LOG "getList: $cd/$rep -> $group->{done}{$rpm}\n";
1550                            push @{$filelist{$listnumber}}, [$rpm,{ done => 1, regexp => 1, force => 1, udpate => $r->[2]{update}}];
1551                        }
1552                    }
1553                }else { $listdone = 0}
1554            }
1555            $listdone and print LOG "getList: setting list $listnumber as done\n" and $config[1][$listnumber][2]{done} = 1;
1556        }
1557        \%filelist
1558}
1559
1560sub getBuiltDiscs{
1561    my ($lists, $group, $discsFiles) = @_;
1562    foreach my $l (keys %{$group->{list}}){
1563        my @rpmlist;
1564        ref $group->{list}{$l} and push @rpmlist, @{$group->{list}{$l}};
1565        ref $group->{sourcerep}{$l} and push @rpmlist, @{$group->{sourcerep}{$l}};
1566        for (my $i; $i < @rpmlist; $i++){
1567            my ($cd,$rep,$repopt) = @{$rpmlist[$i]};
1568            $lists->{$cd} == 1 or next;
1569            my $dir = "$topdir/build/$config[0][0]/$cd/$config[2][$cd][2]{dir}{$rep}";
1570            #
1571            # FIXME maybe need to unshift instead of push
1572            #
1573            $repopt->{source} or push @{$config[1][$l][1]}, [$dir];
1574            $config[1][$l][3]{$cd}{$rep}{done} = 1;
1575            print LOG "getBuiltDiscs: get files from $dir\n";
1576            local *A; opendir A,$dir;
1577            foreach (readdir A){
1578                /(.*)\.rpm/ or next;
1579                # FIXME need to check if it is well placed in getList function
1580                # $group->{done}{$rpm} = $group->{orderedrep}{"$cd/$rep"};
1581                $discsFiles->[$cd]{$rep}{$1} = $dir
1582            }
1583        }
1584    }
1585    1
1586}
1587
1588sub getGroupReps{
1589    my ($groups) = @_;
1590    my @reps;
1591    my @sreps;
1592    foreach my $listnumber (keys %{$groups->{list}}){
1593        my $ok;
1594        foreach (@{$groups->{list}{$listnumber}}){
1595            !$_->[3]{nodeps} and $ok = 1
1596        }
1597        if (!$ok) { $groups->{nodeps}{$listnumber} = 1; next }
1598        print LOG "getGroupReps list $listnumber\n";
1599        foreach (@{$config[1][$listnumber][1]}) {
1600            print LOG "$_->[0] ($_->[1])\n";
1601            unshift @reps, $_->[0];
1602            unshift @sreps, $_->[1] 
1603        }
1604    }
1605    (\@reps,\@sreps)
1606}
1607
1608sub getSize{
1609    my ($group) = @_;
1610    my $max;
1611    my $redeps;
1612    foreach my $listnumber (keys %{$group->{list}}){
1613        print LOG "getSize list $listnumber\n";
1614        my $repnb;
1615        $group->{nodeps}{$listnumber} and next;
1616        #$config[1][$listnumber][2]{done} and next;
1617        foreach (@{$config[1][$listnumber][1]}) {
1618            $repnb++;
1619            my $dir = $_->[0];
1620            $VERBOSE and print LOG "getSize DIRECTORY $dir\n";
1621            local *RPMS; opendir RPMS, $dir or print LOG "WARNING: getSize: cannot open $dir\n" and next;
1622            foreach (readdir RPMS){
1623                /(.*)\.rpm$/ or next;
1624                my $rpm = $group->{rpmkey}{key}{$1} or print LOG "$1 not in depslist, forcing rebuilt\n" and return 2;
1625                my $b = du("$dir/$_");
1626                $b or print LOG "ERROR getSize: $rpm has a zero size\n";
1627                ref $group->{size}{$rpm}{$listnumber} and print LOG "ERROR getSize: duplicate $rpm in list $listnumber, ignoring\n" and next;
1628                $group->{size}{$rpm}{$listnumber} = [$b,$dir,$repnb];
1629                push @{$group->{listrpm}{$listnumber}}, $rpm;
1630                $group->{listsize}{$listnumber} += $b;
1631                $b > $max and $max = $b;
1632            }
1633            $dir = $_->[1];
1634            $dir or next;
1635            $VERBOSE and print LOG "getSize DIRECTORY $dir\n";
1636            local *SRPMS; opendir SRPMS, $dir or print LOG "WARNING: getSize: cannot open $dir\n" and next;
1637            foreach (readdir SRPMS){
1638                /\.rpm$/ or next;
1639                my ($srpm,$srpmname,$key);
1640                if (($srpm,$srpmname) = /((.*)-[^-]*-[^-]*\.src)\.rpm$/){
1641                    $key = $srpm;
1642                }else {
1643                    ($key) = /(.*)\.rpm$/;
1644                    my %header;
1645                    tie %header, "RPM::Header", "$dir/$_" or print LOG "ERROR getSize: $RPM::err" and next;
1646                    $srpmname = $header{'NAME'};
1647                    $srpm = "$srpmname-$header{'VERSION'}-$header{'RELEASE'}.src";
1648                }
1649                $group->{rpmkey}{key}{$key} = $srpm; 
1650                $group->{rpmkey}{rpm}{$srpm} = $key; 
1651                my $b = du("$dir/$_");
1652                $b or print LOG "ERROR getSize: $srpm has a zero size\n";
1653                ref $group->{size}{$srpm}{$listnumber} and print LOG "ERROR getSize: duplicate $srpm in list $listnumber, ignoring\n" and next;
1654                $group->{size}{$srpm}{$listnumber} = [$b,$dir,$repnb];
1655                $group->{srpmname}{$srpmname} = $srpm;
1656            }
1657        }
1658    }
1659    $group->{maxsize} = $max;
1660    1
1661}
1662
1663#
1664# compute individual scoring (max_size*(rpmsrate+1)*rpmsrate_factor/(size*size_factor))
1665# then add dependencies sons score ( score + deps_factor*(sons_score)
1666#
1667# special rpmsrate groups score could be added in the rpmsrate value
1668#
1669# FIXME current scoring rules make size only significant for equaly dependent packages,
1670# dependencies get far more importance for packages a lot of packages depend on.
1671#
1672# Size scoring could be added afterwards, but this will break the autodeps created with
1673# this scheme.
1674#
1675# TODO
1676# add scoring rules to include srpm size in score.
1677#
1678#
1679sub scoreList{
1680    my ($group) = @_;
1681    my $scoreweight = $group->{score};
1682    my $params = $group->{params};
1683    my $rpmsrate = $group->{rpmsrate};
1684    my $maxsize = $group->{maxsize} || 1;
1685    $VERBOSE and print LOG "SCORE for group: @$scoreweight\n";
1686    print LOG "Individual scoring\n";
1687    my $sf;
1688    my $i;
1689    my $total;
1690    my (@min,@max);
1691    if ($scoreweight->[1]){
1692        (@min,@max) = (($maxsize*$scoreweight->[0]*6/($scoreweight->[1]*1),0),(0,0))
1693    }else{
1694        (@min,@max) = (($maxsize*$scoreweight->[0]*6,0),(0,0))
1695    }
1696    my @specialdeps;
1697    foreach (keys %{$params->{info}}){
1698        #print "INFO KEYS $_\n";
1699        my ($ratekey) = /(.*)-[^-]+-[^-]+\.[^.]+$/;
1700        # FIXME take the bigger size when package appears in multiple lists
1701        my $size;
1702        foreach my $list (keys %{$group->{size}{$_}}){ $size < $group->{size}{$_}{$list}[0] and $size = $group->{size}{$_}{$list}[0] }
1703        $size or print LOG "ERROR: $_ has zero size\n" and next;
1704        my $s;
1705        my $rate = $group->{brokendeps}{$_} ? 0 : (defined $group->{pkgrate}{$_} ? $group->{pkgrate}{$_}: $rpmsrate->[0]{$ratekey});
1706        if ($scoreweight->[1]) {
1707            $sf = ($size*9)/$maxsize + 1; # from 1 to 10
1708            $s = $scoreweight->[0]*($rate + 1)/($scoreweight->[1]*$sf);
1709        } else {
1710            $s = $scoreweight->[0]*($rate + 1);
1711        }
1712        $group->{scorelist}{$_} = $s;
1713        ($s < $min[0]) and @min = ($s,$_);
1714        ($s > $max[0]) and @max = ($s,$_);
1715
1716        $VERBOSE and print LOG "SCORE package $_: $s (rpmsrate ($ratekey): $rate, sf: $sf)\n";
1717        $total+=$s;
1718        $i++
1719    }
1720    $i and print LOG "minimal $min[0] ($min[1]), maximal $max[0] ($max[1]), average ",$total/$i,"\n";
1721    1
1722}
1723
1724sub autodeps{
1725    my ($group, $rpmlist) = @_;
1726    my $scoredeps = $group->{score}[2];
1727    $scoredeps or print LOG "autodeps: deps score is null, bypassing autodeps\n" and return 1;
1728    $VERBOSE and print LOG "autodeps: compute reversed depslist.ordered ($scoredeps)\n";
1729    my $revDeps = $group->{revdeps};
1730    my %rpm;
1731    foreach my $k (keys %{$rpmlist}){ foreach (keys %{$rpmlist->{$k}}) { $rpm{$_} = $rpmlist->{$k}{$_} }}
1732    # FIXME this algo is not correct
1733    for (my $i = @{$group->{params}{depslist}} - 1 ; $i >= 0; $i--){
1734        my $rpm = $group->{depslistid}[$i];
1735        $rpm{$rpm} or print LOG "autodeps: ignoring $rpm\n" and next;
1736        if ($rpm{$rpm}{ignore}) { print LOG "autodeps: $rpm has ignore flag, do not add deps score\n"; next }
1737        foreach (@{$revDeps->[$i]}){
1738            $group->{scorelist}{$rpm} += $scoredeps*$group->{scorelist}{$group->{depslistid}[$_]};
1739        }
1740    }
1741    1
1742}
1743
1744sub reverseDepslist{
1745    my ($group) = @_;
1746    my $depslist = $group->{params}{depslist};
1747    my $locales = $group->{lang};
1748    my @revdeps;
1749    my %skip;
1750    print LOG "reverseDepslist\n";
1751    for (my $i; $i < @$depslist; $i++){
1752        my $d = $depslist->[$i];
1753        my $rpm = "$d->{name}-$d->{version}-$d->{release}.$d->{arch}";
1754        $group->{depslistid}[$i] = $rpm;
1755        my %rev;
1756        foreach ( split (' ', $d->{deps})){
1757            if (!$group->{options}{nodeps} && !$NODEPS && /NOTFOUND_(\S*)/) {
1758                $skip{$i} = 1;
1759                $group->{brokendeps}{$rpm} = 2;
1760                push @{$group->{missingdeps}{$rpm}}, $1;
1761                print LOG "WARNING: $rpm has unresolved dependencies ($1), ignored\n";
1762                next
1763            }
1764            if (/\|/) { 
1765                my $s = [split '\|', $_];
1766                push @{$group->{pkgdeps}{$rpm}}, $s; 
1767                foreach (@$s) { $skip{$_} or push @{$revdeps[$_]}, $i }
1768            } else { 
1769                if ($locales && $group->{depslistid}[$_] =~ /locales-([^-]+)-[^-]+-[^-]+\.[^.]+/){
1770                    if (!$locales->{$1}){
1771                        print LOG "LOCALE $1 ($group->{depslistid}[$_]) skipped for $rpm\n" and $skip{$i} = 1;
1772                        !$group->{brokendeps}{$rpm} and $group->{brokendeps}{$rpm} = 1 
1773                    }
1774                }
1775                push @{$group->{pkgdeps}{$rpm}}, $_;
1776                $skip{$_} or push @{$revdeps[$_]}, $i;
1777            }
1778        }
1779    }
1780    return \@revdeps
1781}
1782
1783sub closeRpmsList{
1784    my ($group,$rpmfile) = @_;
1785    my $n=1;
1786    my %done;
1787    my %doneName;
1788    my %alternatives;
1789    while ($n){
1790        $n = 0;
1791        foreach my $listnumber (keys %{$group->{list}}){
1792            foreach my $rpm (keys %{$rpmfile->{$listnumber}}){
1793                if (!$group->{options}{dup}){
1794                    my ($name,$version,$release,$arch) = $rpm =~ /^(.*)-([^-]+)-([^-]+)\.([^.]+)$/;
1795                    if ($doneName{$name}){
1796                        if (!($doneName{$name}[0] eq "$version-$release.$arch")){
1797                            print LOG "closeRpmsList: $name-$version-$release.$arch duplicated with $doneName{$name}[0]\n";
1798                            my ($v,$r,$a) = @{$doneName{$name}[1]};     
1799                            my $todel;
1800                            my $vers;
1801                            my $ret = rpmVersionCompare($rpm,"$name-$v-$r.$a");
1802                            if ($ret < 0){
1803                                $todel = "$name-$v-$r.$a";
1804                                $vers = [$version,$release,$arch]
1805                            }elsif ($ret > 0){
1806                                $todel = $rpm;
1807                                $vers = [$v,$r,$a]
1808                            }else{
1809                                print LOG "ERROR closeRpmsList: oops, something not possible happened in duplicate version comparaison ($rpm)\n";
1810                            }
1811                            if (0){
1812                                my $ret = rpmtools::version_compare($v,$version);
1813                                if ($ret > 0){
1814                                    $todel = $rpm;
1815                                    $vers = [$v,$r,$a]
1816                                }elsif ($ret < 0){
1817                                    $todel = "$name-$v-$r.$a";
1818                                    $vers = [$version,$release,$arch]
1819                                }else{
1820                                    $ret = rpmtools::version_compare($r,$release);
1821                                    if ($ret > 0){
1822                                        $todel = $rpm;
1823                                        $vers = [$v,$r,$a]
1824                                    }elsif ($ret < 0){
1825                                        $todel = "$name-$v-$r.$a";
1826                                        $vers = [$version,$release,$arch]
1827                                    }else{
1828                                        if($ARCH{$a} < $ARCH{$arch}){
1829                                            $todel = $rpm;
1830                                            $vers = [$v,$r,$a]
1831                                        }elsif($ARCH{$a} > $ARCH{$arch}){
1832                                            $todel = "$name-$v-$r.$a";
1833                                            $vers = [$version,$release,$arch]
1834                                        }else{
1835                                            print LOG "ERROR closeRpmsList: oops, something not possible happened in duplicate version comparaison ($rpm)\n";
1836                                        }
1837                                    }
1838                                }
1839                            }
1840                            if ($todel){
1841                                print LOG "closeRpmsList: deleting $todel\n";
1842                                $doneName{$name} = [ "$vers->[0]-$vers->[1].$vers->[2]", $vers];
1843                                $group->{brokendeps}{$todel} = 3;
1844                                delete $rpmfile->{$listnumber}{$todel};
1845                                $todel eq $rpm and next 
1846                            }
1847                            $n = 1
1848                        }
1849                    }else{
1850                        $doneName{$name} = [ "$version-$release.$arch",[$version,$release,$arch]]
1851                    }
1852                }
1853                if ($group->{brokendeps}{$rpm} == 2 || $group->{brokendeps}{$rpm} == 3){
1854                    print LOG "closeRpmsList: deleting $rpm (list $listnumber)\n";
1855                    $rpmfile->{$listnumber}{$rpm} = undef;
1856                    delete $rpmfile->{$listnumber}{$rpm};
1857                    $n = 1;
1858                    next
1859                }
1860                $done{$rpm} and next;
1861                $rpmfile->{$listnumber}{$rpm}{nodeps} and next;
1862                my $force;
1863                ($rpmfile->{$listnumber}{$rpm}{cdcom} || $rpmfile->{$listnumber}{$rpm}{done} || $rpmfile->{$listnumber}{$rpm}{force}) and $force = 1;
1864                foreach (@{$group->{pkgdeps}{$rpm}}){
1865                    /NOTFOUND_(.*)/ and print LOG "ERROR: $1 not provided\n" and next;
1866                    my $rpmdep;
1867                    my $rpmdeplist;
1868                    my $specialrpmdep;
1869                    if (ref){
1870                        if ($alternatives{"@$_"}) {
1871                            ($rpmdep, $rpmdeplist) = @{$alternatives{"@$_"}};
1872                        }
1873                        if (! ref $rpmfile->{$rpmdeplist}{$rpmdep}){
1874                            ($rpmdep, $rpmdeplist) = (undef,undef);
1875                            # FIXME this is wrong, package can come from any list
1876                            my @score = ($group->{maxlist},int @{$group->{list}{$listnumber}},$group->{maxsize});
1877                            my @specialscore = (int @{$group->{list}{$listnumber}},$group->{maxsize});
1878                            print LOG "$rpm @$_ (maxscore @score) alternative\n";
1879                            foreach (@$_) {
1880                                my $pkg = $group->{depslistid}[$_];
1881                                $group->{brokendeps}{$pkg} == 2 and next;
1882                                $group->{brokendeps}{$pkg} == 3 and next;
1883                                # FIXME take random list if multiple lists and noone equal to $listnumber
1884                                my $pkglist;
1885                                foreach (keys %{$group->{size}{$pkg}}){
1886                                    $pkglist = $_;
1887                                    last if $listnumber == $_
1888                                }
1889                                $rpmfile->{$pkglist}{$pkg}{limit} and next;
1890                                $rpmfile->{$pkglist}{$pkg}{noalternatives} and next;
1891                                my $rep = $group->{size}{$pkg}{$pkglist}[2];
1892                                my $s = $group->{size}{$pkg}{$pkglist}[0];
1893                                my $l = $group->{listsort}{$pkglist};
1894                                print LOG "\t$pkg ($l,$rep,$s) (@score)\n";
1895                                # also put an alternative from this list
1896                                if ($pkglist == $listnumber){
1897                                    if ($rep < $specialscore[1]){
1898                                        @specialscore = ($rep,$s);
1899                                        $specialrpmdep = $pkg;
1900                                    }elsif ($rep == $specialscore[1] && $s < $specialscore[2]){
1901                                        @specialscore = ($rep,$s);
1902                                        $specialrpmdep = $pkg;
1903                                    }           
1904                                }
1905                                if ($l < $score[0]){
1906                                    @score = ($l,$rep,$s);
1907                                    $rpmdep = $pkg;
1908                                    $rpmdeplist = $pkglist;
1909                                    print LOG "1 $rpmdep -- $rpmdeplist -- $l,$rep,$s\n";
1910                                }elsif ($l == $score[0]){
1911                                    if ($pkglist == $listnumber){
1912                                        if ($rep < $score[1]){
1913                                            @score = ($l,$rep,$s);
1914                                            $rpmdep = $pkg;
1915                                            $rpmdeplist = $pkglist;
1916                                            print LOG "2 $rpmdep -- $rpmdeplist -- $l,$rep,$s\n";
1917                                        }elsif ($rep == $score[1] && $s < $score[2]){
1918                                            @score = ($l,$rep,$s);
1919                                            $rpmdep = $pkg;
1920                                            $rpmdeplist = $pkglist;
1921                                            print LOG "3 $rpmdep -- $rpmdeplist -- $l,$rep,$s\n";
1922                                        }
1923                                    }elsif ($s < $score[2]){
1924                                        @score = ($l,$rep,$s);
1925                                        $rpmdep = $pkg;
1926                                        $rpmdeplist = $pkglist;
1927                                        print LOG "4 $rpmdep -- $rpmdeplist -- $l,$rep,$s\n";
1928                                    }
1929
1930                                }
1931                            }
1932                            if ($rpmdep && $rpmdeplist){
1933                                print LOG "\tResult:\t$rpmdep\n";
1934                                $alternatives{"@$_"} = [ $rpmdep, $rpmdeplist ]
1935                            }else{
1936                                print LOG "WARNING: $rpm has unresolved or excluded dependencies, removed\n";
1937                                print LOG "closeRpmsList: deleting $rpm (list $listnumber)\n";
1938                                delete $rpmfile->{$listnumber}{$rpm};
1939                                $n = 1;
1940                                $group->{brokendeps}{$rpm} = 2
1941                            }
1942                        }
1943                    } else{     $rpmdep = $group->{depslistid}[$_];
1944                    foreach (keys %{$group->{size}{$rpmdep}}){
1945                        $rpmdeplist = $_;
1946                        last if $_ == $listnumber
1947                    }
1948                }
1949                if ($rpmdep){
1950                    if ($group->{brokendeps}{$rpmdep} == 2 || $group->{brokendeps}{$rpmdep} == 3){
1951                        $group->{brokendeps}{$rpm} = $group->{brokendeps}{$rpmdep};
1952                        $n = 1;
1953                        print LOG "WARNING: $rpm has unresolved or excluded  dependencies ($rpmdep), removed\n";
1954                        print LOG "closeRpmsList: deleting $rpm (list $listnumber)\n";
1955                        delete $rpmfile->{$listnumber}{$rpm};
1956                        next
1957                    }
1958                    if ($rpmdeplist && ! ref $rpmfile->{$rpmdeplist}{$rpmdep}){
1959                        $n = 1;
1960                        $VERBOSE and print LOG "closeRpmsList: ADDED $rpmdep (list $rpmdeplist)\n";
1961                        $rpmfile->{$rpmdeplist}{$rpmdep} = { force => $force }
1962                    }
1963                }
1964                if ($specialrpmdep){
1965                    if (! ref $rpmfile->{$listnumber}{$specialrpmdep}){
1966                        $n = 1;
1967                        $VERBOSE and print LOG "closeRpmsList: ADDED $specialrpmdep (list $listnumber)\n";
1968                        $rpmfile->{$listnumber}{$specialrpmdep} = { force => $force }
1969                    }
1970                }
1971            }
1972            $done{$rpm} = 1;
1973        }
1974        print LOG "closeRpmsList: $listnumber {$n}\n";
1975    }
1976}
1977}
1978
1979sub rpmVersionCompare{
1980    my ($pkg1, $pkg2) = @_;
1981    my ($n1,$v1,$r1,$a1) = $pkg1 =~ /^(.*)-([^-]+)-([^-]+)\.([^.]+)$/;
1982    my ($n2,$v2,$r2,$a2) = $pkg2 =~ /^(.*)-([^-]+)-([^-]+)\.([^.]+)$/;
1983    die "ERROR rpmVersionCompare: trying to compare version of two differently named packages ($pkg1,$pkg2)\n" if (!($n1 eq $n2)) ;
1984    my $ret = rpmtools::version_compare($v1,$v2);
1985    if ($ret){
1986        return $ret
1987    }else{
1988        $ret = rpmtools::version_compare($r1,$r2);
1989        if ($ret){
1990            return $ret
1991        }else{
1992            if($ARCH{$a1} < $ARCH{$a2}){
1993                return -1 
1994            }elsif($ARCH{$a1} > $ARCH{$a2}){
1995                return 1
1996            }else{
1997                return 0
1998            }
1999        }
2000    }
2001}
2002
2003sub addRPMToList{
2004    my ($group,$listnumber,$rpmfile,$done,$rpms,$fentry,$name) = @_;
2005    $name =~ s/\+/\\+/g;
2006    my @toadd = grep { /^$name-[^-]+-[^-]+\.[^.]*$/ } @$rpms; 
2007    my $rep;
2008    my $pkg;
2009    # FIXME present algorythm selects only one package per version, and choose the one in the list declared first.
2010    # Maybe adding all the version and letting closeRRPMsList choose the right one is better.
2011    foreach (@toadd){
2012        $_ or print LOG "ERROR addRPMToList: empty rpm\n" and next;
2013        $group->{size}{$_}{$listnumber} or next;
2014        $group->{brokendeps}{$_} == 2 and next;
2015        $group->{brokendeps}{$_} == 3 and next;
2016        $fentry->{exclude} and print LOG "addRPMToList: excluding $_\n" and $group->{brokendeps}{$_} = 3 and next;
2017        if ($group->{size}{$_}{$listnumber}[2] < $rep || !$rep)  {
2018            $rep = $group->{size}{$_}{$listnumber}[2];
2019            print LOG "addRPMToList: choosing $_ (rep $rep)\n";
2020            $pkg = $_ 
2021        }elsif ($group->{size}{$_}{$listnumber}[2] == $rep){
2022           if (rpmVersionCompare($pkg,$_) < 0){
2023               $rep = $group->{size}{$_}{$listnumber}[2];
2024               print LOG "addRPMToList: choosing $_ (rep $rep)\n";
2025               $pkg = $_
2026           }
2027        }
2028    }
2029    defined $fentry->{rate} and $group->{pkgrate}{$pkg} = $fentry->{rate} and print LOG "addRPMToList: setting $pkg rate to $fentry->{rate}\n";
2030    $fentry->{exclude} and return 1;
2031    my ($pkgname) = $pkg =~ /^(.*)-[^-]+-[^-]+\.[^.]*$/;
2032    if ($pkg && !$done->{$pkgname}){
2033        $rpmfile->{$listnumber}{$pkg} = $fentry;       
2034        $done->{$pkgname} = [ $pkg, $group->{size}{$pkg}{$listnumber}[2], $fentry, $listnumber ];
2035        $VERBOSE and print LOG "addRPMToList: ADDED $pkg (list $listnumber)\n"
2036    }
2037}
2038
2039sub buildList{
2040    my ($group) = @_;
2041    my %rpmfile;
2042    my $filelist = $group->{filelist};
2043    my @fullrpm = (keys %{$group->{params}{info}});
2044    my @section = (keys %{$group->{rpmsrate}[1]});
2045    my %done;
2046    foreach my $listnumber (keys %{$group->{list}}){
2047        my $rpms = $group->{listrpm}{$listnumber};
2048        if (ref $rpms){
2049            $VERBOSE and print LOG "buildList: FILE LIST $listnumber (", int @{$filelist->{$listnumber}},")\n";
2050            foreach my $fentry (@{$filelist->{$listnumber}}){
2051                my $name = $fentry->[0];
2052                my $opt = $fentry->[1]; 
2053                $VERBOSE and print LOG "buildList: processing $name ", join ' ', keys %{$opt},"\n";
2054                my @toadd;
2055                if ($opt->{section}){
2056                    $opt->{section} = 0;
2057                    if ($opt->{regexp}){
2058                        @toadd = grep {/$name/} @section;
2059                        foreach (@toadd){
2060                            foreach (@{$group->{rpmsrate}[1]{$_}}){
2061                                addRPMToList($group,$listnumber,\%rpmfile,\%done,$rpms,$opt,$_);
2062                            }
2063                        }
2064                    }else{
2065                        my $rpmlist = $group->{rpmsrate}[1]{$name} or print LOG "ERROR buildList: $name unknown rpmsrate section\n" and next;
2066                        foreach (@$rpmlist){
2067                            addRPMToList($group,$listnumber,\%rpmfile,\%done,$rpms,$fentry->[1],$_);
2068                        }
2069                    }
2070                }else{
2071                    if ($opt->{regexp}) { 
2072                        $name =~ s/\+/\\+/g;
2073                        @toadd = grep { /$name/ } @$rpms;
2074                        foreach (@toadd){
2075                            $_ or print LOG "ERROR buildList: empty rpm\n" and next;
2076                            $group->{size}{$_}{$listnumber} or next;
2077                            if ($opt->{done}){
2078                                $rpmfile{$listnumber}{$_} = $fentry->[1];       
2079                                my ($pkgname) = /^(.*)-[^-]+-[^-]+\.[^.]*$/;
2080                                $done{$pkgname} = [ $_, $group->{size}{$_}{$listnumber}[2], $opt, $listnumber];
2081                                $VERBOSE and print LOG "ADDED $_ (list $listnumber)\n"
2082                            } else {
2083                                $group->{brokendeps}{$_} == 2 and next;
2084                                $group->{brokendeps}{$_} == 3 and next;
2085                                $opt->{exclude} and print LOG "buildList: excluding $_\n" and $group->{brokendeps}{$_} = 3 and next;
2086                                defined $opt->{rate} and $group->{pkgrate}{$_} = $opt->{rate} and print LOG "buildList: setting $_ rate to $opt->{rate}\n";
2087                                my ($pkgname) = /^(.*)-[^-]+-[^-]+\.[^.]*$/;
2088                                if ($done{$pkgname} && $done{$pkgname}->[3] == $listnumber){
2089                                    if (!$opt->{update} || !$done{$pkgname}[2]{done}){
2090                                        my $rep = $group->{size}{$_}{$listnumber}[2];
2091                                        if ($rep < $done{$pkgname}->[1]){
2092                                            delete $rpmfile{$listnumber}{$done{$pkgname}->[0]};
2093                                            $VERBOSE and print LOG "REPLACING $done{$pkgname}->[0] with $_ (list $listnumber)\n";
2094                                            $rpmfile{$listnumber}{$_} = $fentry->[1];   
2095                                            $done{$pkgname} = [ $_, $rep, $opt, $listnumber ]
2096                                        }
2097                                    }
2098                                }else{
2099                                    $rpmfile{$listnumber}{$_} = $fentry->[1];   
2100                                    $done{$pkgname} = [ $_, $group->{size}{$_}{$listnumber}[2], $opt, $listnumber ];
2101                                    $VERBOSE and print LOG "ADDED $_ (list $listnumber)\n"
2102                                }
2103                            }
2104                        }
2105                    }
2106                    else { 
2107                        addRPMToList($group,$listnumber,\%rpmfile,\%done,$rpms,$fentry->[1],$name)
2108                    }
2109                }
2110            }
2111        }else{
2112            print LOG "WARNING: List $listnumber is empty, ignoring\n"; 
2113            $config[1][$listnumber][2]{empty} = 1;
2114        }
2115    }
2116    if (!$NODEPS && !$group->{options}{nodeps}){
2117        my @toadd = grep { /^basesystem-[^-]+-[^-]+\.[^.]*$/ } @fullrpm; 
2118        my $rep;
2119        my $pkg;
2120        my $listnumber;
2121        foreach (@toadd){
2122            # FIXME need to select default list in a better way
2123            my $l;
2124            foreach $l (keys %{$group->{size}{$_}}){
2125                if ($l == $listnumber && $group->{size}{$_}{$listnumber}[2] < $rep || !$rep){
2126                    $rep = $group->{size}{$_}{$listnumber}[2];
2127                    $pkg = $_;
2128                    $listnumber = $l
2129                }
2130            }
2131            $listnumber or $listnumber = $l
2132        }
2133        if ($pkg){
2134            $rpmfile{$listnumber}{$pkg} = {};
2135            print LOG "B ADDED $pkg \n"
2136        }else { print LOG "ERROR: basesystem package is not available.\n"}
2137
2138        # add deps
2139        closeRpmsList($group,\%rpmfile)
2140    }
2141    \%rpmfile
2142}
2143
2144sub optimizeSpace{
2145    my ($groups,$log,$diff,$size,$cdsize,$cdnum,$gain,$grp,$cdlists,$list) = @_;
2146    my $maxSpace;
2147    for(my $i; $i < @$cdsize; $i++){
2148        $cdlists->{$i} or next;
2149        $maxSpace += $cdsize->[$i] - $size->[$i]       
2150    }
2151    if ($maxSpace < $gain) { print LOG "Could not get $gain on disc $cdnum\n"; return 0}
2152    else { print LOG "$maxSpace available, try to move packages to get $gain free space on disc $cdnum\n"}
2153    if ($list){
2154        my %cd;
2155        my $space;
2156        my $group = $groups->[$grp];
2157        my @cd;
2158        for (my $j; $j < @{$group->{sourcerep}{$list}}; $j++){
2159            my $cd = $group->{list}{$list}[$j][0];
2160            $cd{$cd} = 1;
2161            $space += $cdsize->[$cd] - $size->[$cd]
2162        }
2163        my $ok;
2164        for (my $j; $j < @{$group->{list}{$list}}; $j++){
2165            my $cd = $group->{list}{$list}[$j][0];
2166            $space += $cdsize->[$cd] - $size->[$cd];
2167            if ($cd{$cd}){
2168                $ok = 1;
2169                push @cd, $cd
2170            }
2171        }
2172        if ($ok && $space >= $gain){
2173            print LOG "optimizeSpace: trying to gain $gain within group\n";     
2174            foreach (@cd){
2175
2176            }
2177        }
2178    }
2179    0
2180}
2181
2182sub addRPMToDiff{
2183    my ($rpm,$srpm,$rpmd,$diff,$cdnum,$repnumber, $i, $list, $curdir, $size, $rpmsize,$totrpmsize,$j, $done) = @_;
2184    my @interdeps;
2185    for (my $s; $s < @$rpm; $s++){
2186        push @{$diff->[$cdnum][$i][$list][$j][0]}, [$rpm->[$s],1,$rpmd->[$s],$curdir,$rpmsize->[$s]];
2187        my $id = @{$diff->[$cdnum][$i][$list][$j][0]};
2188        print LOG "addRPMToDiff: $rpm->[$s] DONE on CD $repnumber\n";
2189        $done->{$rpm->[$s]} = $repnumber;
2190        $done->{$srpm->[$s]}++;
2191        $interdeps[$s][0] = $id-1;
2192        $interdeps[$s][1] = [$cdnum, $i, $list, $curdir, $id];
2193    }
2194    if (@$rpm > 1){ 
2195        for (my $s; $s < @$rpmd; $s++){
2196            my $id = $interdeps[$s][0]; 
2197            foreach (my $t; $t < @interdeps; $t++){
2198                $t == $s and next;
2199                push @{$diff->[$cdnum][$i][$list][$j][0][$id][6]}, $interdeps[$t][1]
2200            }
2201        }
2202    }
2203    $size->[$cdnum] += $totrpmsize;
2204    $VERBOSE and print LOG "addRPMToDiff: SIZE disc $cdnum: $size->[$cdnum] (+ @$rpm $totrpmsize)\n";
2205    1
2206}
2207
2208# TODO the algo is not as beautiful as it should be
2209
2210sub buildDiscs{
2211    my ($groups,$buildlist,$rpmlist,$log,$groupok,$size,$cdsize,$cdlists,$cds) = @_;
2212    my @diff;
2213    for(my $i; $i < @$size; $i++){
2214        if ($size->[$i] > $cdsize->[$i]) { 
2215            my $gain = $size->[$i] - $cdsize->[$i];
2216            optimizeSpace($groups,$log,\@diff,$size,$cdsize,$gain,$i,$cdlists)
2217        }
2218    }
2219    my $ok;
2220    my @groupok = map 0, @$groups;
2221    my @tobedone;
2222    my @rejected;
2223    my @needed;
2224    my $iti;
2225    while (!$ok){
2226        $VERBOSE and print LOG "iti: ",$iti++,"\n";
2227        $ok = 1;
2228        for (my $i; $i < @$groups; $i++){
2229            $groupok[$i] and next;
2230            my $group = $groups->[$i];
2231            my $done = $group->{done};
2232            my $dn;
2233            while (!$dn){
2234                $groupok[$i] = 1;
2235                foreach my $list (keys %{$group->{list}}){
2236                    $config[1][$list][2]{cdcom} and next;
2237                    $config[1][$list][2]{done} and next;
2238                    $config[1][$list][2]{empty} and next;
2239                    my $next;
2240                    foreach (@{$needed[$i]{$list}}){
2241                        $VERBOSE and print LOG "List $list need list $_->[0] to be <= $_->[1] (",int @{$buildlist->[$i]{$_->[0]}},")\n";
2242                        int @{$buildlist->[$i]{$_->[0]}} <= $_->[1] or $next = 1
2243                    }
2244                    $next and print LOG "LIST $list waiting\n" and next;
2245                    $needed[$i]{$list} = [];
2246                    my $trpmd;
2247                    my $k;
2248                    my $goon;
2249                    my @rpmd;
2250                    do { 
2251                        $trpmd = pop @{$buildlist->[$i]{$list}} or next;
2252                        if (ref $trpmd->[0]){
2253                            foreach (@$trpmd){
2254                                !$done->{$_->[0]} and push @rpmd, $_
2255                            }
2256                        } else { !$done->{$trpmd->[0]} and push @rpmd, $trpmd}
2257                    } until (@rpmd);
2258                    $groupok[$i] = 0;
2259                    $ok = 0;
2260                    my @rpm;
2261                    my $rpmsize;
2262                    my @rpmsize;
2263                    foreach (@rpmd){
2264                        my $r = $_->[0];
2265                        !$r and print LOG "ERROR empty package @$_\n";
2266                        push @rpm, $r;
2267                        $VERBOSE and print LOG "RPM $r (group $i list $list -- ",int @{$group->{list}{$list}},")\n";
2268                        $tobedone[$i]{$r} = 1;
2269                        $rpmsize += $group->{size}{$r}{$list}[0];
2270                        push @rpmsize, $group->{size}{$r}{$list}[0]
2271                    }
2272                    my $loop;
2273                    my $dn2;
2274                    for (my $j; !$loop && !$dn2 && $j < @{$group->{list}{$list}}; $j++){
2275                        $loop = 0;
2276                        my $curdir = $group->{list}{$list}[$j];
2277                        $config[1][$list][3]{$curdir->[0]}{$curdir->[1]}{done} and next;
2278                        my $cdnum = $curdir->[0];
2279                        my $repname = $curdir->[1];
2280                        $cdlists->{$cdnum} > 1 or next;
2281                        if ($size->[$cdnum] + $rpmsize > $cdsize->[$cdnum]) {
2282                            if ($j == @{$group->{list}{$list}}-1) {
2283                                if (!optimizeSpace($groups,$log,\@diff,$size,$cdsize,$cdnum,$rpmsize,$i,$cdlists,$list)){
2284                                    if ($config[1][$list][2]{auto}){
2285                                        my $ncd;
2286                                        foreach (keys %{$cdlists}){
2287                                            $ncd = $_ + 1 if $ncd <= $_
2288                                        }
2289                                        print LOG "autoMode: $config[1][$list][2]{cd} -- $ncd\n";
2290                                        if (!$config[1][$list][2]{cd} || ($config[1][$list][2]{cd} >= $ncd)){
2291                                            print LOG "buildDiscs: adding new disc $ncd\n";
2292                                            $config[2][$ncd][0] = [$DISCSIZE,"$config[0][0]-disc$ncd",$ncd,"MandrakeLinux $config[0][0]"];
2293                                            $cdsize->[$ncd] = $DISCSIZE;
2294                                            &{$functions{dir}[0][5]}($ncd,1,"rpms","Mandrake/RPMS$ncd");
2295                                            &{$functions{generic}[0][5]}($ncd,2,"rpms",1);
2296                                            $group->{orderedrep}{"$ncd/rpms"} = $ncd;
2297                                            #
2298                                            # generic has no FIXED part, otherwize a call to generic with fixed=0
2299                                            # had beed needed
2300                                            #
2301                                            my $f = "$TMP/build/$config[0][0]/$ncd.list";
2302                                            -f $f and unlink $f;
2303                                            $curdir = [$ncd, "rpms"];
2304                                            push @{$group->{list}{$list}}, $curdir;
2305                                            my $instcd = $group->{installDisc};
2306                                            push @{$config[2][$instcd][2]{installation}[2]{rpmsdir}}, [$ncd,"rpms"];
2307                                            $cdlists->{$ncd} = 2;
2308                                            push @{$cds}, $ncd;
2309                                            $cdnum = $ncd
2310                                        } else {
2311                                            $VERBOSE and print LOG "Could not add more disc, rejecting @rpm\n";
2312                                            @{$rejected[$i]}{@rpm} = map 1, @rpm and next
2313                                        }
2314                                    }else {
2315                                        $VERBOSE and print LOG "Rejecting $@rpm\n";
2316                                        @{$rejected[$i]}{@rpm} = map 1, @rpm and next
2317                                    }
2318                                }
2319                            }else { next }
2320                        }
2321                        if (!$NODEPS && !$group->{options}{nodeps}) {
2322                            my @tdeps;
2323                            my %curID;
2324                            foreach (@rpmd){
2325                                my $rpm = $_->[0];
2326                                $curID{$group->{params}{info}{$rpm}{id}} = 1;
2327                                $_->[1]{nodeps} and next;
2328                                $group->{pkgdeps}{$rpm} and push @tdeps, @{$group->{pkgdeps}{$rpm}}
2329                            }
2330                            my @deps;
2331                            my %depsdone;
2332                            foreach (@tdeps){
2333                                if (ref){
2334                                    my @toadd;
2335                                    my $key = join '|',@$_;
2336                                    $depsdone{$key}++ and next;
2337                                    foreach my $d (@$_){
2338                                        if ($curID{$d}){ @toadd = (); last }
2339                                        push @toadd, $d
2340                                    }
2341                                    @toadd and push @deps, \@toadd
2342                                }elsif(!$curID{$_}){
2343                                    $depsdone{$_}++ and next;
2344                                    push @deps, $_
2345                                }
2346                            }
2347                            if (@deps){
2348                                my %topush;
2349                                my $depsdisc;
2350                                foreach (@deps){
2351                                    if (!ref){
2352                                        # FIXME default to random list if $l != $list
2353                                        my $r = $group->{depslistid}[$_]; 
2354                                        my $l;
2355                                        foreach (keys %{$group->{size}{$r}}){
2356                                            $l = $_;
2357                                            last if $_ == $list
2358                                        }
2359                                        if (!$l){
2360                                            print LOG "ERROR buildDisc: $r not in a list\n";
2361                                            $loop = 1 and last
2362                                        }
2363                                        $rejected[$i]{$r} and $loop = 1 and last;
2364                                        my $tcd = $done->{$r};
2365                                        if ($tcd){
2366                                            if ($tcd > $depsdisc) { $depsdisc = $tcd};
2367                                            $VERBOSE and print LOG "$r on rep $tcd ($depsdisc)\n";
2368                                            next
2369                                        }
2370                                        if ($tobedone[$i]{$r}){
2371                                            if ($l == $list){
2372                                                print LOG "$r tobedone\n";
2373                                                push @rpmd, [$r, $rpmlist->[$i]{$l}{$r}];
2374                                                push @{$topush{$l}}, \@rpmd; 
2375                                                $VERBOSE and print LOG "DEPS adding $r ($_ -- $l) with @rpm\n"
2376                                            }else{
2377                                                print LOG "buildDiscs: ERROR: loop in dependencies between list $l and $list, ignoring\n";
2378                                                push @{$topush{$l}}, [$r, $rpmlist->[$i]{$l}{$r}]; 
2379                                                $VERBOSE and print LOG "DEPS $r ($_ -- $l)\n"
2380                                            }
2381                                        }else{
2382                                            push @{$topush{$l}}, [$r, $rpmlist->[$i]{$l}{$r}]; 
2383                                            $VERBOSE and print LOG "DEPS $r ($_ -- $l)\n"
2384                                        }
2385                                    }else{
2386                                        # must create a virtual package that install all of them in one loop
2387                                        my $score;
2388                                        my $r;
2389                                        foreach (@$_){
2390                                            # FIXME it may have a problem here, as depslistid are not erased when the
2391                                            # package is removed, that is to say that if the previous deps failed for
2392                                            # any reason, alternates deps may be added, although excluded before
2393                                            # however this _must_ not happen, and signify a bug somewhere else.
2394                                            my $pkg = $group->{depslistid}[$_];
2395                                            $rejected[$i]{$pkg} and next;
2396                                            my $tcd = $done->{$pkg};
2397                                            if ($done->{$pkg} && $tcd <= $group->{orderedrep}{"$cdnum/$repname"}){
2398                                                print LOG "$pkg ($tcd) done";
2399                                                $r = 0;
2400                                                last
2401                                            } 
2402                                            my $s = $group->{scorelist}{$pkg};
2403                                            if ($s > $score && !$tcd){
2404                                                $score = $s;
2405                                                $r = $pkg;
2406                                            }
2407                                        }
2408                                        if ($r){
2409                                            # FIXME default to random list if $l != $list
2410                                            my $l;
2411                                            foreach (keys %{$group->{size}{$r}}){
2412                                                $l = $_;
2413                                                last if $_ == $list
2414                                            }
2415                                            if ($l){
2416                                                if ($tobedone[$i]{$r}){
2417                                                    if ($l == $list){
2418                                                        push @rpmd, [$r, $rpmlist->[$i]{$l}{$r}];
2419                                                        push @{$topush{$l}}, \@rpmd; 
2420                                                        $VERBOSE and print LOG "DEPS adding $r ($_ -- $l) with @rpm\n"
2421                                                    }else{
2422                                                        print LOG "buildDiscs: ERROR: loop in dependencies between list $l and $list, ignoring\n";
2423                                                        push @{$topush{$l}}, [$r, $rpmlist->[$i]{$l}{$r}];
2424                                                        $VERBOSE and print LOG "DEPS $r ($_ -- $l)\n"
2425                                                    }
2426                                                }else{
2427                                                    push @{$topush{$l}}, [$r, $rpmlist->[$i]{$l}{$r}];
2428                                                    $VERBOSE and print LOG "DEPS $r ($_ -- $l)\n"
2429                                                }
2430                                            }else{ 
2431                                                print LOG "ERROR buildDisc: $r not in a list\n";
2432                                                $loop = 1 and last
2433                                            }
2434                                        }else{
2435                                            $VERBOSE and print LOG "Finding better alternatives rep (@$_ - $depsdisc)\n";
2436                                            my $bestdisc = (keys %{$group->{orderedrep}});
2437                                            if ($bestdisc >= $depsdisc){
2438                                                foreach (@$_){
2439                                                    my $pkg = $group->{depslistid}[$_];
2440                                                    $rejected[$i]{$pkg} and print LOG "rejected\n" and next;
2441                                                    my $tcd = $done->{$pkg} or next; 
2442                                                    $VERBOSE and print LOG "$pkg => rep $tcd\n";
2443                                                    if ($tcd < $bestdisc) { $bestdisc = $tcd}
2444                                                }
2445                                                $bestdisc > $depsdisc and $depsdisc = $bestdisc
2446                                            }
2447                                            $VERBOSE and print LOG "Finding better alternatives rep result $depsdisc\n";
2448                                        }
2449                                    }
2450                                }
2451                                if (keys %topush){
2452                                    $VERBOSE and print LOG "Adding dependencies, looping\n";
2453                                    $loop = 1;
2454                                    my $test = @rpmd > 1 ? \@rpmd : $rpmd[0];
2455                                    push @{$buildlist->[$i]{$list}}, @rpmd > 1 ? \@rpmd : $rpmd[0];
2456                                    foreach (keys %topush){
2457                                        print LOG "buildDisc: topush $needed[$i]{$list} -- $i -- $_ -- $buildlist->[$i]{$_}\n";
2458                                        $list != $_ and push @{$needed[$i]{$list}}, [ $_, int @{$buildlist->[$i]{$_}} ];
2459                                        push @{$buildlist->[$i]{$_}}, @{$topush{$_}}
2460                                    }
2461                                }elsif ($j < $depsdisc - 1) {
2462                                    $VERBOSE and print LOG "Dependencies on later directories ($depsdisc)\n";
2463                                    next
2464                                }
2465                            }
2466                        }
2467                        $loop and next; 
2468                        print LOG "@rpm deps ok\n";
2469                        my $nosrc = 1;
2470                        my @srpm;
2471                        my $donesrpm = 1;
2472                        if (!$group->{options}{nosources} && @{$group->{sourcerep}{$list}}){
2473                            for (my $s; $s < @rpmd; $s++){
2474                                my $srpm = $group->{params}{info}{$rpm[$s]}{sourcerpm}; 
2475                                $srpm =~ s/\.rpm$//;
2476                                if (!$group->{size}{$srpm}{$list}) {
2477                                    print LOG "buildDiscs: ERROR: $srpm not available, trying alternatives => ";
2478                                    my ($srpmname) = $srpm =~ /(.*)-[^-]+-[^-]+\.src/;
2479                                    $srpm = $group->{srpmname}{$srpmname};
2480                                    if ($srpm) { print LOG " $srpm\n"} else { print LOG "not found\n"}
2481                                }
2482                                $done->{$srpm} or $donesrpm = 0;
2483                                $srpm[$s] = $srpm;
2484                                $rpmd[$s][1]{nosrc} or $nosrc = 0;
2485                            }
2486                        }
2487                        $VERBOSE and print LOG "buildDiscs: list $list: @rpm (@srpm) -- $curdir->[0] -- $curdir->[1] -- disc $cdnum\n";
2488                        if ($group->{options}{nosources} || !@{$group->{sourcerep}{$list}} || $nosrc || $donesrpm) {
2489                            $dn2 = addRPMToDiff(\@rpm, \@srpm, \@rpmd,\@diff,$cdnum, $group->{orderedrep}{"$cdnum/$repname"}, $i, $list, $curdir, $size,\@rpmsize,$rpmsize,$j,$done)
2490                        }else{
2491                            my %srpmrep;   
2492                            my $srpmok = 1;
2493                            my @srpmsize;
2494                            for (my $s; $s < @srpm; $s++){
2495                                $done->{$srpm[$s]} and next;
2496                                $rpmd[$s][1]{nosrc} and next;
2497                                my $srpmsize = $group->{size}{$srpm[$s]}{$list}[0];
2498                                $srpmsize[$s] = $srpmsize;
2499                                for (my $k; !$dn2 && $k < @{$group->{sourcerep}{$list}}; $k++){
2500                                    my $srpmdir = $group->{sourcerep}{$list}[$k];
2501                                    my $srccd = $srpmdir->[0];
2502                                    $VERBOSE and print LOG "trying source disc $srccd\n";
2503                                    $cdlists->{$srccd} > 1 or next;
2504                                    my $currentrpm;
2505                                    $cdnum == $srccd and $currentrpm = $rpmsize;
2506                                    if ($size->[$srccd] + $srpmsize + $currentrpm <= $cdsize->[$srccd]){
2507                                        $srpmrep{$srpm[$s]} = [$srccd,$k,$srpmdir];
2508                                        last
2509                                    }
2510                                }
2511                                if (!$srpmrep{$srpm[$s]}){
2512                                    $srpmok = 0
2513                                }
2514                            }
2515                            if ($srpmok){
2516                                my @interdeps;
2517                                for (my $s; $s < @rpm; $s++){
2518                                    if (!$rpmd[$s][1]{nosrc} && !$done->{$srpm[$s]}){
2519                                        my $srpmrep = $srpmrep{$srpm[$s]};
2520                                        push @{$diff[$cdnum][$i][$list][$j][0]}, [$rpm[$s],1,$rpmd[$s],$curdir,$rpmsize];
2521                                        push @{$diff[$srpmrep->[0]][$i][$list][$srpmrep->[1]][1]}, [$srpm[$s],1,$rpmd[$s],$srpmrep->[2],$srpmsize[$s]];
2522                                        my $idx = @{$diff[$cdnum][$i][$list][$j][0]};
2523                                        my $sidx = @{$diff[$srpmrep->[0]][$i][$list][$srpmrep->[1]][1]};
2524
2525                                        $interdeps[$s][0] = $idx-1;
2526                                        my $rdeps = [$cdnum,$i, $list, $j,$idx-1];
2527                                        $interdeps[$s][1] = $rdeps;
2528                                        $diff[$cdnum][$i][$list][$j][0][$idx-1][5] = [$srpmrep->[0], $i, $list, $srpmrep->[1], $sidx-1];
2529                                        $diff[$srpmrep->[0]][$i][$list][$srpmrep->[1]][1][$sidx-1][5] = $rdeps;
2530                                        $size->[$srpmrep->[0]] += $srpmsize[$s];
2531                                        $VERBOSE and print LOG "SIZE disc $srpmrep->[0]: $size->[$srpmrep->[0]] (+ $srpm[$s] $srpmsize[$s])\n";
2532                                    }else{
2533                                        push @{$diff[$cdnum][$i][$list][$j][0]}, [$rpm[$s],1,$rpmd[$s],$curdir,$rpmsize];
2534                                        my $idx = @{$diff[$cdnum][$i][$list][$j][0]};
2535                                        $interdeps[$s][0] = $idx-1;
2536                                        $interdeps[$s][1] = [$cdnum,$i, $list, $j,$idx-1];
2537                                    }
2538                                    $done->{$rpm[$s]} = $group->{orderedrep}{"$cdnum/$repname"};
2539                                    $done->{$srpm[$s]}++;
2540                                }
2541                                if (@rpm > 1) {
2542                                    for (my $s; $s < @rpmd; $s++){
2543                                        my $id = $interdeps[$s][0]; 
2544                                        foreach (my $t; $t < @interdeps; $t++){
2545                                            $t == $s and next;
2546                                            push @{$diff[$cdnum][$i][$list][$j][0][$id][6]}, $interdeps[$t][1]
2547                                        }
2548                                    }
2549                                }
2550
2551                                $dn2 = 1;
2552                                $size->[$cdnum] += $rpmsize;
2553                                $VERBOSE and print LOG "SIZE disc $cdnum: $size->[$cdnum] (+ @rpm $rpmsize)\n";
2554                            }else{
2555                                print LOG "WARNING: @srpm does not fit on the discs\n"
2556                            }
2557                            if (!$dn2 && ($NOSRCFIT || $group->{options}{nosrcfit})){
2558                                $dn2 = addRPMToDiff(\@rpm, \@srpm, \@rpmd,\@diff,$cdnum, $group->{orderedrep}{"$cdnum/$repname"}, $i, $list, $curdir, $size,\@rpmsize,$rpmsize,$j,$done)
2559                            }
2560                            if (!$dn2) {
2561                                @{$rejected[$i]}{@rpm} = map 1, @rpm;
2562                                print LOG "WARNING: @rpm does not fit on the disc ($size->[$cdnum] + $rpmsize > $cdsize->[$cdnum]) \n"
2563                            }
2564                        }
2565                    }
2566                    $dn2 and $dn = 1;
2567                }
2568                $groupok[$i] and $dn = 1
2569            }
2570        }
2571    }
2572    my $rejected;
2573    $VERBOSE and print LOG "buildDiscs: rejected packages\n";
2574    for(my $i; $i < @rejected; $i++){
2575        $rejected[$i] or next;
2576        print LOG "groups $i\n";
2577        $rejected=1;
2578        foreach (keys %{$rejected[$i]}){
2579            print LOG "$_\n"
2580        }
2581    }
2582    (\@diff,$rejected);
2583}
2584
2585sub checkSize{
2586    my ($n,$size,$cdsize,$rejected) = @_;
2587    my $ok;
2588    for (my $i; $i < @$size; $i++) {
2589        $size->[$i] or next;
2590        my $origcdsize = $config[2][$i][0][0];
2591        if ($size->[$i] > $cdsize) {
2592            my $d = ($size->[$i] - $cdsize->[$i]);
2593            if ($d > 0) { 
2594                $ok = 0;
2595                $cdsize->[$i] -= $d;
2596                print LOG "ERROR: disc $i is too big ($size->[$i] > $cdsize (new disc size $cdsize->[$i])\n" }
2597            }elsif ($rejected){
2598                my $d = ($cdsize->[$i] - $size->[$i]);
2599                if ($d > $origcdsize/1000) { 
2600                    $ok = 0;
2601                    $cdsize->[$i] += $d;
2602                    print LOG "ERROR: disc $i is too small ($size->[$i] < $cdsize (new disc size $cdsize->[$i])\n" }
2603            }
2604        }
2605        return $ok
2606}
2607
2608sub makeDiscs {
2609    my ($fixed, $lists, $cds, $size, $mkisos, $discsFile, $cdfile) = @_;
2610    my $dir;
2611    if (!$NOLIVE){
2612        $dir = "$topdir/build/$config[0][0]";
2613        -d "$dir" or mkpath "$dir";
2614    }else{
2615        $dir = "$TMP/build/$config[0][0]";
2616        -d "$dir" or mkpath "$dir";
2617    }
2618    print LOG "makeDiscs: Discs @$cds TOPDIR $dir\n";
2619    foreach my $i (@$cds){
2620        $lists->{$i} > 1 or next;
2621        my $cd = $config[2][$i];
2622        if (!$fixed){
2623            print LOG "Fixed part of disc $i\n";
2624            if ($NOLIVE){
2625                print LOG "generic: removing $dir/$i.list\n";
2626                -f "$dir/$i.list" and unlink "$dir/$i.list";
2627            }else{
2628                rmtree "$topdir/build/$config[0][0]/$i";
2629                rmtree "$topdir/build/$config[0][0]/first/$i"
2630            }
2631        }else {print LOG "Finalizing disc $i\n"}
2632        my $sz;
2633        for (my $j; $j < @{$cd->[3]}; $j++){
2634            my $name = $cd->[3][$j][0];
2635            print LOG "makeDiscs: $name ($fixed)\n";
2636            if (defined $::{$name}) { $sz += &{$::{$name}}($cd->[3][$j],$dir,$fixed,$NOLIVE,$i,$cd,$cdfile,$lists,$mkisos,$discsFile)}
2637            else {print LOG "ERROR: unrecognized function name $name\n"}
2638            print LOG "SIZE ($name) $sz\n";
2639        }
2640        if ($NOLIVE){
2641            print LOG "SIZE $size->[$i] + $sz\n";
2642            $size->[$i] += $sz
2643        }else{
2644            $size->[$i] = du("$dir/$i") + $sz
2645        }
2646        print LOG "disc $i ($dir/$i) size: $size->[$i] ($sz)\n";
2647        if ($fixed) {
2648            my $isodir = $ISODIR ? $ISODIR : "$topdir/iso/$config[0][0]";
2649            if ($NOLIVE){
2650                $mkisos->[$i] = "mkisofs $MKISOOPT -graft-points " . (-f "$dir/$i.list" ? " -path-list $dir/$i.list " : "") . " -V $cd->[0][1] -o $isodir/$i-$config[0][0].iso $mkisos->[$i]"
2651            }else{
2652                if ($mkisos->[$i]) { $mkisos->[$i] = "mkisofs $MKISOOPT -V $cd->[0][1] -o $isodir/$i-$config[0][0].iso $mkisos->[$i]"}
2653                else { $mkisos->[$i] = qq{mkisofs $MKISOOPT -V $cd->[0][1] -o "$isodir/$i-$config[0][0]".iso "$dir/$i"}}
2654            }
2655        }
2656    }
2657    !$fixed and return 1;
2658    if (!$NOISO){
2659        -d "$topdir/iso/$config[0][0]" or mkpath "$topdir/iso/$config[0][0]"; 
2660        foreach my $i (@$cds){
2661            $lists->{$i} > 1 or next;
2662            print LOG "MKISOFS disc $i $mkisos->[$i]\n";
2663            my $err = system $mkisos->[$i];
2664            $err or print LOG "ERROR: disc $i $mkisos->[$i] failed ($!)\n";
2665            $size->[$i] = du("$topdir/iso/$config[0][0]/$i-$config[0][0].iso")
2666        }
2667    }
2668    1
2669}
2670
2671sub template {
2672    my ($dir,$fixed,$nolive,$cdnum,$cd,$cdfile,$list,$mkisos) = @_;
2673    if (!$fixed){
2674        my $size;
2675        if ($nolive){
2676            return $size
2677        }else {
2678        }
2679    }elsif ($fixed == 1){
2680        my $mkiso;
2681        if ($nolive){
2682        }else {
2683        }
2684    }elsif ($fixed == 2){
2685        my $mkiso;
2686        if ($nolive){
2687        }else {
2688        }
2689    }
2690}
2691
2692sub cp {
2693    my ($fct,$dir,$fixed,$nolive,$cdnum,$cd,$cdfile,$list,$mkisos) = @_;
2694    if (!$fixed){
2695        my $size;
2696        my $source = $fct->[1]{src};
2697        my $dest = $fct->[1]{dest};
2698        if ($nolive){
2699            $size += du($source);
2700            print LOG "cp: copying $source => $dest (size $size)\n";
2701            $mkisos->[$cdnum] .= " /$dest=$source";
2702            return $size
2703        }else {
2704            cpal($source, "$dir/$cdnum/$dest");
2705            return
2706        }
2707    }
2708}
2709sub cdcom {
2710    my ($fct,$dir,$fixed,$nolive,$cdnum,$cd,$cdfile,$list,$mkisos) = @_;
2711    if (!$fixed){
2712        my $size;
2713        my $source = $fct->[1]{source};
2714        my $dest = $config[2][$cdnum][2]{dir}{$fct->[1]{dir}};
2715        my $destination = $fct->[1]{dest};
2716        if ($nolive){
2717            my $path = "$dir/$cdnum/$dest";
2718            -d $path or mkpath "$path";
2719            local *A; opendir A, "$source";
2720            $VERBOSE and print LOG "cdcom: $source\n";
2721            foreach (readdir A){
2722                /^\.{1,2}$/ and next;
2723                if (! /^Mandrake$/){
2724                    $size += du("$source/$fct");
2725                    print LOG "cdcom: adding $_ (size $size)\n";
2726                    $mkisos->[$cdnum] .= " /$destination/$_/=$source/$fct"
2727                }else {
2728                    $mkisos->[$cdnum] .= " /$dest/=$source/Mandrake/RPMS/"
2729                }
2730            }
2731            local *A; opendir A, "$source/Mandrake/RPMS";
2732            foreach (readdir A){
2733                /^\.{1,2}$/ and next;
2734                my $newdest = readlink "$source/Mandrake/RPMS/$_";
2735                $newdest =~ s,((?:../))*(.*),$1/$destination/$2,;
2736                print LOG "cdcom: creating symlink $dest/$_ => $newdest\n";
2737                my $err = symlink $newdest, "$dir/$cdnum/$dest/$_";
2738                !$err and print "ERROR: cdcom: $!\n" and next;
2739                $mkisos->[$cdnum] .= " /$dest/=$dir/$cdnum/$dest/$_"
2740            }
2741            my $err = symlink "$dest", "$dir/$cdnum/$destination/RPMS";                                           
2742            !$err and print "ERROR: cdcom: $!\n";
2743            $mkisos->[$cdnum] .= " /=$dir/$cdnum/RPMS";
2744            return $size
2745        }else {
2746            cpal($source, "$dir/$cdnum/$destination", "Mandrake/RPMS");
2747            local *A; opendir A, "$source/Mandrake/RPMS";
2748            foreach (readdir A){
2749                /^\.{1,2}$/ and next;
2750                my $newdest = readlink "$source/Mandrake/RPMS/$_";
2751                $newdest =~ s,((?:../)*)(.*),$1$destination/$2,;
2752                print LOG "cdcom: creating symlink $dest/$_ => $newdest\n";
2753                my $err = symlink $newdest, "$dir/$cdnum/$dest/$_";
2754                !$err and print "ERROR: cdcom: $!\n"
2755            }
2756            my $err = symlink "$dest", "$dir/$cdnum/$destination/RPMS";                                           
2757            !$err and print "ERROR: cdcom: $!\n";
2758            return
2759        }
2760    }
2761}
2762
2763sub advertising {
2764    my ($fct,$dir,$fixed,$nolive,$cdnum,$cd,$cdfile,$list,$mkisos) = @_;
2765    if (!$fixed){
2766        my $size;
2767        if ($nolive){
2768            print LOG "Getting advertising images size\n";
2769            my $addir = "Mandrake/share/advertising" . ($fct->[1]{lang} ? ".$fct->[1]{lang}" : "");
2770            my $rep = "$dir/$cdnum/$addir";
2771            -d "$rep" or mkpath "$rep";
2772            local *L; open L, ">$rep/list";
2773            foreach (@{$fct->[1]{img}}){
2774                my ($name) = /([^\/]*)$/;
2775                $size += du($_);
2776                print L "$name\n";
2777                $mkisos->[$cdnum] .= " $addir/$name=$_";
2778            }
2779            close L;
2780            $mkisos->[$cdnum] .= " $addir/list=$rep/list";
2781            $size += du("$rep/list");
2782            return $size
2783        }else {
2784            print LOG "Creating advertising images directory\n";
2785            my $rep = "$dir/$cdnum/Mandrake/share/advertising" . ($fct->[1]{lang} ? ".$fct->[1]{lang}" : "");
2786            -d "$rep" or mkpath "$rep";
2787            local *L; open L, ">$rep/list";
2788            foreach (@{$fct->[1]{img}}){
2789                my ($name) = /([^\/]*)$/;
2790                cpal($_,"$rep/$name");
2791                print L "$name\n"
2792            }
2793            close L;
2794            return
2795        }
2796    }
2797}
2798
2799sub dir {
2800    my ($fct,$dir,$fixed,$nolive,$cdnum,$cd) = @_;
2801    if (!$fixed){
2802        if ($nolive){
2803            return 0
2804        }else {
2805            my $reploc = "$dir/$cdnum/$fct->[1]{reploc}";
2806            print LOG "DIR: creating $reploc\n";
2807            -d $reploc or mkpath $reploc;
2808            return 0   
2809        }
2810    }
2811}
2812
2813sub genSynthesis{
2814    my ($hdlist,$synthesis) = @_;
2815    system("parsehdlist --compact --info --provides --requires $hdlist | gzip -9 > $synthesis");
2816}
2817
2818sub generic {
2819    my ($fct,$dir,$fixed,$nolive,$cdnum,$cd,$cdfile,$list,$mkisos,$discFiles) = @_;
2820    if ($fixed){
2821        my $rep = $fct->[1]{repname};
2822        print LOG "generic: rep $rep\n";
2823        my $reploc = "$dir/$cdnum/$cd->[2]{dir}{$rep}/";
2824        if ($nolive){
2825            my $size;
2826            my $mkiso;
2827            if ($fixed == 1){
2828                local *A; open A, ">>$dir/$cdnum.list";
2829                foreach my $src (keys %{$cdfile->[$cdnum]{$rep}}){
2830                    print LOG "generic: src $src\n";
2831                    foreach (@{$cdfile->[$cdnum]{$rep}{$src}}){
2832                        if ($_->[0] == 1){
2833                            print A "$cd->[2]{dir}{$rep}/$_->[1]=$src/$_->[1]\n";
2834                        }
2835                    }
2836                }
2837                close A
2838            }elsif ($fixed == 2){
2839                my %todo;
2840                foreach my $src (keys %{$cdfile->[$cdnum]{$rep}}){
2841                    print LOG "generic: src $src\n";
2842                    foreach (@{$cdfile->[$cdnum]{$rep}{$src}}){
2843                        if ($_->[0] == 1){
2844                            push @{$todo{add}} , "$cd->[2]{dir}{$rep}/$_->[1]=$src/$_->[1]"
2845                        }elsif ($_->[0] == 2){
2846                            $todo{del}{"$cd->[2]{dir}{$rep}/$_->[1]=$src/$_->[1]"} = 1
2847                        }
2848                    }
2849                }
2850                link "$dir/$cdnum.list", "$dir/$cdnum.list.tmp";
2851                unlink "$dir/$cdnum.list";
2852                local *A; open A, "$dir/$cdnum.list.tmp";
2853                local *B; open B, ">>$dir/$cdnum.list";
2854                while (<A>){
2855                    chomp;
2856                    if (!$todo{del}{$_}) { print B "$_\n"}
2857                }
2858                close A;
2859                foreach (@{$todo{add}}){
2860                    print B "$_\n"
2861                }
2862                close B
2863            }
2864            if ($fct->[1]{synthesis} || $fct->[1]{hdlist}){
2865                buildGenericHdlist($dir,$cdnum,$fct,$rep,$reploc,$discFiles->[$cdnum]{$rep});
2866                if ($fct->[1]{hdlist}){
2867                    $size += du ("$dir/$cdnum/$reploc/hdlist$cdnum$rep.cz");
2868                    $mkiso .= " Mandrake/base/hdlist$cdnum$rep.cz=$dir/$cdnum/$reploc/hdlist$cdnum$rep.cz";
2869                }
2870                if ($fct->[1]{synthesis}){
2871                    $size += du ("$dir/$cdnum/$reploc/synthesis.hdlist$cdnum$rep.cz");
2872                    $mkiso .= " $reploc/synthesis.hdlist$cdnum$rep.cz=$dir/$cdnum/$reploc/synthesis.hdlist$cdnum$rep.cz";
2873                }
2874            }
2875            $mkisos->[$cdnum] = $mkiso;
2876            return $size
2877        }else {
2878            foreach my $src (keys %{$cdfile->[$cdnum]{$rep}}){
2879                print LOG "generic: src $src\n";
2880                foreach (@{$cdfile->[$cdnum]{$rep}{$src}}){
2881                    if ($_->[0] == 1){
2882                        cpal("$src/$_->[1]",$reploc)   
2883                    }elsif ($_->[1] == 2){
2884                        unlink "$reploc/$_->[1]";
2885                    }
2886                }
2887            }
2888            if ($fct->[1]{synthesis} || $fct->[1]{hdlist}){
2889                buildGenericHdlist($dir,$cdnum,$fct,$rep,$reploc,$discFiles->[$cdnum]{$rep});
2890            }
2891            return 0
2892        }
2893    }
2894}
2895
2896sub printVERSION {
2897    my ($file, $tag) = @_;
2898    local *A; open A, ">$file";
2899    my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
2900    $year += 1900;
2901    printf A "Mandrake Linux $config[0][0] $tag %04d%02d%02d $hour:%02d\n", $year, $mon+1, $mday, $min;
2902}
2903
2904sub buildGenericHdlist{
2905    my ($dir,$cdnum,$fct,$rep,$reploc,$discFilescdrep,$hdlist) = @_;
2906    my $hdlist = $fct->[1]{hdlist} ? "$dir/$cdnum/$reploc/hdlist$cdnum$rep.cz" : "$TMP/$cdnum/$reploc/hdlist$cdnum$rep.cz";
2907    my $params = new rpmtools();
2908    $params->build_hdlist(1,9,"$TMP/.mkcd_build_hdlist",$hdlist, keys %{$discFilescdrep});
2909    if ($fct->[1]{synthesis}){
2910        genSynthesis($hdlist,"$dir/$cdnum/$reploc/synthesis.hdlist$cdnum$rep.cz")
2911    }
2912}
2913
2914sub buildInstallHdlist{
2915    my ($dir,$cdnum,$inst,$list,$discsFiles) = @_;
2916    my $params = new rpmtools();
2917    my @hdlist;
2918    my @rpm;
2919    -d "$dir/$cdnum/Mandrake/base/" or mkpath "$dir/$cdnum/Mandrake/base/";
2920    local *A; open A, ">$dir/$cdnum/Mandrake/base/hdlists";
2921    my %rpmdone;
2922    my $repnum = 1;
2923    foreach my $rd (@{$inst->[2]{rpmsdir}}){
2924        my ($cdrep,$repname,$opts) = @$rd;
2925        $list->{$cdrep} or print LOG "WARNING buildInstallHdlist: disc $cdrep not in list, ignoring\n" and next;
2926        my $realcd = $config[2][$cdrep][0][2];
2927        my $rpmdir = $config[2][$cdrep][2]{dir}{$repname};
2928        $rpmdir or print LOG "ERROR buildInstallHdlist: disc $cdrep: $repname not defined\n" and next;
2929        print LOG "BUILDING $cdrep -- $repname -- $rpmdir\n";
2930        if ($realcd){
2931            print A "hdlist$repnum.cz $rpmdir disc $realcd $config[2]->[$cdrep][0][3]\n";
2932        }else{
2933            print A "hdlist$repnum.cz $rpmdir $config[2]->[$cdrep][0][3]\n";
2934        }
2935        my $hdlist = "$dir/$cdnum/Mandrake/base/hdlist$repnum.cz";
2936        $hdlist[$repnum] = $hdlist;
2937        #
2938        # even for live sources rpm are taken, this may lead to errors in some special case, where
2939        # the sources change after the live is created, but this could help in combined live/nolive
2940        # situation
2941        #
2942        my $cdsfilesrpms = $discsFiles->[$cdrep]{$repname};
2943        if ($opts->{update}){
2944            print LOG "buildInstallHdlist: update mode for $cdrep/$repname\n";
2945            push @{$rpm[$repnum]}, map { /(.*)-[^-]+-[^-]+\.[^.]+$/; $rpmdone{$_} = 1; $rpmdone{$1} = 1;  "$cdsfilesrpms->{$_}/$_.rpm" } grep { /(.*)-[^-]+-[^-]+\.[^.]+$/; ! ($rpmdone{$_} || $rpmdone{$1}) } keys %{$cdsfilesrpms};
2946        } else {
2947            print LOG "buildInstallHdlist: normal mode for $cdrep/$repname\n";
2948            push @{$rpm[$repnum]}, map { /(.*)-[^-]+-[^-]+\.[^.]+$/; $rpmdone{$_} = 1; $rpmdone{$1} = 1;  "$cdsfilesrpms->{$_}/$_.rpm" } grep { /(.*)-[^-]+-[^-]+\.[^.]+$/; ! $rpmdone{$_} } keys %{$cdsfilesrpms};
2949        }
2950        print LOG "installation: $cdrep - $repname - @{$rpm[$repnum]}\n";
2951        $params->build_hdlist(1,9,"$TMP/.mkcd_build_hdlist",$hdlist,@{$rpm[$repnum]});
2952        $repnum++
2953    }
2954    foreach my $n (1 .. $repnum - 1){
2955        $params->read_hdlists($hdlist[$n]);
2956        $params->compute_depslist();
2957    }
2958
2959    my @unresolved = $params->get_unresolved_provides_files();
2960    if (@unresolved > 0) {
2961        $params->clean();
2962
2963        foreach my $n (1 .. $repnum - 1){
2964            $params->read_hdlists($hdlist[$n]);
2965        }
2966        $params->keep_only_cleaned_provides_files();
2967        foreach my $n (1 .. $repnum - 1){
2968            $params->read_hdlists($hdlist[$n]);
2969            $params->compute_depslist();
2970        }
2971    }
2972    close A;
2973    my $file = "$dir/$cdnum/Mandrake/base/depslist.ordered";
2974    print LOG "writing $file\n";
2975    open F, ">$file" or print LOG "ERROR: unable to write depslist file $file\n" and return;
2976    $params->write_depslist(\*F);
2977    close F;
2978    my $file = "$dir/$cdnum/Mandrake/base/provides";
2979    print LOG "writing $file\n";
2980    open F, ">$file" or die "unable to write provides file $file\n";
2981    $params->write_provides(\*F);
2982    close F;
2983    $file = "$dir/$cdnum/Mandrake/base/compss";
2984    print LOG "writing $file\n";
2985    open F, ">$file" or die "unable to write compss file $file";
2986    $params->write_compss(\*F);
2987    close F;
2988    my $path = "$dir/$cdnum/Mandrake/base";
2989    $params->read_depslist("$path/depslist.ordered");
2990    $params->read_provides_files("$path/provides");
2991    foreach my $n (1 .. $repnum - 1){
2992        $params->build_hdlist(1,9,"$TMP/.mkcd_build_hdlist","$path/hdlist$n.cz",@{$rpm[$n]});
2993        if ($inst->[1]{synthesis}){
2994            genSynthesis("$path/hdlist$n.cz","$path/synthesis.hdlist$n.cz")
2995
2996        }
2997    }
2998    return ($repnum,$path);
2999}
3000
3001sub isolinux {
3002    my ($fct,$dir,$fixed,$nolive,$cdnum,$cd,$cdfile,$list,$mkisos,$discsFiles) = @_;
3003    my $isolinux = $fct->[1]{isolinux};
3004    my $bootimg = $fct->[1]{bootimg} ? $fct->[1]{bootimg} : "isolinux.bin";
3005    if (!$fixed){
3006        my $size;
3007        if ($nolive){
3008            my $mkiso;
3009            $mkiso .= qq{ -b isolinux/$bootimg -c isolinux/boot.cat isolinux/=$isolinux/$bootimg -no-emul-boot -boot-load-size 4 -boot-info-table $mkisos->[$cdnum]};
3010            $size += du($isolinux);
3011            local *A; opendir A, $isolinux;
3012            foreach (readdir A){
3013                /~$/ and next;
3014                $size += du ("$isolinux/$_");
3015                if (-d "$isolinux/$_"){ $mkiso .= " /$_/=$isolinux/$_"; next }
3016                $mkiso .= " /=$isolinux/$_"
3017            }
3018            $mkisos->[$cdnum] = $mkiso;
3019        }else{
3020            my $isolinuxdest = "$dir/isolinux/$cdnum/isolinux/";
3021            rmtree $isolinuxdest;
3022            -d $isolinuxdest or mkpath $isolinuxdest;
3023            cpal("$isolinux/", $isolinuxdest);
3024            $size = du($isolinuxdest);
3025        }
3026        return $size
3027    }else{
3028        if (!$nolive){
3029            if ($bootimg){
3030                $mkisos->[$cdnum] = qq{ -b isolinux/$bootimg -c isolinux/boot.cat -no-emul-boot -boot-load-size 4 -boot-info-table "$topdir/build/$config[0][0]/isolinux/$cdnum" "$topdir/build/$config[0][0]/$cdnum"};
3031            }
3032        }
3033    }
3034
3035}
3036
3037sub boot {
3038    my ($fct,$dir,$fixed,$nolive,$cdnum,$cd,$cdfile,$list,$mkisos,$discsFiles) = @_;
3039    my $isolinux = $fct->[1]{isolinux};
3040    my $bootimg = $fct->[1]{bootimg};
3041    print LOG "Boot: $fixed nolive $nolive\n";
3042    if (!$fixed){
3043        my $size;
3044        if ($nolive){
3045            my $mkiso;
3046            if ($isolinux){
3047                my $dir = $isolinux->[0];
3048                my $img = $bootimg ? $bootimg->[0] : "isolinux/isolinux.bin"; 
3049                $mkiso .= qq{ -b $img -c $dir/boot.cat $dir/=$dir/$img -no-emul-boot -boot-load-size 4 -boot-info-table $mkisos->[$cdnum]};
3050            }elsif ($bootimg){
3051                my $img = $bootimg->[0];
3052                my $dir = $bootimg->[1]{dir};
3053                $img =~ s/(.*)\/([^\/]+)$/$2/;
3054                $dir or ($dir) = $1;
3055                $mkiso .= qq{ -b $dir/$img };
3056                if ((stat "$img")[7] > 3000000){ 
3057                    $mkiso .= qq{ -no-emul-boot}
3058                }
3059                $mkiso .= qq{ -c ${dir}boot.cat $dir/=$img }
3060            }
3061            foreach ($fct->[1]{files}){
3062                my ($files,$opt) = @$_;
3063                my $dest = $opt->{dest};
3064                $size += du ($files);
3065                my ($dirname) = $files =~ /([^\/]*)$/;
3066                if (-d "$files"){ $mkiso .= " /$dest/$dirname/=$files"; next }
3067                $mkiso .= " /$dest/=$files"
3068            }
3069            $mkisos->[$cdnum] = $mkiso;
3070        }else{
3071            print LOG "FILES $fct->[1]{files}\n";
3072            foreach (@{$fct->[1]{files}}){
3073                my ($files,$opt) = @$_;
3074                print LOG "boot: file $files\n";
3075                my $dest = "$topdir/build/$config[0][0]/" . ($opt->{first} ? "first/" : "") . "$cdnum/";
3076                -d $dest or mkpath $dest;
3077                my $odest = $opt->{dest};
3078                if ($odest){
3079                    $dest .= "/$odest";
3080                }else{
3081                    my ($dirname) = $files =~ /([^\/]*)$/;
3082                    $dest .= "/$dirname"
3083                }
3084                cpal($files,$dest,0,1);
3085            }
3086            $size = du("$dir/first/$cdnum/");
3087        }
3088        return $size
3089    }else{
3090        if (!$nolive){
3091            if ($isolinux){
3092                my $dir = $isolinux->[0];
3093                my $img = $bootimg ? $bootimg->[0] : "isolinux/isolinux.bin"; 
3094                $mkisos->[$cdnum] .= qq{ -b $img -c $dir/boot.cat -no-emul-boot -boot-load-size 4 -boot-info-table "$topdir/build/$config[0][0]/first/$cdnum" "$topdir/build/$config[0][0]/$cdnum"};
3095            }elsif ($bootimg){
3096                my $img = $bootimg->[0];
3097                my $sdir = $bootimg->[1]{dir};
3098                $img =~ s/(.*\/)([^\/]+)$/$2/;
3099                $sdir or ($sdir) = $1;
3100                print LOG "boot: boot image $sdir/$img\n";
3101                $mkisos->[$cdnum] .= qq{-b $sdir/$img};
3102                if ((stat "$img")[7] > 3000000){ 
3103                    $mkisos->[$cdnum] .= qq{ -no-emul-boot}
3104                }
3105                my $cdimages = "$dir/$cdnum/";
3106                my $Bootdir = "$dir/first/$cdnum/$sdir/";
3107                if (! -d $Bootdir ) { mkpath $Bootdir or die "cannot create $Bootdir\n" }
3108                my $err = link "$cdimages/$bootimg->[0]","$Bootdir/$img";
3109                if (!$err) { print LOG "Linking failed $cdimages/$bootimg->[0]: $!\n"};
3110               
3111                $mkisos->[$cdnum] .= qq{ -c $sdir/boot.cat "$dir/first/$cdnum" "$dir/$cdnum"};
3112                print LOG "BOOT $mkisos->[$cdnum]\n";
3113            }
3114        }
3115    }
3116}
3117
3118sub installation {
3119    my ($inst,$dir,$fixed,$nolive,$cdnum,$cd,$cdfile,$list,$mkisos,$discsFiles) = @_;
3120    my $install = $inst->[1]{install};
3121    if (!$fixed){
3122        $install or return;
3123        my $size;
3124        if ($nolive){
3125            my $mkiso;
3126
3127            local *A; opendir A, "$install";
3128            foreach (readdir A){
3129                /~$/ and next;
3130                /^(\.{1,2}|Mandrake|isolinux|images|VERSION)$/ and next;
3131                $size += du ("$install/$_");
3132                if (-d "$install/$_"){ $mkiso .= " /$_/=$install/$_"; next }
3133                $mkiso .= " /=$install/$_"
3134            }
3135
3136            local *A; opendir A, "$install/Mandrake";
3137            foreach (readdir A){
3138                print LOG "Mandrake -- $_\n";
3139                /~$/ and next;
3140                /(^(\.{1,2}|base)$|RPMS|share)/ and next;
3141                $size += du ("$install/Mandrake/$_");
3142                if (-d "$install/Mandrake/$_") { $mkiso .= " Mandrake/$_/=$install/Mandrake/$_"; next }
3143                $mkiso .= " Mandrake/=$install/Mandrake/$_";
3144            }
3145
3146            local *A; opendir A, "$install/Mandrake/base";
3147            foreach (readdir A){
3148                /~$/ and next;
3149                /(^(\.{1,2}|compss|provides|depslist.ordered|compssUsers|rpmsrate|rpmslist|filelist|Serial|hashfile)$|hdlist|cooker)/ and next;
3150                $size += du ("$install/Mandrake/base/$_");
3151                if (-d "$install/Mandrake/base/$_"){ $mkiso .= " Mandrake/base/$_/=$install/Mandrake/base/$_"; next}
3152                $mkiso .= " Mandrake/base/=$install/Mandrake/base/$_";
3153            }
3154            my $rpmsrate = $cd->[2]{installation}[2]{rpmsrate} || "$install/Mandrake/base/rpmsrate";
3155            $size += du ($rpmsrate);
3156            $mkiso .= " Mandrake/base/rpmsrate=$rpmsrate";
3157            my $compss= $cd->[2]{installation}[2]{compssUsers} || "$install/Mandrake/base/compssUsers";
3158            $size += du ($compss);
3159            $mkiso .= " Mandrake/base/compssUsers=$compss";
3160
3161            $mkisos->[$cdnum] = $mkiso;
3162        }else {
3163            cpal("$install/","$dir/$cdnum","((Mandrake/+base/+(hdlist|depslist|rpmslist|filelist|Serial|hashfile|compssUsers|rpmsrate))|$install/+Mandrake/+RPMS|$install/+Mandrake/+share|isolinux|images)");
3164            my $rpmsrate = $cd->[2]{installation}[2]{rpmsrate} || "$install/Mandrake/base/rpmsrate";
3165            print LOG "installation: rpmsrate: $rpmsrate\n";
3166            cpal($rpmsrate,"$dir/$cdnum/Mandrake/base/rpmsrate");
3167            my $compss = $cd->[2]{installation}[2]{compssUsers} || "$install/Mandrake/base/compssUsers";
3168            print LOG "installation: rpmsrate: $compss\n";
3169            cpal($compss,"$dir/$cdnum/Mandrake/base/compssUsers");
3170        }
3171        return $size
3172    }elsif ($fixed == 1){
3173        if ($nolive){
3174            my $size;
3175            my ($repnum,$path) = buildInstallHdlist($dir, $cdnum,$inst,$list,$discsFiles);
3176            my $mkiso;
3177            if ($install){
3178                $mkiso = " Mandrake/base/=$path/compss Mandrake/base/=$path/depslist.ordered Mandrake/base/=$path/provides Mandrake/base/=$path/hdlists";
3179                $size += du("$path/compss");
3180                $size += du("$path/depslist.ordered");
3181                $size += du("$path/provides");
3182                my $version = "$dir/$cdnum/VERSION";
3183                printVERSION($version,$inst->[1]{tag});
3184                $mkiso .= " VERSION=$version";
3185                $size += du($version);  $size += du("$path/hdlists");
3186            }   
3187            foreach my $n (1 .. $repnum - 1){
3188                $mkiso .= " Mandrake/base/=$path/hdlist$n.cz";
3189                $size += du("Mandrake/base/=$path/hdlist$n.cz");
3190                if ($inst->[1]{synthesis}){
3191                    $mkiso .= " Mandrake/base/=$path/synthesis.hdlist$n.cz";
3192                    $size += du("Mandrake/base/=$path/synthesys.hdlist$n.cz")
3193                }
3194            }
3195            $mkisos->[$cdnum] .= $mkiso;
3196            return $size;
3197        } else {
3198            if (!$install){ mkpath "$dir/$cdnum/Mandrake/base/" }
3199            unlink "$dir/$cdnum/Mandrake/base/hdlists";
3200            if (!$inst->[1]{fixed}){
3201                my @check;
3202                local *A; open A, ">$dir/$cdnum/Mandrake/base/hdlists";
3203                my $cmddep = qq{gendistrib --noclean --distrib "$dir/$cdnum" };
3204                my $repnum = 1;
3205                my @synth;
3206                foreach my $rd (@{$inst->[1]{rpmsdir}}){
3207                    my ($cdrep,$repname) = @$rd;
3208                    $list->{$cdrep} or print LOG "WARNING installation: disc $cdrep not in list, ignoring\n" and next;
3209                    my $rpmdir = $config[2][$cdrep][2]{dir}{$repname};
3210                    $rpmdir or print LOG "ERROR: disc $cdrep: $repname not defined\n" and next;
3211                    print LOG "BUILDING $cdrep -- $repname -- $rpmdir\n";
3212                    my $realcd = $config[2][$cdrep][0][2];
3213                    if ($realcd) { 
3214                        print A "hdlist$repnum.cz $rpmdir disc $realcd $config[2]->[$cdrep][0][3]\n";
3215                    }else{
3216                        print A "hdlist$repnum.cz $rpmdir $config[2]->[$cdrep][0][3]\n";
3217                    }
3218                    push @synth, "hdlist$repnum.cz";
3219                    if ($cdnum != $cdrep){ 
3220                        $cmddep .= qq{ "$dir/$cdrep/"}
3221                    }
3222                    $check[$repnum] = qq{$dir/$cdrep/};
3223                    $repnum++
3224                }
3225                close A;
3226                print LOG "Building hdlists $cmddep\n";
3227                system($cmddep);
3228                system($cmddep);
3229                checkcds(\@check) or die "depslist.ordered, hdlists and RPMS mismatch\n";
3230                if ($inst->[1]{synthesis}){
3231                    foreach my $s (@synth){
3232                        genSynthesis("$dir/$cdnum/Mandrake/base/$s","$dir/$cdnum/Mandrake/base/synthesis.$s")
3233                    }
3234                }
3235            }else{
3236                buildInstallHdlist($dir, $cdnum,$inst,$list,$discsFiles);
3237            }
3238            if ($install){
3239                my $version = "$dir/$cdnum/VERSION";
3240                unlink $version;
3241                printVERSION($version,$inst->[1]{tag});
3242            }
3243        }
3244    }
3245}
3246
3247sub du {
3248    my ($path,$size) = @_;
3249    my $size;
3250    if (-d $path){
3251        opendir O, $path;
3252        foreach (readdir O){
3253            /^\.{1,2}$/ and next;
3254            -l "$path/$_" or $size += du("$path/$_")
3255        }
3256    } else {
3257        -l $path or $size = (stat $path)[7] + 2048;
3258    }
3259    $size
3260}
3261
3262sub cpal{
3263    my ($source,$dest,$exclude,$verbose) = @_;
3264    if ($exclude && "$source/$_" =~ /$exclude/) {return 0}
3265    if (!-l $source && -d $source){
3266        mkdir "$dest";
3267        opendir O, $source; 
3268        foreach (readdir O){
3269            /^\.{1,2}$/ and next;
3270            cpal("$source/$_","$dest/$_",$exclude,$verbose)
3271        }
3272    }else {
3273        my $err;
3274        if (-d $dest){ my ($filename) = $source =~ /([^\/]*)$/; $dest .= "/$filename"}
3275        $err = link "$source","$dest" ;
3276        $verbose and print LOG "cpal: link $source -> $dest\n" ; 
3277        if (!$err) { 
3278            print LOG "Linking failed $source -> $dest: $!, trying to copy\n" ; 
3279            $err = copy "$source", "$dest"; 
3280            if (!$err) { print LOG "Copying failed $source -> $dest: $!,\n"; return 0}
3281        }
3282    }
3283    1
3284}
3285
3286#
3287# check depslist, depslists.ordered and hdlists
3288#
3289sub checkcds{
3290    my ($tops,$first) = @_;
3291    my $i;
3292    my $top;
3293
3294    if ($first) { $top = $tops->[$first]} else { while (!$tops->[$i]){$i++}; $top = $tops->[$i]} ;
3295
3296    local *A; open A, "$top/Mandrake/base/depslist.ordered" or print LOG "ERROR: unable to open $top/Mandrake/base/depslist.ordered" and return 0;
3297    my %depspackages;
3298    my %dup;
3299    my $ok = 1;
3300    my $OK=1;
3301    print LOG "Duplicate version: ";
3302    while (<A>){
3303        my ($pkg,$name) = ((split)[0]) =~ /((.*)-[^-]+-[^-]+\.[^:]+)/;
3304        $dup{$pkg} and do { print LOG "\n$pkg"; $ok=0 ; $OK=0};
3305        $dup{$name} and do { print LOG "\n$name"; $ok=0 ; $OK=0};
3306        $depspackages{$pkg} = 1;
3307        $dup{$pkg} = 1;
3308        $dup{$name} = 1;
3309    }
3310    $ok ? print LOG " OK\n" : print LOG " FAILED\n";
3311
3312    my %hdlist;
3313    my %rep;
3314    my $num;
3315    local *A; open A, "$top/Mandrake/base/hdlists" or die "unable to open $top/Mandrake/base/hdlists";
3316    while (<A>){
3317        my ($hdlist, $dir, undef) = split;
3318        $num++;
3319        local $_;
3320        local *B; open B, "packdrake -l $top/Mandrake/base/$hdlist|" or die "unable to open packdrake $top/Mandrake/base/$hdlist|";
3321        <B>;
3322        print LOG "\nIn $hdlist, not in depslist:";
3323        my $ok = 1;
3324        my $p;
3325        my $k;
3326        my %key;
3327        while (<B>){
3328            $p = (split)[2];
3329            if ($p =~ /(.*):(.*)/){
3330                $p = $1;
3331                $k = $2;
3332                $key{$2} = $1
3333            }else { $key{$p} = $p } 
3334            # $p =~ s/(\.(i386|i486|i586|i686|noarch))?$//;
3335            $hdlist{$p} = 1;
3336            if (!$depspackages{$p}) {print LOG "\n$p"; $ok=0; $OK=0}
3337        }
3338        $p or do { print LOG "$hdlist is empty\n" ; $OK=0};
3339        $ok and print LOG " OK\n";
3340        local *C;
3341        opendir C, "$tops->[$num]/$dir" or opendir C, "$top/$dir";
3342        my $ok = 1;
3343        print LOG "\n\nIn $tops->[$num]/$dir, not in depslist:";
3344        readdir C;
3345        readdir C;
3346        foreach (readdir C){
3347            s/\.rpm// or next;
3348            $rep{$key{$_}} = 1;
3349            if (!$depspackages{$key{$_}}) {print LOG "\n$_"; $ok=0; $OK = 0}
3350        }       
3351        $ok ? print LOG " OK\n" : print LOG " FAILED\n";
3352    }
3353
3354    print LOG "\n\nIn depslist, not in hdlist*.cz:";
3355    my $ok = 1;
3356    foreach (keys %depspackages){ 
3357        if (!($hdlist{$_})) {print LOG "\n$_"; $ok=0; $OK=0}
3358    }
3359    $ok ? print LOG " OK\n" : print LOG " FAILED\n";
3360
3361    print LOG "\n\nIn depslist, not in RPMS*:";
3362    my $ok = 1;
3363    foreach (keys %depspackages){ 
3364        if (!$rep{$_}) {print LOG "\n$_"; $ok=0; $OK=0}
3365    }
3366    $ok ? print LOG " OK\n" : print LOG " FAILED\n";
3367    print LOG "\n";
3368    $OK
3369}
3370
3371sub cleanrpmsrate {
3372    my ($rpmsrate,$R,@rpms) = @_;
3373    my %rpms;
3374    foreach (@rpms){
3375        -d or print LOG "ERROR: $_ is not a directory\n" and next;
3376        local *A; opendir A, $_;
3377        foreach (readdir A) { if (/-devel-/) { s/(.*?)(_*[\d.]*)-devel-[^-]+-[^-]+\.[^.]+\.rpm$//; $2 and $rpms{$1} = $2}}
3378    }
3379    open A, $rpmsrate;
3380
3381    my %done;
3382    my $current;
3383    my $rate;
3384    while (<A>){
3385        s/#.*//;
3386        /^\s*$/ and print $R $_ and next;
3387        if (/^(\S+)/) {
3388            print $R $_;
3389            $current = $1;
3390            next
3391        }
3392        my ($indent,$r,$prefix,$data) = /^(\s*)([1-5]?)(\s*(?:[!0-9A-Z_]*\s+)*(?:[!0-9A-Z_]+"[^"]*"(?:\s+\|\|\s+)*)*\s*)(.*)$/;
3393        $r and $rate = $r;
3394        my @k;
3395        $data or print $R "$indent$r$prefix" and next;
3396        my ($postfix) = $data =~ /(\s*)$/;
3397        foreach (split ' ', $data) {
3398            #FIXME need to handle doble the same way the install is doing, not just removing them.
3399            my $c = $_;
3400            if (!($current eq "INSTALL")) {
3401                $done{$_} and next;
3402                my $a; my ($b) = $_ =~ s/(-devel)// ? "-devel" : "";
3403                if ($b && ($rpms{$_} || ($rpms{"lib$_"} and $a = "lib"))) { 
3404                    my $d = "$a$_" . $rpms{"$a$_"} . "$b"; 
3405                    if (!$done{$d}){ $done{$d} = $rate; push @k, $d, $c}
3406                }else { push @k, $c }
3407            } else { push @k, $c}
3408            $done{$c} = $rate;
3409        } 
3410        @k and print $R "$indent$r$prefix@k$postfix\n"
3411    }
3412    1
3413}
Note: See TracBrowser for help on using the repository browser.