From 5cc9eeab0fc6942ec8ee81794ee7a29f1ed4a685 Mon Sep 17 00:00:00 2001
From: fukachan <fukachan>
Date: Sun, 1 Feb 2004 14:52:49 +0000
Subject: new FML::Command::Filter $curproc; fix/update comments/messages.
 rename method: rules() -> set_rules(). use //o if could.

fix var name:
$article_none_mime_filter_rules -> $article_non_mime_filter_rules.

implement reject_empty_content_type rule (non mime filter).
---
 fml/lib/FML/Command/Filter.pm       |  38 ++++-----
 fml/lib/FML/Filter.pm               |  70 ++++++++++-------
 fml/lib/FML/Filter/Header.pm        |   8 +-
 fml/lib/FML/Filter/MimeComponent.pm | 151 ++++++++++++++++++------------------
 fml/lib/FML/Filter/Size.pm          |  29 +++----
 fml/lib/FML/Filter/TextPlain.pm     |  22 +++---
 6 files changed, 163 insertions(+), 155 deletions(-)

(limited to 'fml/lib/FML')

diff --git a/fml/lib/FML/Command/Filter.pm b/fml/lib/FML/Command/Filter.pm
index a3f138a1..a9cb50f4 100644
--- a/fml/lib/FML/Command/Filter.pm
+++ b/fml/lib/FML/Command/Filter.pm
@@ -4,7 +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.
 #
-# $FML: Filter.pm,v 1.2 2003/08/23 07:24:42 fukachan Exp $
+# $FML: Filter.pm,v 1.3 2004/01/02 14:42:43 fukachan Exp $
 #
 
 package FML::Command::Filter;
@@ -38,41 +38,42 @@ dummy :-)
 
 
 # Descriptions: constructor.
-#    Arguments: OBJ($self) HASH_REF($args)
+#    Arguments: OBJ($self) OBJ($curproc) HASH_REF($args)
 # Side Effects: none
 # Return Value: OBJ
 sub new
 {
-    my ($self, $args) = @_;
+    my ($self, $curproc, $args) = @_;
     my ($type) = ref($self) || $self;
-    my $me     = {};
+    my $me     = { _curproc => $curproc };
     return bless $me, $type;
 }
 
 
 # Descriptions: virtual reject handler, just return __LAST__ :-)
-#    Arguments: OBJ($self) OBJ($curproc) OBJ($msg)
+#    Arguments: OBJ($self) OBJ($msg)
 # Side Effects: none
 # Return Value: STR (__LAST__, a special upcall)
 sub reject
 {
-    my ($self, $curproc, $msg) = @_;
+    my ($self, $msg) = @_;
 
     return '__LAST__';
 }
 
 
 # Descriptions:
-#    Arguments: OBJ($self) OBJ($curproc) OBJ($msg)
+#    Arguments: OBJ($self) OBJ($msg)
 # Side Effects: admin password modified.
 # Return Value: NUM
 sub check_command_limit
 {
-    my ($self, $curproc, $msg) = @_;
-    my $config = $curproc->config();
-    my $limit  = $config->{ command_mail_valid_command_limit } || 1024;
-    my $lines  = $msg->message_text_as_array_ref();
-    my $count  = 0;
+    my ($self, $msg) = @_;
+    my $curproc = $self->{ _curproc };
+    my $config  = $curproc->config();
+    my $limit   = $config->{ command_mail_valid_command_limit } || 1024;
+    my $lines   = $msg->message_text_as_array_ref();
+    my $count   = 0;
 
   LINE:
     for my $buf (@$lines) {
@@ -90,16 +91,17 @@ sub check_command_limit
 
 
 # Descriptions:
-#    Arguments: OBJ($self) OBJ($curproc) OBJ($msg)
+#    Arguments: OBJ($self) OBJ($msg)
 # Side Effects: admin password modified.
 # Return Value: NUM
 sub check_line_length_limit
 {
-    my ($self, $curproc, $msg) = @_;
-    my $config = $curproc->config();
-    my $limit  = $config->{ command_mail_line_length_limit } || 999;
-    my $lines  = $msg->message_text_as_array_ref();
-    my $match  = 0;
+    my ($self, $msg) = @_;
+    my $curproc = $self->{ _curproc };
+    my $config  = $curproc->config();
+    my $limit   = $config->{ command_mail_line_length_limit } || 999;
+    my $lines   = $msg->message_text_as_array_ref();
+    my $match   = 0;
     my $len;
 
   LINE:
diff --git a/fml/lib/FML/Filter.pm b/fml/lib/FML/Filter.pm
index 33c6e2ec..8e4b9604 100644
--- a/fml/lib/FML/Filter.pm
+++ b/fml/lib/FML/Filter.pm
@@ -4,7 +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.
 #
-# $FML: Filter.pm,v 1.38 2004/01/02 14:50:28 fukachan Exp $
+# $FML: Filter.pm,v 1.39 2004/01/21 03:48:32 fukachan Exp $
 #
 
 package FML::Filter;
@@ -58,7 +58,7 @@ sub new
 }
 
 
-# Descriptions: entry point for FML::Filter::* modules
+# Descriptions: entry point for FML::Filter::* modules.
 #    Arguments: OBJ($self) OBJ($curproc)
 # Side Effects: none
 # Return Value: STR or UNDEF, error reason (string). return undef if ok.
@@ -81,7 +81,7 @@ sub article_filter
 	    }
 	    else {
 		if ($debug) {
-		    $curproc->log("filter(debug): not check by $function");
+		    $curproc->log("filter(debug): $function check disabled.");
 		}
 	    }
 
@@ -95,7 +95,7 @@ sub article_filter
 }
 
 
