home *** CD-ROM | disk | FTP | other *** search
/ ftp.madoka.org / 2014.12.ftp.madoka.org.tar / ftp.madoka.org / pub / plum / 2.x / plum2_26_1.lzh / support / merge < prev    next >
Text File  |  1998-07-31  |  3KB  |  138 lines
  1. #!/bin/perl -w
  2. # $Id: merge,v 2.5 1998/07/31 14:01:49 hasegawa Exp $
  3. # copyright (c)1998 pupu_j <hasegawa@agusa.nuie.nagoya-u.ac.jp>
  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 < scalar(@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*\}\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.         &property("$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.       next if $line =~ /^\s*#/;
  90.       last if $line eq '__END__';
  91.       if ($line =~ /^\$\_\s*\=\s*\'([^\']+)\'/) {
  92.         if ($pkg ne $1) {
  93.           warn "$path: illegal package\n";
  94.         }
  95.         $init = 0;
  96.         print "\n";
  97.         print 'sub init {', "\n";
  98.         foreach $st (@statement) {
  99.           print '  ', $st, "\n";
  100.         }
  101.         print '}', "\n";
  102.         next;
  103.       }
  104.       if ($init) {
  105.         if ($line =~ /\S/) {
  106.           push(@statement, $line);
  107.         }
  108.         next;
  109.       }
  110.       if ($line =~ /^\s*package\s+(.*)\s*\;/) {
  111.         $pkg = $1;
  112.         push(@package, $path, $pkg);
  113.         $init = 1;
  114.       }
  115.       print $line, "\n";
  116.     }
  117.   }
  118. }
  119.  
  120. sub usage {
  121.   print 'usage: perl merge <plum-top-directory>', "\n";
  122. }
  123.  
  124. __END__
  125. sub 'import {
  126.   local($name) = @_;
  127.   local($line, $file, $pkg, $sub);
  128.   while (defined($line = <main'DATA>)) {
  129.     $line =~ tr/\r\n//d;
  130.     ($file, $pkg) = split(/\s+/, $line);
  131.     $'package{$file} = $pkg;
  132.     $'filename{$pkg} = $file;
  133.   }
  134.   $pkg = $'package{$name} || 'main';
  135.   $sub = $pkg . '\'init';
  136.   &$sub();
  137. }
  138.