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 >
Wrap
Text File
|
1998-07-31
|
3KB
|
138 lines
#!/bin/perl -w
# $Id: merge,v 2.5 1998/07/31 14:01:49 hasegawa Exp $
# copyright (c)1998 pupu_j <hasegawa@agusa.nuie.nagoya-u.ac.jp>
&main(@ARGV);
sub main {
local(@args) = @_;
local($dir, $i);
if (!@args) {
&usage();
exit(1);
}
@package = ();
$dir = shift(@args);
&stub("$dir/plum");
&traverse("$dir/module", '');
print '__END__', "\n";
for ($i = 0; $i < scalar(@package); $i += 2) {
print $package[$i], ' ', $package[$i + 1], "\n";
}
}
sub stub {
local($file) = @_;
local($line, $import);
print '#!/bin/perl', "\n";
if (open(FILE, $file)) {
while (defined($line = <FILE>)) {
$line =~ tr/\r\n//d;
last if $line eq '__END__';
if ($import && $line =~ /^\s*\}\s*$/) {
while (defined($im = <DATA>)) {
$im =~ tr/\r\n//d;
print $im, "\n";
}
$import = 0;
next;
}
if ($import) {
next;
}
if ($line =~ /^sub\s+\'import/) {
$import = 1;
next;
}
print $line, "\n";
}
close(FILE);
}
}
sub traverse {
local($base, $dir) = @_;
local(@files, $file);
opendir(DIR, "$base/$dir") || die;
@files = readdir(DIR);
closedir(DIR);
foreach $file (sort(@files)) {
next if $file =~ /^\./;
next if $file eq 'SCCS';
next if $file eq 'RCS';
next if $file eq 'CVS';
next if $file =~ /\,v$/;
if (-d "$base/$dir/$file") {
if ($dir) {
&traverse($base, "$dir/$file");
} else {
&traverse($base, $file);
}
} elsif ($file =~ /\.plm/) {
if ($dir) {
&merge("$base/$dir/$file", "$dir/$file");
} else {
&property("$base/$file", "$file");
}
}
}
}
sub merge {
local($file, $path) = @_;
local($line, $init, @statement, $pkg);
$init = 0;
@statement = ();
if (open(FILE, $file)) {
while (defined($line = <FILE>)) {
$line =~ tr/\r\n//d;
next if $line =~ /^\s*#/;
last if $line eq '__END__';
if ($line =~ /^\$\_\s*\=\s*\'([^\']+)\'/) {
if ($pkg ne $1) {
warn "$path: illegal package\n";
}
$init = 0;
print "\n";
print 'sub init {', "\n";
foreach $st (@statement) {
print ' ', $st, "\n";
}
print '}', "\n";
next;
}
if ($init) {
if ($line =~ /\S/) {
push(@statement, $line);
}
next;
}
if ($line =~ /^\s*package\s+(.*)\s*\;/) {
$pkg = $1;
push(@package, $path, $pkg);
$init = 1;
}
print $line, "\n";
}
}
}
sub usage {
print 'usage: perl merge <plum-top-directory>', "\n";
}
__END__
sub 'import {
local($name) = @_;
local($line, $file, $pkg, $sub);
while (defined($line = <main'DATA>)) {
$line =~ tr/\r\n//d;
($file, $pkg) = split(/\s+/, $line);
$'package{$file} = $pkg;
$'filename{$pkg} = $file;
}
$pkg = $'package{$name} || 'main';
$sub = $pkg . '\'init';
&$sub();
}