-# Descriptions: size based filtering
+# Descriptions: size based filtering.
 #    Arguments: OBJ($self) OBJ($curproc) OBJ($mesg)
 # Side Effects: none
 # Return Value: STR(reason) or 0 (not trapped, ok)
@@ -115,7 +115,7 @@ sub _apply_article_size_filter
 
 	# overwrite rules
 	if (defined $rules) {
-	    $obj->rules( $rules );
+	    $obj->set_rules( $rules );
 	}
 
 	# go check
@@ -123,8 +123,8 @@ sub _apply_article_size_filter
 	if ($obj->error()) {
 	    my $x;
 	    $x =  $obj->error();
-	    $x =~ s/\s*at .*$//;
-	    $x =~ s/[\n\s]*$//m;
+	    $x =~ s/\s*at .*$//o;
+	    $x =~ s/[\n\s]*$//mo;
 	    $self->error_set($x);
 	    return $x;
 	}
@@ -134,7 +134,7 @@ sub _apply_article_size_filter
 }
 
 
-# Descriptions: header based filter
+# Descriptions: header based filter.
 #    Arguments: OBJ($self) OBJ($curproc) OBJ($mesg)
 # Side Effects: none
 # Return Value: STR(reason) or 0 (not trapped, ok)
@@ -152,7 +152,7 @@ sub _apply_article_header_filter
 
 	# overwrite rules
 	if (defined $rules) {
-	    $obj->rules( $rules );
+	    $obj->set_rules( $rules );
 	}
 
 	# go check
@@ -160,8 +160,8 @@ sub _apply_article_header_filter
 	if ($obj->error()) {
 	    my $x;
 	    $x =  $obj->error();
-	    $x =~ s/\s*at .*$//;
-	    $x =~ s/[\n\s]*$//m;
+	    $x =~ s/\s*at .*$//o;
+	    $x =~ s/[\n\s]*$//mo;
 	    $self->error_set($x);
 	    return $x;
 	}
@@ -171,7 +171,7 @@ sub _apply_article_header_filter
 }
 
 
-# Descriptions: filter non MIME format message
+# Descriptions: filter non MIME format message.
 #    Arguments: OBJ($self) OBJ($curproc) OBJ($mesg)
 # Side Effects: none
 # Return Value: 0 (always ok, anyway)
