use Mail::Bounce::FixBrokenAddress to clean up address

Mail::Bounce::FixBrokenAddress class provides irrgular
address handlings, so handles domain/MTA specific addresses.
For example, nifty.ne.jp, webtv.ne.jp, ...

2 files changed, 90 insertions, 8 deletions

diff --git a/fml/lib/Mail/Bounce.pm b/fml/lib/Mail/Bounce.pm
index 5dc7f2da..e1cd0d3a 100644
--- a/fml/lib/Mail/Bounce.pm
+++ b/fml/lib/Mail/Bounce.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: Bounce.pm,v 1.11 2001/07/30 14:42:33 fukachan Exp $
+# $FML: Bounce.pm,v 1.12 2001/07/30 23:09:04 fukachan Exp $
 #
 
 package Mail::Bounce;
@@ -253,7 +253,7 @@ It is rarely used.
 
 sub address_clean_up
 {
-    my ($self, $type, $addr) = @_;
+    my ($self, $hint, $addr) = @_;
 
     # nuke predecing and trailing strings around user@domain pattern
     my $prev_addr = $addr;
@@ -270,12 +270,11 @@ sub address_clean_up
 	print "   address_clean_up.out: $addr\n" if $debug;
     } while ($addr ne $prev_addr);
 
-    if ($type eq 'nifty.ne.jp' && $addr !~ /\@/) {
-	$addr . '@nifty.ne.jp';
-    }
-    else {
-	$addr;
-    }
+    # Mail::Bounce::FixBrokenAddress class provides irrgular
+    # address handlings, so handles domain/MTA specific addresses.
+    # For example, nifty.ne.jp, webtv.ne.jp, ...
+    use Mail::Bounce::FixBrokenAddress;
+    return Mail::Bounce::FixBrokenAddress::FixIt($hint, $addr);
 }
 
 
diff --git a/fml/lib/Mail/Bounce/FixBrokenAddress.pm b/fml/lib/Mail/Bounce/FixBrokenAddress.pm
new file mode 100644
index 00000000..f8f0a494
--- /dev/null
+++ b/fml/lib/Mail/Bounce/FixBrokenAddress.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: DSN.pm,v 1.8 2001/07/30 23:09:04 fukachan Exp $
+#
+
+
+package Mail::Bounce::FixBrokenAddress;
+
+use strict;
+use vars qw(@ISA @EXPORT @EXPORT_OK $AUTOLOAD);
+use Carp;
+
+my $debug = $ENV{'debug'} ? 1 : 0;
+
+@ISA = qw(Mail::Bounce);
+
+
+=head1 NAME
+
+Mail::Bounce::FixBrokenAddress - handles irregular error message
+
+=head1 SYNOPSIS
+
+See C<Mail::Bounce> for more details.
+
+=head1 DESCRIPTION
+
+See C<Mail::Bounce> for more details.
+
+=head1 ERROR EXAMPLE
+
+
+=cut
+
+
+sub FixIt
+{
+    my ($hint, $addr) = @_;
+
+    print STDERR "Fixit($hint, $addr)\n";
+
+    # error address from nifty.ne.jp has no domain part ;)
+    if ($hint eq 'nifty.ne.jp' && $addr !~ /\@/) {
+	return( $addr . '@nifty.ne.jp' );
+    }
+    # looks like URL for DB
+    # e.g. errorperson?user-id=102624708&subscriber-id=94219786@webtv.ne.jp
+    elsif ($hint =~ /webtv.ne.jp/ && $addr =~ /\?/) {
+	if ($addr =~ /^(\S+)\?/) {
+	    return( $1 .'@webtv.ne.jp' );
+	}
+    }
+    # return $addr itself by default (not match anything)
+    else {
+	return $addr;
+    }
+}
+
+
+=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
+
+Mail::Bounce::FixBrokenAddress appeared in fml5 mailing list driver package.
+See C<http://www.fml.org/> for more details.
+
+=cut
+
+
+1;