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