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 / merge < prev    next >
Text File  |  1999-03-24  |  3KB  |  137 lines
  1. #!/bin/perl -w
  2. # $Id: merge,v 2.10 1999/01/20 15:02:41 hasegawa Exp $
  3. # copyright (c)1998-1999 Yoshinori Hasegawa <hasegawa@madoka.org>
  4.  
  5. &main(@ARGV);
  6.  
  7. sub main {
  8.   local(@args) = @_;
  9.   local($dir, $i);
  10.   if (!@args) {
  11.     &usage();
  12.     exit(1);
  13.   }
  14.   @package = ();
  15.   $dir = shift(@args);
  16.   &stub("$dir/plum");
  17.   &traverse("$dir/module", '');
  18.   print '__END__', "\n";
  19.   for ($i = 0; $i < @package; $i += 2) {
  20.     print $package[$i], ' ', $package[$i + 1], "\n";
  21.   }
  22. }
  23.  
  24. sub stub {
  25.   local($file) = @_;
  26.   local($line, $import);
  27.   print '#!/bin/perl', "\n";
  28.   if (open(FILE, $file)) {
  29.     while (defined($line = <FILE>)) {
  30.       $line =~ tr/\r\n//d;
  31.       last if $line eq '__END__';
  32.       if ($import && $line =~ /^\}\s*$/) {
  33.         while (defined($im = <DATA>)) {
  34.           $im =~ tr/\r\n//d;
  35.           print $im, "\n";
  36.         }
  37.         $import = 0;
  38.         next;
  39.       }
  40.       if ($import) {
  41.         next;
  42.       }
  43.       if ($line =~ /^sub\s+\'import/) {
  44.         $import = 1;
  45.         next;
  46.       }
  47.       print $line, "\n";
  48.     }
  49.     close(FILE);
  50.   }
  51. }
  52.  
  53. sub traverse {
  54.   local($base, $dir) = @_;
  55.   local(@files, $file);
  56.   opendir(DIR, "$base/$dir") || die;
  57.   @files = readdir(DIR);
  58.   closedir(DIR);
  59.   foreach $file (sort(@files)) {
  60.     next if $file =~ /^\./;
  61.     next if $file eq 'SCCS';
  62.     next if $file eq 'RCS';
  63.     next if $file eq 'CVS';
  64.     next if $file =~ /\,v$/;
  65.     if (-d "$base/$dir/$file") {
  66.       if ($dir) {
  67.         &traverse($base, "$dir/$file");
  68.       } else {
  69.         &traverse($base, $file);
  70.       }
  71.     } elsif ($file =~ /\.plm/) {
  72.       if ($dir) {
  73.         &merge("$base/$dir/$file", "$dir/$file");
  74.       } else {
  75.         &merge("$base/$file", "$file");
  76.       }
  77.     }
  78.   }
  79. }
  80.  
  81. sub merge {
  82.   local($file, $path) = @_;
  83.   local($line, $init, @statement, $pkg);
  84.   $init = 0;
  85.   @statement = ();
  86.   if (open(FILE, $file)) {
  87.     while (defined($line = <FILE>)) {
  88.       $line =~ tr/\r\n//d;
  89.       last if $line eq '__END__';
  90.       if ($line =~ /^\$\_\s*\=\s*\'([^\']+)\'/) {
  91.         if ($pkg ne $1) {
  92.           warn "$path: illegal package\n";
  93.         }
  94.         $init = 0;
  95.         print "\n";
  96.         print 'sub init {', "\n";
  97.         foreach $st (@statement) {
  98.           print '  ', $st, "\n";
  99.         }
  100.         print '}', "\n";
  101.         next;
  102.       }
  103.       if ($init) {
  104.         if ($line =~ /\S/) {
  105.           push(@statement, $line);
  106.         }
  107.         next;
  108.       }
  109.       if ($line =~ /^\s*package\s+(.*)\s*\;/) {
  110.         $pkg = $1;
  111.         push(@package, $path, $pkg);
  112.         $init = 1;
  113.       }
  114.       print $line, "\n";
  115.     }
  116.   }
  117. }
  118.  
  119. sub usage {
  120.   print 'usage: perl merge <plum-top-directory>', "\n";
  121. }
  122.  
  123. __END__
  124. sub 'import {
  125.   local($name) = @_;
  126.   local($line, $file, $pkg, $sub);
  127.   while (defined($line = <main'DATA>)) {
  128.     $line =~ tr/\r\n//d;
  129.     ($file, $pkg) = split(/\s+/, $line);
  130.     $'package{$file} = $pkg;
  131.     $'filename{$pkg} = $file;
  132.   }
  133.   $pkg = $'package{$name} || 'main';
  134.   $sub = $pkg . '\'init';
  135.   &$sub();
  136. }
  137.