diff options
| -rw-r--r-- | fml/lib/Mail/Bounce.pm | 15 | ||||
| -rw-r--r-- | fml/lib/Mail/Bounce/FixBrokenAddress.pm | 83 |
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; |