@@ -181,18 +181,27 @@ sub _apply_article_non_mime_filter
     my $config = $curproc->config();
 
     if ($config->yes( 'use_article_non_mime_filter' )) {
+	my $hdr   = $curproc->incoming_message_header();
 	my $rules =
-	    $config->get_as_array_ref('article_none_mime_filter_rules');
+	    $config->get_as_array_ref('article_non_mime_filter_rules');
 
       RULE:
 	for my $rule (@$rules) {
+	    $curproc->log("article_non_mime_filter.check $rule") if $debug;
+
 	    if ($rule eq 'permit') {
 		return 0;
 	    }
 
-	    # XXX-TODO: implement this!
-	    if ($rule eq 'reject') {
-		;
+	    if ($rule eq 'reject_empty_content_type') {
+		if (defined $hdr) {
+		    my $type  = $hdr->get('content-type') || '';
+		    unless ($type) {
+			my $s = "no Content-Type:";
+			$self->error_set($s);
+			return $s;
+		    }
+		}
 	    }
 	}
     }
@@ -201,7 +210,7 @@ sub _apply_article_non_mime_filter
 }
 
 
-# Descriptions: syntax check for text(/plain)
+# Descriptions: syntax check for text(/plain).
 #    Arguments: OBJ($self) OBJ($curproc) OBJ($mesg)
 # Side Effects: none
 # Return Value: none
@@ -218,7 +227,7 @@ sub _apply_article_text_plain_filter
 	my $rules =
 	    $config->get_as_array_ref('article_text_plain_filter_rules');
 	if (defined $rules) {
-	    $obj->rules( $rules );
+	    $obj->set_rules( $rules );
 	}
 
 	# go check
@@ -226,8 +235,8 @@ sub _apply_article_text_plain_filter
 	if ($obj->error()) {
 	    my $x;
 	    $x =  $obj->error();
-	    $x =~ s/\s*at .*$//;
-	    $x =~ s/[\n\s]*$//m;
+	    $x =~ s/\s*at .*$//o;
+	    $x =~ s/[\n\s]*$//mo;
 	    $self->error_set($x);
 	    return $x;
 	}
@@ -266,8 +275,8 @@ sub _apply_article_mime_component_filter
 	if ($obj->error()) {
 	    my $x;
 	    $x =  $obj->error();
-	    $x =~ s/\s*at .*$//;
-	    $x =~ s/[\n\s]*$//m;
+	    $x =~ s/\s*at .*$//o;
+	    $x =~ s/[\n\s]*$//mo;
 	    $self->error_set($x);
 	    return $x;
 	}
@@ -365,9 +374,14 @@ sub _filter_reject_notice
 
 =head1 COMMAND MAIL
 
+=head2 command_mail_filter($curproc)
+
+entry point for FML::Filter::* modules.
+
 =cut
 
-# Descriptions: entry point for FML::Filter::* modules
+
+# Descriptions: entry point for FML::Filter::* modules.
 #    Arguments: OBJ($self) OBJ($curproc)
 # Side Effects: none
 # Return Value: STR or UNDEF, error reason (string). return undef if ok.
@@ -391,7 +405,7 @@ sub command_mail_filter
 	    }
 	    else {
 		if ($debug) {
-		    $curproc->log("filter(debug): not check by $function");
+		    $curproc->log("filter(debug): $function check disabled.");
 		}
 	    }
 
@@ -405,7 +419,7 @@ sub command_mail_filter
 }
 
 
-# Descriptions: size based filtering
+# Descriptions: size based filtering.
 #    Arguments: OBJ($self) OBJ($curproc) OBJ($mesg)
 # Side Effects: none
 # Return Value: STR(reason) or 0 (not trapped, ok)
@@ -426,7 +440,7 @@ sub _apply_command_mail_size_filter
 
 	# overwrite rules
 	if (defined $rules) {
-	    $obj->rules( $rules );
+	    $obj->set_rules( $rules );
 	}
 
 	# go check
@@ -434,8 +448,8 @@ sub _apply_command_mail_size_filter
 	if ($obj->error()) {
 	    my $x;
 	    $x =  $obj->error();
-	    $x =~ s/\s*at .*$//;
-	    $x =~ s/[\n\s]*$//m;
+	    $x =~ s/\s*at .*$//o;
+	    $x =~ s/[\n\s]*$//mo;
 	    $self->error_set($x);
 	    return $x;
 	}
diff --git a/fml/lib/FML/Filter/Header.pm b/fml/lib/FML/Filter/Header.pm
index 9c3326ab..5bc78061 100644
--- a/fml/lib/FML/Filter/Header.pm
+++ b/fml/lib/FML/Filter/Header.pm
@@ -4,7 +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.
 #
