* fixed SLAPD module to depend on NETWORK
[mnemosyne.git] / mnemosyne.pl
blobda316df8108748ded0bca6bff5ac0e07ab2b7884
1 #!/usr/bin/perl
2 # --- T2-COPYRIGHT-NOTE-BEGIN ---
3 # This copyright note is auto-generated by ./scripts/Create-CopyPatch.
4 #
5 # T2 SDE: target/mnemosyne/mnemosyne.pl
6 # Copyright (C) 2004 - 2006 The T2 SDE Project
7 #
8 # More information can be found in the files COPYING and README.
9 #
10 # This program is free software; you can redistribute it and/or modify
11 # it under the terms of the GNU General Public License as published by
12 # the Free Software Foundation; version 2 of the License. A copy of the
13 # GNU General Public License can be found in the file COPYING.
14 # --- T2-COPYRIGHT-NOTE-END ---
16 use warnings;
17 use strict;
18 use IPC::Open2;
20 use constant {ALL => 0, ASK => 1, CHOICE => 2 };
21 %::FOLDER=();
22 %::MODULE=();
24 sub scandir {
25 my ($pkgseldir,$prefix) = @_;
26 my %current=('location', $pkgseldir, 'var', "CFGTEMP_$prefix");
28 # $current{desc,var} for sub-pkgsel dirs
29 if ($pkgseldir ne $::ROOT) {
30 my ($relative,$dirvar,$dirname);
31 $_ = $pkgseldir;
32 $relative = (m/^$::ROOT\/(.*)/i)[0];
34 $dirvar = "CFGTEMP_$prefix\_$relative";
35 $dirvar =~ tr,a-z\/ ,A-Z__,;
37 $dirname=$relative;
38 $dirname=~ s/.*\///g;
40 $current{desc} = $dirname;
41 $current{var} = $dirvar;
44 # make this folder global
45 $::FOLDER{$current{var}} = \%current;
48 # make scandir recursive
49 my @children;
50 opendir(my $DIR, $pkgseldir);
51 foreach( grep { ! /^\./ } sort readdir($DIR) ) {
52 $_ = "$pkgseldir/$_";
53 if ( -d $_ ) {
54 my $subdir = scandir($_,$prefix);
55 push @children,$subdir;
56 } else {
57 my $module=scanmodule($_,$prefix,$current{var});
58 if ($module) {
59 push @children,$module unless grep(/^$module$/,@children);
63 closedir $DIR;
64 $current{children} = \@children;
65 return $current{var};
70 sub scanmodule {
71 my ($file,$prefix,$folder)=@_;
72 my (%current,$FILE);
74 # this defines dir,key,option and kind acording to the following format.
75 # $dir/[$prio-]$var[$option].$kind
76 do {
77 my ($dir,$key,$option,$kind);
78 m/^(.*)\/(\d+-)?([^\.]*).?([^\.]*)?\.([^\/\.]*)/i;
79 ($dir,$key,$option,$kind) = ($1,$3,$4,$5);
81 if ($kind eq 'choice') { $current{kind} = CHOICE; $current{option} = $option; }
82 elsif ($kind eq 'all') { $current{kind} = ALL; }
83 elsif ($kind eq 'ask') { $current{kind} = ASK; }
84 else { return; }
86 $current{location} = $dir;
87 $current{key} = $key;
88 $current{file} = $file;
90 } for $file;
92 open($FILE,'<',$file);
93 while(<$FILE>) {
94 if (/^#[^#: ]+: /) {
95 my ($field,$value) = m/^#([^#: ]+): (.*)$/i;
96 if ($field eq 'Description') {
97 $current{desc} = $value;
98 } elsif ($field eq 'Variable') {
99 $current{var} = $value;
100 } elsif ($field eq 'Default') {
101 $current{default} = $value;
102 } elsif ($field eq 'Forced') {
103 $current{forced} = $value;
104 } elsif ($field eq 'Imply') {
105 $current{imply} = $value;
106 } elsif ($field eq 'Dependencies') {
107 $current{deps} = $value;
108 # } else {
109 # print "$file:$field:$value.\n";
113 close($FILE);
115 # var name
116 $current{var} = uc $current{key}
117 unless exists $current{var};
118 $current{var} = "SDECFG_$prefix\_" . $current{var}
119 unless $current{var} =~ /^SDECFG_$prefix\_/;
121 # for choices, we use $option instead of $key as description
122 ($current{desc} = $current{option}) =~ s/_/ /g
123 if exists $current{option} && ! exists $current{desc};
124 ($current{desc} = $current{key}) =~ s/_/ /g
125 unless exists $current{desc};
127 # dependencies
128 # NOTE: don't use spaces on the pkgsel file, only to delimite different dependencies
129 if (exists $current{deps}) {
130 my @deps;
131 for ( split (/\s+/,$current{deps}) ) {
132 $_="SDECFG_$prefix\_$_" unless /^SDECFG/;
134 if (/=/) {
135 m/(.*?)(==|!=|=)(.*)/i;
136 $_="\"\$$1\" $2 $3";
137 } else {
138 $_="\"\$$_\" == 1";
141 push @deps,$_;
143 $current{deps} = \@deps;
146 # forced modules
147 if (exists $current{forced}) {
148 my @forced;
149 for ( split (/\s+/,$current{forced}) ) {
150 $_="SDECFG_$prefix\_$_" unless /^SDECFG/;
152 $_="$_=1" unless /=/;
153 push @forced,$_;
155 $current{forced} = \@forced;
158 # implied options
159 if (exists $current{imply}) {
160 my @imply = split (/\s+/,$current{imply});
161 $current{imply} = \@imply;
164 # make this module global
165 if ( $current{kind} == CHOICE ) {
167 # prepare the option for this choice
168 my %option;
169 for ('desc','forced','imply','deps','option','file') {
170 $option{$_}=$current{$_} if exists $current{$_};
173 if ( exists $::MODULE{$current{var}} ) {
174 push @{ $::MODULE{$current{var}}{options} },\%option;
175 } else {
176 # prepare and add this choice module
177 my @options = (\%option);
179 $::MODULE{$current{var}} = {
180 'kind', CHOICE,
181 'options', \@options,
184 for ('key','location','var') {
185 $::MODULE{$current{var}}{$_}=$current{$_}
186 if exists $current{$_};
190 } else {
191 $::MODULE{$current{var}} = {};
192 for ('key','location','var','desc','forced','deps','file','kind') {
193 $::MODULE{$current{var}}{$_}=$current{$_}
194 if exists $current{$_};
198 # default value
199 $::MODULE{$current{var}}{folder} = $folder;
200 $::MODULE{$current{var}}{default} = $current{default}
201 if exists $current{default};
203 return $current{var};
206 sub process_modules {
207 my ($READ,$WRITE,$pid);
208 my $i=0;
210 $pid = open2($READ, $WRITE, 'tsort');
211 # prepare topographic modules map
212 for my $module (values %::MODULE) {
213 my $related;
215 if ($module->{kind} == CHOICE) {
216 for (@{ $module->{options} }) {
217 my $option = $_;
218 for (@{exists $option->{deps} ? $option->{deps} : []} ) {
219 my $dep = (m/"\$([^"]+)"/i)[0];
220 print $WRITE "$dep $module->{var}\n";
221 $related=1;
223 for (@{exists $option->{forced} ? $option->{forced} : []} ) {
224 my $forced = (m/([^"]+)=/i)[0];
225 print $WRITE "$module->{var} $forced\n";
226 $related=1;
229 } else {
230 for (@{exists $module->{deps} ? $module->{deps} : []} ) {
231 my $dep = (m/"\$([^"]+)"/i)[0];
232 print $WRITE "$dep $module->{var}\n";
233 $related=1;
235 for (@{exists $module->{forced} ? $module->{forced} : []} ) {
236 my $forced = (m/([^"]+)=/i)[0];
237 print $WRITE "$module->{var} $forced\n";
238 $related=1;
242 if (! $related) {
243 print $WRITE "$module->{var} $module->{var}\n";
247 close($WRITE);
249 # and populate the sorted list
250 my @sorted;
251 while(<$READ>) {
252 if (/(.*)\n/) { push @sorted, $1; }
255 waitpid $pid,0;
256 die if $?;
258 # and remember the sorted list
259 $::MODULES=\@sorted;
262 sub process_folders {
263 my ($READ,$WRITE,$pid);
265 $pid = open2($READ, $WRITE, 'tsort | tac');
266 # prepare topographic modules map
267 for my $folder (values %::FOLDER) {
268 for ( exists $folder->{children} ? grep(!/^SDECFG/, @{$folder->{children}}) : [] ) {
269 print $WRITE "$folder->{var} $_\n";
272 close($WRITE);
274 # and populate the sorted list
275 my @sorted;
276 while(<$READ>) {
277 if (/(.*)\n/) { push @sorted, $1; }
280 waitpid $pid,0;
281 die if $?;
283 # and remember the sorted list
284 $::FOLDERS=\@sorted;
287 sub render_widgets_folder {
288 my ($folder,$offset) = @_;
289 for (@{$folder->{children}}) {
290 if (/^CFGTEMP/) {
291 my $subfolder=$::FOLDER{$_};
292 print "\n${offset}# $_\n${offset}#\n";
294 # opening
295 print "${offset}if [ \"\$$subfolder->{var}\" == 1 ]; then\n";
296 print "${offset}\tmenu_begin $subfolder->{var} '$subfolder->{desc}'\n";
297 print "${offset}fi\n";
299 render_widgets_folder($::FOLDER{$_},"$offset\t");
301 # closing
302 print "${offset}if [ \"\$$subfolder->{var}\" == 1 ]; then\n";
303 print "${offset}\tmenu_end\n";
304 print "${offset}fi\n";
305 } else {
306 my $module=$::MODULE{$_};
307 my $var=$module->{var};
308 my $conffile="$module->{location}/$module->{key}.conf"
309 if -f "$module->{location}/$module->{key}.conf";
311 print "${offset}# $var\n";
313 if ($module->{kind} == CHOICE) {
314 # CHOICE
315 my $tmpvar = "CFGTEMP_$1" if $var =~ m/^SDECFG_(.*)/i;
316 my $listvar = "$tmpvar\_LIST";
317 my $defaultvar = "$tmpvar\_DEFAULT";
319 print "${offset}if \[ -n \"\$$var\" \]; then\n";
320 print "${offset}\tchoice $var \$$defaultvar \$$listvar\n";
321 print "${offset}\t. $conffile\n" if $conffile;
322 print "${offset}fi\n";
324 } elsif ($module->{kind} == ASK) {
325 # ASK
326 my $default=0;
327 $default = $module->{default} if exists $module->{default};
329 print "${offset}if \[ -n \"\$$var\" \]; then\n";
330 print "${offset}\tbool '$module->{desc}' $module->{var} $default\n";
331 print "${offset}\t\[ \"\$$var\" == 1 \] && . $conffile\n" if $conffile;
332 print "${offset}fi\n";
333 } elsif ($conffile) {
334 # ALL, only if $conffile
335 print "${offset}if \[ -n \"\$$var\" \]; then\n";
336 print "${offset}\t. $conffile\n" if $conffile;
337 print "${offset}fi\n";
342 sub render_widgets {
343 open(my $FILE,'>',$_[0]);
344 my $root="CFGTEMP_$_[1]";
346 select $FILE;
347 render_widgets_folder($::FOLDER{$root},'');
348 select STDOUT;
349 close($FILE);
352 sub pkgsel_parse {
353 my ($action,$patternlist) = @_;
354 if ($action eq 'X' or $action eq 'x' ) {
355 $action = '$1="X"';
356 } elsif ($action eq 'O' or $action eq 'o') {
357 $action = '$1="O"';
358 } elsif ($action eq '-') {
359 $action = 'next';
360 } else {
361 $action = '{ exit; }';
364 my ($address,$first,$others)= ('','( ','&& ');
366 for (split(/\s+/,$patternlist)) {
367 if (! $address and $_ eq '!') {
368 $address = '! ';
369 $others = '|| $4"/"$5 ~';
370 } else {
371 $_="\*/$_" unless /\//;
372 s,[^a-zA-Z0-9_/\*+\.-],,g;
373 s,([/\.\+]),\\$1,g;
374 s,\*,[^/]*,g;
375 next unless $_;
376 $address = "$address$first";
377 $address = "$address / $_ /";
378 $first = "$others";
381 =for nobody
382 [ "$pattern" ] || continue
383 address="$address$first"
384 address="$address / $pattern /"
385 first=" $others"
387 =cut
390 print "\techo '$address ) { $action; }'\n";
391 return 1;
394 sub render_awkgen {
395 open(my $OUTPUT,'>',$_[0]);
396 my $root="CFGTEMP_$_[1]";
398 select $OUTPUT;
400 # initially change packages $4 and $5 to be able to correctly match repo based.
401 print "echo '{'\n";
402 print "echo '\trepo=\$4 ;'\n";
403 print "echo '\tpkg=\$5 ;'\n";
404 print "echo '\t\$5 = \$4 \"/\" \$5 ;'\n";
405 print "echo '\t\$4 = \"placeholder\" ;'\n";
406 print "echo '}'\n";
408 render_awkgen_folder($::FOLDER{$root});
410 # ... restore $4 and $5, and print the resulting line
411 print "echo '\n{'\n";
412 print "echo '\t\$4=repo ;'\n";
413 print "echo '\t\$5=pkg ;'\n";
414 print "echo '\tprint ;'\n";
415 print "echo '}'\n";
417 select STDOUT;
418 close($OUTPUT);
421 sub render_awkgen_folder {
422 my ($folder) = @_;
423 for (@{$folder->{children}}) {
424 if (/^CFGTEMP/) {
425 render_awkgen_folder($::FOLDER{$_});
426 } else {
427 my $module=$::MODULE{$_};
428 if ($module->{kind} == CHOICE) {
429 my %options;
431 # the list of options
432 for (@{ $module->{options} }) {
433 my $option = $_;
434 my @array=("\"\$$module->{var}\" == $_->{option}");
435 $options{$_->{option}} = \@array;
437 # and their implyed options
438 for (@{ $module->{options} }) {
439 my $option = $_;
440 for (@{exists $option->{imply}? $option->{imply} : [] }) {
441 push @{$options{$_}},
442 "\"\$$module->{var}\" == $option->{option}";
446 print "\n";
447 # and finally, render.
448 for (@{ $module->{options} }) {
449 print "if [ " . join(' -o ',@{ $options{ $_->{option} }}). " ]; then\n";
451 open(my $FILE,'<',$_->{file});
452 my $hasrules=0;
453 while(<$FILE>) {
454 next if /^#/;
455 next if /^\s*$/;
456 pkgsel_parse($1,$2) if m/^([^\s]+)\s+(.*)\s*\n?$/i;
457 $hasrules=1;
459 close($FILE);
460 print "\ttrue\n" unless $hasrules;
462 print "fi\n";
464 } else {
465 print "\nif [ \"\$$module->{var}\" == 1 ]; then\n";
466 open(my $FILE,'<',$module->{file});
467 my $hasrules=0;
468 while(<$FILE>) {
469 next if /^#/;
470 next if /^\s*$/;
471 pkgsel_parse($1,$2) if m/^([^\s]+)\s+(.*)\s*\n?$/i;
472 $hasrules=1;
474 close($FILE);
475 print "\ttrue\n" unless $hasrules;
476 print "fi\n";
482 sub render_rules_module {
483 my ($module,$offset) = @_;
484 my $var = $module->{var};
486 if ($module->{kind} == CHOICE) {
487 my $tmpvar = "CFGTEMP_$1" if $var =~ m/^SDECFG_(.*)/i;
488 my $listvar = "$tmpvar\_LIST";
489 my $defaultvar = "$tmpvar\_DEFAULT";
490 my $default = "undefined";
491 my $forcer;
493 $default = $module->{default} if exists $module->{default};
495 # initialize the list
496 print "${offset}$listvar=\n";
498 print "${offset}$defaultvar=$default\n";
499 print "${offset}\[ -n \"\$$var\" \] || $var=$default\n\n";
501 for ( @{ $module->{options} } ) {
502 my $option = $_;
503 (my $desc = $option->{desc}) =~ s/ /_/g;
505 # has something to force?
506 if (exists $option->{forced}) { $forcer = 1; }
508 if (exists $option->{deps}) {
509 print "${offset}if [ " .
510 join(' -a ', @{ $option->{deps} } ) .
511 " ]; then\n";
512 print "${offset}\t$listvar=\"\$$listvar $option->{option} $desc\"\n";
513 print "${offset}fi\n";
514 } else {
515 print "${offset}$listvar=\"\$$listvar $option->{option} $desc\"\n";
519 # enable the folder display
520 print "${offset}if \[ -n \"\$$listvar\" \]; then\n";
521 print "${offset}\t$module->{folder}=1\n";
522 print "${offset}else\n";
523 print "${offset}\tunset $module->{var}\n";
524 print "${offset}fi\n";
526 # has something to force?
527 if ($forcer) {
528 print "\n${offset}case \"\$$var\" in\n";
529 for ( @{ $module->{options} } ) {
530 my $option = $_;
531 if (exists $option->{forced}) {
532 print "${offset}\t$option->{option})\n";
533 for ( @{ $option->{forced} } ) {
534 print "$offset\t\t$_\n";
535 print "$offset\t\tSDECFGSET_$1\n" if $_ =~ m/^SDECFG_(.*)/i;
537 print "${offset}\t\t;;\n";
540 print "${offset}esac\n";
543 # printref($var,$module,$offset);
544 } elsif ($module->{kind} == ASK) {
545 my $default=0;
546 $default = $module->{default} if exists $module->{default};
548 #enable the folder display
549 print "$offset$module->{folder}=1\n";
551 # and set the default value if none is set.
552 print "$offset\[ -n \"\$$var\" \] || $var=$default\n";
554 # if enabled, append pkgsel and force the forced
556 if (exists $module->{forced}) {
557 print "\n${offset}if [ \"\$$var\" == 1 ]; then\n";
558 for ( @{ $module->{forced} } ) {
559 print "$offset\t$_\n";
560 print "$offset\tSDECFGSET_$1\n" if $_ =~ m/^SDECFG_(.*)/i;
562 print $offset."fi\n";
564 } else {
565 # just enable the feature
566 print "$offset$var=1\n";
568 # forced list doesn't make sense for {kind} == ALL
572 sub render_rules_nomodule {
573 my ($module,$offset) = @_;
574 my $var = $module->{var};
576 # unset the choice list, and the var
577 if ($module->{kind} == CHOICE) {
578 my $listvar = "CFGTEMP_$1_LIST" if $var =~ m/^SDECFG_(.*)/i;
579 print "${offset}unset $listvar\n";
581 print "${offset}unset SDECFGSET_$1\n" if $var =~ m/^SDECFG_(.*)/i;
582 print "${offset}unset $var\n";
585 sub render_rules {
586 open(my $FILE,'>',$_[0]);
587 my $root="CFGTEMP_$_[1]";
588 select $FILE;
590 # clean folder enablers
591 print "#\n# folder enablers\n#\n\n";
592 for (@$::FOLDERS) { print "$_=\n" unless /^$root$/; }
594 # pkgsel list
595 for (@$::MODULES) {
596 my $module = $::MODULE{$_};
597 print "\n#\n# $module->{var} ("
598 . ($module->{kind} == ALL ? "ALL" : ($module->{kind} == ASK ? "ASK" : "CHOICE" ) )
599 . ")\n#\n";
602 if (exists $module->{deps}) {
603 print "if [ " . join(' -a ', @{ $module->{deps} } ) . " ]; then\n";
604 render_rules_module($module,"\t");
605 print "else\n";
606 render_rules_nomodule($module,"\t");
607 print "fi\n";
608 } else {
609 render_rules_module($module,"");
613 print "\n#\n# enable folder with enabled subfolders\n#\n";
614 for (@$::FOLDERS) {
615 my $folder = $::FOLDER{$_};
616 my @subdirs = grep(/^CFGTEMP/,@{$folder->{children}});
617 if ( @subdirs ) {
618 print "if [ -n \"\$".join('$', @subdirs )."\" ]; then\n";
619 print "\t$folder->{var}=1\n";
620 print "fi\n";
624 select STDOUT;
625 close($FILE);
628 # print the content of a hash
629 sub printref {
630 my ($name,$ref,$offset) = @_;
631 my $typeof = ref($ref);
633 print "$offset$name:";
634 if ($typeof eq '') {
635 print " '$ref'\n";
636 } elsif ($typeof eq 'HASH') {
637 print "\n";
638 for (sort keys %{ $ref }) {
639 printref($_,$ref->{$_},"$offset\t");
641 } elsif ($typeof eq 'ARRAY') {
642 my $i=0;
643 print "\n";
644 for (@{ $ref }) {
645 printref("[$i]",$_,"$offset\t");
646 $i++;
648 } else {
649 print " -> $typeof\n";
653 if ($#ARGV != 4) {
654 print "Usage mnemosyne.pl: <pkgseldir> <prefix> <configfile> <rulesfile> <awkgenerator>\n";
655 exit (1);
658 $| = 1;
660 $::ROOT=$ARGV[0];
661 scandir($ARGV[0],$ARGV[1]);
662 process_modules();
663 process_folders();
664 render_rules($ARGV[3],$ARGV[1]);
665 render_widgets($ARGV[2],$ARGV[1]);
666 render_awkgen($ARGV[4],$ARGV[1]);