Initial revision

7 files changed, 298 insertions, 0 deletions

diff --git a/regress/base/base.pl b/regress/base/base.pl
new file mode 100755
index 00000000..b6f69871
--- /dev/null
+++ b/regress/base/base.pl
@@ -0,0 +1,9 @@
+use lib qw(./lib/fml5 ./lib/CPAN ./lib/3RDPARTY ./lib);
+
+use FML::BaseSystem;
+$p = new FML::BaseSystem;
+
+$p->dump_variables;
+
+exit 0;
+
diff --git a/regress/base/header_parser.pl b/regress/base/header_parser.pl
new file mode 100755
index 00000000..5d4b16a2
--- /dev/null
+++ b/regress/base/header_parser.pl
@@ -0,0 +1,30 @@
+use lib qw(./lib/fml5 ./lib/CPAN ./lib/3RDPARTY ./lib);
+# use strict;
+use Carp;
+
+use Mail::Header;
+use FML::Parse;
+
+my ($head, $body) = new FML::Parse \*STDIN;
+
+my $s = {
+    header => $head,
+    body   => $body,
+};
+
+
+$s->{'header'}->delete('Received');
+$s->{'header'}->print;
+print "\n\n";
+print ${ $s->{'body'} };
+
+use FML::Debug;
+my $fp = new FML::Debug;
+$fp->show_structure( \$s );
+
+for (1.. 100) {
+    ${ "x$_" } = $s;
+system "ps auxww|grep $$";
+}
+
+exit 0;
diff --git a/regress/base/io_map.pl b/regress/base/io_map.pl
new file mode 100755
index 00000000..5b788d52
--- /dev/null
+++ b/regress/base/io_map.pl
@@ -0,0 +1,30 @@
+$map = 'file:/etc/mail/sendmail.cf';
+
+while (1) { &p;}
+
+sub p
+{
+    use FML::IO::Map;
+    my $obj = new FML::IO::Map $map;
+
+    if (defined $obj) {
+	$obj->open;
+
+	if ($pos) { $obj->setpos($pos);} 
+
+	$i = 0;
+	# XXX $obj->getline returns a mail address.
+	while (defined ($_ = $obj->get_rawline)) {
+	    print $_;
+	    last if $i++ > 3;
+	}
+
+	# save the current position in the file handle
+	$pos = $obj->getpos;
+
+	if ($obj->eof) { exit 0;}
+
+	$obj->close;
+    }
+}
+
diff --git a/regress/base/listmap.pl b/regress/base/listmap.pl
new file mode 100755
index 00000000..cf82e67d
--- /dev/null
+++ b/regress/base/listmap.pl
@@ -0,0 +1,150 @@
+#!/usr/local/bin/perl -w
+#-*- perl -*-
+#
+# Copyright (C) 2000 Ken'ichi Fukamachi
+#          All rights reserved. 
+#
+# $FML$
+#
+
+=head1 NAME
+
+distribute -- fml5 article distributer program.
+
+=head1 SYNOPSIS
+
+   distribute [-d] config.cf
+
+=head1 DESCRIPTION
+
+libexec/fml.pl, the wrapper, executes this program. For example, The
+incoming mail to elena@fml.org kicks off libexec/distribute via
+libexec/fml.pl, whereas mail to elena-ctl@fml.org kicks off
+libexec/command finally.
+
+   incoming_mail =>
+      elena@fml.org       => fml.pl => libexec/distribute
+      elena-ctl@fml.org   => fml.pl => libexec/command
+      elena-admin@fml.org => forwarded to administrator(s)
+                                  OR
+                          => libexec/mead
+
+C<-d>
+    debug on.
+
+=head1 FLOW AROUND COMPONENTS
+
+   |  <=> FML::BaseSystem
+   |      load configuration files
+   |      start logging service
+   |
+   |  STDIN                     => FML::Parse
+   |  $CurProc->{'incoming_mail'} <=
+   |  $CurProc->{'credential'}
+   | 
+   |  (lock)
+   |  prepare article
+   |  $CurProc->{'article'} is spooled in.
+   |  $CurProc->{'article'}    <=> Service::SMTP
+   |  (unlock)
+   V
+
+=cut
+
+use lib qw(./lib/3RDPARTY ./lib/fml5 ./lib/CPAN ./lib);
+use Carp;
+use FML::BaseSystem;
+use FML::IO::Map;
+
+
+print STDERR "\n--- unix.group:wheel \n";
+$mapobj = new FML::IO::Map 'unix.group:wheel';
+$mapobj->open;
+$line = 0;
+while (defined ($_ = $mapobj->get_member)) { print $_, "\n";}
+$mapobj->close;
+
+print STDERR "\n--- /etc/motd \n";
+$mapobj = new FML::IO::Map '/etc/motd';
+$mapobj->open;
+$line = 0;
+while (defined ($_ = $mapobj->get_member)) { print $_, "\n";}
+$mapobj->close;
+
+print STDERR "\n--- file:/etc/motd \n";
+$mapobj = new FML::IO::Map 'file:/etc/motd';
+$mapobj->open;
+$line = 0;
+while (defined ($_ = $mapobj->get_member)) { print $_, "\n";}
+$mapobj->close;
+
+print STDERR "\n--- mysql:toymodel \n";
+$mapobj = new FML::IO::Map 'mysql:toymodel';
+$mapobj->dump_variables;
+$mapobj->open;
+$line = 0;
+while (defined ($_ = $mapobj->get_member)) { print $_, "\n";}
+$mapobj->close;
+
+
+
+exit 0;
+
+
+
+print STDERR "\n--- benchmark \n";
+use Benchmark;
+use FileHandle;
+
+
+my $file = $ARGV[0] || "/usr/share/dict/web2";
+my $lines = 0;
+{
+    $t2 = new Benchmark;
+    $mapobj = new FML::IO::Map $file;
+    $mapobj->open;
+    $line = 0;
+    while (defined ($_ = $mapobj->get_member)) { print $_;}
+    $mapobj->close;
+
+    $c = $mapobj->line_count;
+    $t3 = new Benchmark;
+    print STDERR timestr( timediff($t3, $t2) ), " for $c lines\n";
+}
+
+{
+    $fh  = new FileHandle $file;
+    $t0  = new Benchmark;
+    my $c = 0;
+    my $ec=0;
+    if (defined $fh) {
+	my $rcpt = '';
+	while (<$fh>) { 
+	    $c++;
+
+	    chop;
+	    print; 
+
+	    next if /^\#/o;  # skip comment and off member
+	    next if /^\s*$/o; # skip null line
+	    next if /\s[ms]=/o;
+
+	    # O.K. Checking delivery and addrs to skip;
+	    ($rcpt) = split(/\s+/, $_);
+	    $ec++;
+	}
+	$fh->close;
+    }
+    $t1 = new Benchmark;
+    print STDERR timestr( timediff($t1, $t0) ), " for $ec/$c lines\n";
+    $lines = $c;
+}
+
+$ra = timediff($t3, $t2);
+$rb = timediff($t1, $t0);
+
+print STDERR $$ra[1] / $$rb[1], " times\n";
+print STDERR $$ra[1] *10000 / ( $lines ), " sec. for 10000 addresses\n";
+print STDERR $$rb[1] *10000 / ( $lines ), " sec. for 10000 addresses\n";
+
+exit 0;
diff --git a/regress/base/lock.pl b/regress/base/lock.pl
new file mode 100755
index 00000000..788dbf50
--- /dev/null
+++ b/regress/base/lock.pl
@@ -0,0 +1,22 @@
+if ($0 eq __FILE__) {
+    use FML::Lock;
+    my $lockobj = new FML::Lock;
+
+    my $r = $lockobj->lock( { file => '/tmp/a' });
+    if ($r) { 
+	print STDERR "lock ($$) o.k.\n";
+    }
+    else {
+	print STDERR $lockobj->error, "\n";
+    }
+
+    system "date"; sleep 1;
+
+    $r = $lockobj->unlock( { file => '/tmp/a' });
+    if ($r) { 
+	print STDERR "unlock o.k.\n";
+    }
+    else {
+	print STDERR $lockobj->error, "\n";
+    }
+}
diff --git a/regress/base/string.pl b/regress/base/string.pl
new file mode 100755
index 00000000..733ac426
--- /dev/null
+++ b/regress/base/string.pl
@@ -0,0 +1,7 @@
+use lib qw(./lib/fml5 ./lib/CPAN ./lib/3RDPARTY ./lib);
+use FML::String qw(STR2EUC);
+
+for (@ARGV) {
+    my $x = &STR2EUC($_);
+    print "<$_> -> <$x>\n";
+}
diff --git a/regress/base/test_of_list.pl b/regress/base/test_of_list.pl
new file mode 100755
index 00000000..a25d83fd
--- /dev/null
+++ b/regress/base/test_of_list.pl
@@ -0,0 +1,50 @@
+#!/usr/local/bin/perl
+
+use FML::List::Read;
+use Benchmark;
+
+$h = new FML::List::Read(
+			 'type' => 'nis',
+			 'list' => 'members',
+			 'file' => '/etc/motd'
+			 );
+
+print STDERR "--- open motd\n";
+$fh = $h->open;
+if (defined $fh) {
+    while (<$fh>) { print STDERR $_;}
+    $fh = $h->close;
+}
+
+$h = new FML::List::Read();
+print STDERR "--- open test.pl\n";
+
+
+$fh = $h->open("/usr/share/dict/web2");
+$t0 = new Benchmark;
+
+if (defined $fh) {
+    my $outfh = new FileHandle "> /var/tmp/uja";
+    if (defined $outfh) {
+	# $h->put($outfh);
+	$h->put;
+	$outfh->close;
+    }
+    $fh = $h->close;
+}
+$t1 = new Benchmark;
+print STDERR timestr( timediff($t1, $t0) ), "\n";
+
+
+print STDERR "--- standard \n";
+$fh = $h->open("/usr/share/dict/web2");
+$t0 = new Benchmark;
+my $outfh = new FileHandle "> /var/tmp/uja2";
+if (defined $fh) {
+    while (<$fh>) { print $outfh $_;}
+    $fh = $h->close;
+}
+$t1 = new Benchmark;
+print STDERR timestr( timediff($t1, $t0) ), "\n";
+
+exit 0;