-# $FML: Header.pm,v 1.7 2004/01/02 14:50:30 fukachan Exp $
+# $FML: Header.pm,v 1.8 2004/01/21 03:52:00 fukachan Exp $
 #
 
 package FML::Filter::Header;
@@ -37,7 +37,7 @@ constructor.
 my $debug = 0;
 
 
-# XXX-TODO: need this default rules here ? (principle of least surprise?)
+# default rules for convenience.
 my (@default_rules) = qw(check_message_id);
 
 
@@ -59,7 +59,7 @@ sub new
 
 
 
-=head2 rules( $rules )
+=head2 set_rules( $rules )
 
 overwrite rules by specified C<@$rules> ($rules is ARRAY_REF).
 
@@ -70,7 +70,7 @@ overwrite rules by specified C<@$rules> ($rules is ARRAY_REF).
 #    Arguments: OBJ($self) ARRAY_REF($rarray)
 # Side Effects: overwrite info in object
 # Return Value: ARRAY_REF
-sub rules
+sub set_rules
 {
     my ($self, $rarray) = @_;
 
diff --git a/fml/lib/FML/Filter/MimeComponent.pm b/fml/lib/FML/Filter/MimeComponent.pm
index f54b6f47..e7969e5f 100644
--- a/fml/lib/FML/Filter/MimeComponent.pm
+++ b/fml/lib/FML/Filter/MimeComponent.pm
@@ -4,7 +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.
 #
-# $FML: MimeComponent.pm,v 1.8 2004/01/02 14:50:31 fukachan Exp $
+# $FML: MimeComponent.pm,v 1.9 2004/01/21 03:53:18 fukachan Exp $
 #
 
 package FML::Filter::MimeComponent;
@@ -51,7 +51,7 @@ usual constructor.
 my $debug = 0;
 
 
-# default rules
+# default rules for convenience.
 my $filter_rules = [
 		    ['text/plain',   '*',  'permit'],
 		    ['text/html' ,   '*',  'reject'],
@@ -59,6 +59,17 @@ my $filter_rules = [
 		    ];
 
 
+# XXX-TODO: $default_action customizable ?
+my $default_action = 'permit';
+
+# XXX-TODO: $opt_cut_off_empty_part customizable ?
+my $opt_cut_off_empty_part = 1;
+
+# XXX-TODO: $recursive_max_level customizable ?
+my $recursive_max_level    = 10;
+
+
+
 # Descriptions: constructor.
 #    Arguments: OBJ($self) OBJ($curproc)
 # Side Effects: none
@@ -97,79 +108,6 @@ C<Usage>:
 =cut
 
 
-# XXX-TODO: $default_action customizable ?
-my $default_action = 'permit';
-
-# XXX-TODO: $opt_cut_off_empty_part customizable ?
-my $opt_cut_off_empty_part = 1;
-
-# XXX-TODO: $recursive_max_level customizable ?
-my $recursive_max_level    = 10;
-
-
-# Descriptions: parser of child multipart
-#    Arguments: OBJ($self) OBJ($msg)
-# Side Effects: update $recursive_level
-# Return Value: NUM
-sub _rfc822_mime_component_check
-{
-    my ($self, $msg) = @_;
-    my $curproc      = $self->{ _curproc };
-
-    $recursive_level ||= 0;
-    $recursive_level++;
-
-    if ($debug) {
-	print STDERR "\t_rfc822_mime_component_check ($recursive_level)\n";
-    }
-
-    if ($recursive_level > $recursive_max_level) {
-	croak("too deep recursive call");
-    }
-    else {
-	my $tmpf = $self->_temp_file_path();
-
-	use FileHandle;
-	my $wh = new FileHandle "> $tmpf";
-	if (defined $wh) {
-	    $msg->print($wh);
-	    $wh->close();
-	}
-
-	my $rh = new FileHandle $tmpf;
-	if (defined $rh) {
-	    use Mail::Message;
-	    my $msg0 = new Mail::Message->parse( { fd => $rh } );
-	    $self->mime_component_check($msg0);
-	}
-    }
-
-    $recursive_level--;
-}
-
-
-# Descriptions: return temporary file path to be used.
-#    Arguments: OBJ($self)
-# Side Effects: none
-# Return Value: none
-sub _temp_file_path
-{
-    my ($self) = @_;
-    my $curproc = $self->{ _curproc };
-
-    if (defined $curproc) {
-	return $curproc->temp_file_path();
-    }
-    elsif ($debug) {
-	return "./fileter.debug.$$";
-    }
-    else {
-	$curproc->logerror("\$curproc is mandatory");
-	croak("\$curproc undefined");
-    }
-}
-
-
 # Descriptions: top level dispatcher
 #    Arguments: OBJ($self) OBJ($msg)
 # Side Effects: none
@@ -451,6 +389,69 @@ sub _has_effective_part
 }
 
 
+# Descriptions: parser of child multipart
+#    Arguments: OBJ($self) OBJ($msg)
+# Side Effects: update $recursive_level
+# Return Value: NUM
+sub _rfc822_mime_component_check
+{
+    my ($self, $msg) = @_;
+    my $curproc      = $self->{ _curproc };
+
+    $recursive_level ||= 0;
+    $recursive_level++;
+
+    if ($debug) {
+	print STDERR "\t_rfc822_mime_component_check ($recursive_level)\n";
+    }
+
+    if ($recursive_level > $recursive_max_level) {
+	croak("too deep recursive call");
+    }
+    else {
+	my $tmpf = $self->_temp_file_path();
+
+	use FileHandle;
+	my $wh = new FileHandle "> $tmpf";
+	if (defined $wh) {
+	    $msg->print($wh);
+	    $wh->close();
+	}
+
+	my $rh = new FileHandle $tmpf;
+	if (defined $rh) {
+	    use Mail::Message;
+	    my $msg0 = new Mail::Message->parse( { fd => $rh } );
+	    $self->mime_component_check($msg0);
+	}
+    }
+
+    $recursive_level--;
+}
+
+
+# Descriptions: return temporary file path to be used.
+#    Arguments: OBJ($self)
+# Side Effects: none
+# Return Value: none
+sub _temp_file_path
+{
+    my ($self) = @_;
+    my $curproc = $self->{ _curproc };
+
+    if (defined $curproc) {
+	return $curproc->temp_file_path();
+    }
+    elsif ($debug) {
+	return "./fileter.debug.$$";
+    }
+    else {
+	$curproc->logerror("\$curproc is mandatory");
+	croak("\$curproc undefined");
+    }
+}
+
+
 =head1 UTILITY FUNCTIONS
 
 =cut
diff --git a/fml/lib/FML/Filter/Size.pm b/fml/lib/FML/Filter/Size.pm
index 0d98ae85..52c0c249 100644
--- a/fml/lib/FML/Filter/Size.pm
+++ b/fml/lib/FML/Filter/Size.pm
@@ -4,7 +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.
 #
-# $FML: Size.pm,v 1.7 2004/01/02 14:50:31 fukachan Exp $
+# $FML: Size.pm,v 1.8 2004/01/21 03:43:30 fukachan Exp $
 #
 
 package FML::Filter::Size;
@@ -37,7 +37,7 @@ constructor.
 my $debug = 0;
 
 
-# XXX-TODO: need this default rules here ? (principle of least surprise?)
+# default rules for convenience.
 my (@default_rules) = qw(check_header_size check_body_size);
 
 
@@ -61,21 +61,18 @@ sub new
 }
 
 
-# XXX-TODO rules() -> set_rules() ?
-
-
-=head2 rules( $rules )
+=head2 set_rules( $rules )
 
 overwrite rules by specified C<@$rules> ($rules is ARRAY_REF).
 
 =cut
 
 
-# Descriptions: access method to overwrite rule
+# Descriptions: overwrite rules.
 #    Arguments: OBJ($self) ARRAY_REF($rarray)
 # Side Effects: overwrite info in object
 # Return Value: ARRAY_REF
-sub rules
+sub set_rules
 {
     my ($self, $rarray) = @_;
 
@@ -124,7 +121,7 @@ C<Usage>:
 =cut
 
 
-# Descriptions: top level dispatcher
+# Descriptions: top level dispatcher.
 #    Arguments: OBJ($self) OBJ($msg)
 # Side Effects: none
 # Return Value: none
@@ -236,7 +233,7 @@ check the length limit of one command request.
 =cut
 
 
-# Descriptions: check the total number of command requests
+# Descriptions: check the total number of command requests.
 #    Arguments: OBJ($self) OBJ($msg) STR($type)
 # Side Effects: croak() if condition matched.
 # Return Value: none
@@ -247,10 +244,8 @@ sub check_command_limit
 
     use FML::Command::Filter;
     my $_msg   = $curproc->incoming_message_body();
-
-    # XXX-TODO new FML::Command::Filter $curproc ?
-    my $obj    = new FML::Command::Filter;
-    my $reason = $obj->check_command_limit($curproc, $_msg);
+    my $obj    = new FML::Command::Filter $curproc;
+    my $reason = $obj->check_command_limit($_msg);
 
     if ($reason) {
 	$self->error_set($reason);
@@ -270,10 +265,8 @@ sub check_line_length_limit
 
     use FML::Command::Filter;
     my $_msg   = $curproc->incoming_message_body();
-
-    # XXX-TODO new FML::Command::Filter $curproc ?
-    my $obj    = new FML::Command::Filter;
-    my $reason = $obj->check_line_length_limit($curproc, $_msg);
+    my $obj    = new FML::Command::Filter $curproc;
+    my $reason = $obj->check_line_length_limit($_msg);
 
     if ($reason) {
 	$self->error_set($reason);
diff --git a/fml/lib/FML/Filter/TextPlain.pm b/fml/lib/FML/Filter/TextPlain.pm
index c3a59b86..6ef8813b 100644
--- a/fml/lib/FML/Filter/TextPlain.pm
+++ b/fml/lib/FML/Filter/TextPlain.pm
@@ -4,7 +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.
 #
-# $FML: TextPlain.pm,v 1.8 2004/01/02 14:50:31 fukachan Exp $
+# $FML: TextPlain.pm,v 1.9 2004/01/21 03:43:30 fukachan Exp $
 #
 
 package FML::Filter::TextPlain;
@@ -34,8 +34,7 @@ constructor.
 =cut
 
 
-# default rules to apply
-# XXX-TODO: need this default rules here ? (principle of least surprise?)
+# default rules for convenience.
 my (@default_rules) = qw(reject_not_iso2022jp_japanese_string
 			 reject_null_mail_body
 			 reject_one_line_message
@@ -62,7 +61,7 @@ sub new
 }
 
 
-=head2 rules( $rules )
+=head2 set_rules( $rules )
 
 overwrite rules by specified C<@$rules> ($rules is ARRAY_REF).
 
@@ -73,7 +72,7 @@ overwrite rules by specified C<@$rules> ($rules is ARRAY_REF).
 #    Arguments: OBJ($self) ARRAY_REF($rarray)
 # Side Effects: overwrite info in object
 # Return Value: ARRAY_REF
-sub rules
+sub set_rules
 {
     my ($self, $rarray) = @_;
 
@@ -451,17 +450,16 @@ sub is_signature
 {
     my ($self, $data) = @_;
 
-    # XXX-TODO: //o
-    if ($data =~ /\@/    ||
-	$data =~ /TEL:/i ||
-	$data =~ /FAX:/i ||
-	$data =~ /:\/\// ) {
+    if ($data =~ /\@/o    ||
+	$data =~ /TEL:/oi ||
+	$data =~ /FAX:/oi ||
+	$data =~ /:\/\//o ) {
 	return 1;
     }
 
     # -- fukachan ( usenet style signature ? )
     # // fukachan ( signature derived from what ? )
-    if ($data =~ /^--/ || $data =~ /^\/\//) {
+    if ($data =~ /^--/o || $data =~ /^\/\//o) {
 	return 1;
     }
 
@@ -471,7 +469,7 @@ sub is_signature
     $data   = $obj->convert( $data, 'euc-jp' );
 
     # "2-byte @"domain where "@" is a 2-byte "@" character.
-    if ($data =~ /[-A-Za-z0-9]\241\367[-A-Za-z0-9]/) {
+    if ($data =~ /[-A-Za-z0-9]\241\367[-A-Za-z0-9]/o) {
 	return 1;
     }
 
-- 
cgit v1.2.1