protytype method() which are imported from fml 4.0 libenvf

3 files changed, 191 insertions, 13 deletions

diff --git a/fml/lib/FML/Filter/BodyCheck.pm b/fml/lib/FML/Filter/BodyCheck.pm
index 5db1658f..6de5c1f1 100644
--- a/fml/lib/FML/Filter/BodyCheck.pm
+++ b/fml/lib/FML/Filter/BodyCheck.pm
@@ -4,23 +4,25 @@
 #   All rights reserved. This program is free software; you can
 #   redistribute it and/or modify it under the same terms as Perl itself. 
 #
-# $Id$
-# $FML$
+# $FML: BodyCheck.pm,v 1.1.1.1 2001/03/28 15:13:31 fukachan Exp $
 #
 
-package FML::Filter::Core;
+package FML::Filter::BodyCheck;
 use strict;
 use vars qw(@ISA @EXPORT @EXPORT_OK $AUTOLOAD);
 use Carp;
 
 =head1 NAME
 
-FML::Filter::Core - what is this
+FML::Filter::BodyCheck - filter by mail body content
 
 =head1 SYNOPSIS
 
 =head1 DESCRIPTION
 
+C<FML::Filter::BodyCheck> is a collectoin of filter rules based on
+mail body content.
+
 =head1 METHODS
 
 =head2 C<new()>
@@ -39,24 +41,77 @@ sub new
 }
 
 
+
+=head2 C<body_check($curproc, $args)>
+
+entrance to the body check routines.
+C<fml process> to need this function kicks off fileter rules 
+through C<body_check()>.
+
+Filter rules are applied to the incoming message from STDIN, 
+
+   $curproc->{ incoming_message }->{ body }.
+
+=cut
+
+
 sub body_check
 {
     my ($self, $curproc, $args) = @_;
     my $message = $curproc->{ incoming_message }->{ body };
 
-    # 0. preparation 
+    ## 0. preparation 
     # local scope after here
     local($*) = 0;
 
-    # 1. XXX run-hooks
-    # 2. XXX %REJECT_HDR_FIELD_REGEXP
-    # 3. check only the first plain/text block
+    ## 1. XXX run-hooks
+    ## 2. XXX %REJECT_HDR_FIELD_REGEXP
+    ## 3. check only the first plain/text block
+
+    # get the message object for the first plain/text message.
+    # If the incoming message is a mime multipart format,
+    # get_first_plaintext_message() return the first mime part block
+    # with the "plain/text" type.
     my $m = $message->get_first_plaintext_message();
 
-    # 4 check only the last paragraph
+    ## 4. check only the last paragraph
+    #     XXX if message size > 1024 or not, we change the buffer to check.
+    #     XXX fml 4.0 extracts the last and first paragraph (libenvf.pl)
+    #     XXX for small enough buffer. The information comes from @pmap, but
+    #     XXX we should implement methods for them within $m message object.
+    # get useful information for the message object.
     my $num_paragraph = $m->num_paragraph();
-    my $is_one_line   = $m->is_one_line_message();
+    my $is_one_line   = $self->is_one_line_message($m);
+
+    ## 5. preparation for main rules.
+    $self->clean_up_buffer($m);
+
+    ## 6. main fules
+    my $rules = '';
+    for $rules (
+		'reject_not_iso2022jp_japanese_string',
+		'reject_null_mail_body',
+		) {
+	if ($self->can($method)) {
+	    $self->$method($curproc, $args, $m);
+	}
+	else {
+	    LogWarn("no such method $method");
+	}
+    }
+}
+
+
+sub clean_up_buffer
+{
+    ;
+}
 
+
+# XXX fml 4.0: If it has @ or ://, it must be a paragraph 
+sub is_one_line_message
+{
+    ;
 }
 
 
@@ -73,7 +128,7 @@ redistribute it and/or modify it under the same terms as Perl itself.
 
 =head1 HISTORY
 
-FML::Filter::Core appeared in fml5 mailing list driver package.
+FML::Filter::BodyCheck appeared in fml5 mailing list driver package.
 See C<http://www.fml.org/> for more details.
 
 =cut
