Context Navigation

source: soft/build_system/build_system/mkcd/tags/V3_4_1_1mdk/mkcd2 @ 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: 117.6 KB

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

Note: See TracBrowser for help on using the repository browser.

Download in other formats: