home *** CD-ROM | disk | FTP | other *** search
/ ftp.madoka.org / 2014.12.ftp.madoka.org.tar / ftp.madoka.org / pub / plum / plum2_33_1.lzh / support / mkconf < prev    next >
Text File  |  1999-03-24  |  2KB  |  89 lines
  1. #!/bin/perl -w
  2. # $Id: mkconf,v 2.10 1998/11/11 05:47:03 hasegawa Exp $
  3. # copyright (c)1997-1998 Yoshinori Hasegawa <hasegawa@madoka.org>
  4.  
  5. &main(@ARGV);
  6.  
  7. sub main {
  8.   local(@args) = @_;
  9.   local($dir);
  10.   if (!@args) {
  11.     &usage();
  12.     exit(1);
  13.   }
  14.   $dir = shift(@args);
  15.   &property("$dir/plum", 'plum');
  16.   print "\n";
  17.   &traverse("$dir/module", '');
  18. }
  19.  
  20. sub traverse {
  21.   local($base, $dir) = @_;
  22.   local(@files, $file, $prop);
  23.   opendir(DIR, "$base/$dir") || die;
  24.   @files = readdir(DIR);
  25.   closedir(DIR);
  26.   foreach $file (sort(@files)) {
  27.     next if $file =~ /^\./;
  28.     next if $file eq 'SCCS';
  29.     next if $file eq 'RCS';
  30.     next if $file eq 'CVS';
  31.     next if $file =~ /\,v$/;
  32.     if (-d "$base/$dir/$file") {
  33.       if ($dir) {
  34.         &traverse($base, "$dir/$file");
  35.       } else {
  36.         &traverse($base, $file);
  37.       }
  38.     } elsif ($file =~ /\.plm/) {
  39.       $prop = "$dir.$`";
  40.       $prop =~ tr/\//\./;
  41.       if ($dir) {
  42.         print "- $dir/$file\n";
  43.         &property("$base/$dir/$file", $prop);
  44.       } else {
  45.         print "- $file\n";
  46.         &property("$base/$file", $prop);
  47.       }
  48.       print "\n";
  49.     }
  50.   }
  51. }
  52.  
  53. sub property {
  54.   local($file, $prop) = @_;
  55.   local(@prog, @doc);
  56.   @prog = ();
  57.   @doc = ();
  58.   if (open(FILE, $file)) {
  59.     while (defined($line = <FILE>)) {
  60.       $line =~ tr/\r\n//d;
  61.       while ($line =~ /\&\'property\(.*\,\s*\'([^\']*)\'\)/) {
  62.         push(@prog, "# $prop.$1: ");
  63.         $line = $';
  64.       }
  65.       last if $line eq '__END__';
  66.     }
  67.     while (defined($line = <FILE>)) {
  68.       $line =~ tr/\r\n//d;
  69.       if ($line =~ /^\s*\<DT\>\s+([\w\.]+)/) {
  70.         push(@doc, "# $1: ");
  71.       }
  72.     }
  73.     close(FILE);
  74.   }
  75.   foreach $doc (@doc) {
  76.     print $doc, "\n";
  77.     @prog = grep($_ ne $doc, @prog);
  78.   }
  79.   $last = '';
  80.   foreach $prog (sort(@prog)) {
  81.     print '# ', $prog, "\n" if $prog ne $last;
  82.     $last = $prog;
  83.   }
  84. }
  85.  
  86. sub usage {
  87.   print 'usage: perl mkconf <plum-top-directory>', "\n";
  88. }
  89.