diff --git a/fml/lib/FML/Filter/HeaderCheck.pm b/fml/lib/FML/Filter/HeaderCheck.pm
new file mode 100644
index 00000000..ce305288
--- /dev/null
+++ b/fml/lib/FML/Filter/HeaderCheck.pm
@@ -0,0 +1,83 @@
+#-*- perl -*-
+#
+#  Copyright (C) 2001 Ken'ichi Fukamachi
+#   All rights reserved. This program is free software; you can
+#   redistribute it and/or modify it under the same terms as Perl itself. 
+#
+# $FML: HeaderCheck.pm,v 1.1.1.1 2001/03/28 15:13:31 fukachan Exp $
+#
+
+package FML::Filter::HeaderCheck;
+use strict;
+use vars qw(@ISA @EXPORT @EXPORT_OK $AUTOLOAD);
+use Carp;
+
+=head1 NAME
+
+FML::Filter::HeaderCheck - filter by mail header content
+
+=head1 SYNOPSIS
+
+=head1 DESCRIPTION
+
+C<FML::Filter::HeaderCheck> is a collectoin of filter rules based on
+mail header content.
+
+=head1 METHODS
+
+=head2 C<new()>
+
+usual constructor.
+
+=cut
+
+
+sub new
+{
+    my ($self) = @_;
+    my ($type) = ref($self) || $self;
+    my $me     = {};
+    return bless $me, $type;
+}
+
+
+
+=head2 C<header_check($curproc, $args)>
+
+entrance to the header check routines.
+C<fml process> to need this function kicks off fileter rules 
+through C<header_check()>.
+
+Filter rules are applied to the incoming message from STDIN, 
+
+   $curproc->{ incoming_message }->{ header }.
+
+=cut
+
+
+sub header_check
+{
+    my ($self, $curproc, $args) = @_;
+}
+
+
+=head1 AUTHOR
+
+Ken'ichi Fukamachi
+
+=head1 COPYRIGHT
+
+Copyright (C) 2001 Ken'ichi Fukamachi
+
+All rights reserved. This program is free software; you can
+redistribute it and/or modify it under the same terms as Perl itself. 
+
+=head1 HISTORY
+
+FML::Filter::HeaderCheck appeared in fml5 mailing list driver package.
+See C<http://www.fml.org/> for more details.
+
+=cut
+
+
+1;
diff --git a/fml/lib/FML/Filter/Utils.pm b/fml/lib/FML/Filter/Utils.pm
index 2b350ef9..6149a778 100644
--- a/fml/lib/FML/Filter/Utils.pm
+++ b/fml/lib/FML/Filter/Utils.pm
@@ -4,8 +4,7 @@
 #   All rights reserved. This program is free software; you can
 #   redistribute it and/or modify it under the same terms as Perl itself. 
 #
-# $Id$
-# $FML$
+# $FML: Utils.pm,v 1.1.1.1 2001/03/28 15:13:31 fukachan Exp $
 #
 
 package FML::Filter::Utils;
@@ -117,6 +116,47 @@ sub is_one_line
 }
 
 
+# XXX fml 4.0: EUCCompare($buf, $pat) 
+# XXX          where $pat should be $& (matched pattern)
+sub euc_compare
+{
+    my ($self, $a, $pat) = @_;
+
+    # (Refeence: jcode 2.12)
+    # $re_euc_c    = '[\241-\376][\241-\376]';
+    # $re_euc_kana = '\216[\241-\337]';
+    # $re_euc_0212 = '\217[\241-\376][\241-\376]';
+    my ($re_euc_c, $re_euc_kana, $re_euc_0212);
+    $re_euc_c    = '[\241-\376][\241-\376]';
+    $re_euc_kana = '\216[\241-\337]';
+    $re_euc_0212 = '\217[\241-\376][\241-\376]';
+
+    # always true if given buffer is not EUC.
+    if ($a !~ /($re_euc_c|$re_euc_kana|$re_euc_0212)/) {
+	&Log("EUCCompare: do nothing for non EUC strings") if $debug;
+	return 1;
+    }
+
+    # extract EUC code (e.g. .*EUC_PATTERN.*)
+    # but how to do for "EUC ASCII EUC" case ???
+    my ($pa, $loc, $i);
+    do {
+	if ($a =~ /(($re_euc_c|$re_euc_kana|$re_euc_0212)+)/) {
+	    $pa  = $1;
+	    $loc = index($pa, $pat);
+	}
+
+	print "buf = <$a> pa=<$pa> pat=<$pat> loc=$loc\n";
+
+	return 1 if ($loc % 2) == 0;
+
+	$a = substr($a, index($a, $pa) + length($pa) );
+    } while ($i++ < 16);
+
+    0;
+}
+
+
 =head1 AUTHOR
 
 Ken'ichi Fukamachi