package Mail::Address::MobileJp;

use strict;
use vars qw($VERSION);
$VERSION = '0.08';

BEGIN {
    require Exporter;
    @Mail::Address::MobileJp::ISA    = qw(Exporter);
    @Mail::Address::MobileJp::EXPORT = qw(is_mobile_jp is_imode is_vodafone is_ezweb is_softbank);
}

# This regex is generated using http://www.mag2.com/faq/mobile.htm

my $regex_mobile = qr@^(?:
dct\.dion\.ne\.jp|
tct\.dion\.ne\.jp|
hct\.dion\.ne\.jp|
kct\.dion\.ne\.jp|
cct\.dion\.ne\.jp|
sct\.dion\.ne\.jp|
qct\.dion\.ne\.jp|
oct\.dion\.ne\.jp|
email\.sky\.tdp\.ne\.jp|
email\.sky\.kdp\.ne\.jp|
email\.sky\.cdp\.ne\.jp|
sky\.tu\-ka\.ne\.jp|
cara\.tu\-ka\.ne\.jp|
sky\.tkk\.ne\.jp|
.*\.sky\.tkk\.ne\.jp|
sky\.tkc\.ne\.jp|
.*\.sky\.tkc\.ne\.jp|
email\.sky\.dtg\.ne\.jp|
em\.nttpnet\.ne\.jp|
.*\.em\.nttpnet\.ne\.jp|
cmchuo\.nttpnet\.ne\.jp|
cmhokkaido\.nttpnet\.ne\.jp|
cmtohoku\.nttpnet\.ne\.jp|
cmtokai\.nttpnet\.ne\.jp|
cmkansai\.nttpnet\.ne\.jp|
cmchugoku\.nttpnet\.ne\.jp|
cmshikoku\.nttpnet\.ne\.jp|
cmkyusyu\.nttpnet\.ne\.jp|
pdx\.ne\.jp|
d.\.pdx\.ne\.jp|
wm\.pdx\.ne\.jp|
phone\.ne\.jp|
.*\.mozio\.ne\.jp|
page\.docomonet\.or\.jp|
page\.ttm\.ne\.jp|
pho\.ne\.jp|
moco\.ne\.jp|
emcm\.ne\.jp|
p1\.foomoon\.com|
mnx\.ne\.jp|
.*\.mnx\.ne\.jp|
ez.\.ido\.ne\.jp|
cmail\.ido\.ne\.jp|
.*\.i\-get\.ne\.jp
)$@x; # end of qr@@

my $regex_imode = qr@^(?:
docomo\.ne\.jp
)$@x; # end of qr@@

my $regex_vodafone = qr@^(?:
jp\-[dhtckrnsq]\.ne\.jp|
[dhtckrnsq]\.vodafone\.ne\.jp|
softbank\.ne\.jp|
disney.ne.jp
)$@x; # end of qr@@

my $regex_ezweb = qr@^(?:
ezweb\.ne\.jp|
.*\.ezweb\.ne\.jp
)$@x; # end of qr@@


sub is_imode {
    my $domain = _domain(shift);
    return $domain && $domain =~ /$regex_imode/o;
}

sub is_vodafone {
    my $domain = _domain(shift);
    return $domain && $domain =~ /$regex_vodafone/o;
}

*is_softbank = \&is_vodafone;

sub is_ezweb {
    my $domain = _domain(shift);
    return $domain && $domain =~ /$regex_ezweb/o;
}

sub is_mobile_jp {
    my $domain = _domain(shift);
    return $domain && $domain =~ /(?:$regex_imode|$regex_vodafone|$regex_ezweb|$regex_mobile)/o;
}

sub _domain {
    my $stuff = shift;
    if (ref($stuff) && $stuff->isa('Mail::Address')) {
        return $stuff->host;
    }
    my $i = rindex($stuff, '@');
    return $i >= 0 ? substr($stuff, $i + 1) : undef;
}

1;
__END__

=head1 NAME

Mail::Address::MobileJp - mobile email address in Japan

=head1 SYNOPSIS

  use Mail::Address::MobileJp;

  my $email = '123456789@docomo.ne.jp';
  if (is_mobile_jp($email)) {
      print "$email is mobile email in Japan";
  }

  # extract mobile email address from an array of addresses
  my @mobile = grep { is_mobile_jp($_) } @addr;

=head1 DESCRIPTION

Mail::Address::MobileJp is an utility to detect an email address is
mobile (cellphone) email address or not.

This module should be updated heavily :)

=head1 FUNCTION

This module exports following function(s).

=over 4

=item is_mobile_jp

  $bool = is_mobile_jp($email);

returns whether C<$email> is a mobile email address or not. C<$email>
can be an email string or Mail::Address object.

=item is_imode

  $bool = is_imode($email);

returns whether C<$email> is a i-mode email address or not. C<$email>
can be an email string or Mail::Address object.

=item is_vodafone

  $bool = is_vodafone($email);

returns whether C<$email> is a vodafone(j-sky) email address or not. C<$email>
can be an email string or Mail::Address object.

=item is_ezweb

  $bool = is_ezweb($email);

returns whether C<$email> is a ezweb email address or not. C<$email>
can be an email string or Mail::Address object.

=item is_softbank

  $bool = is_softbank($email);

returns whether C<$email> is a softbank email address or not. C<$email>
can be an email string or Mail::Address object.

=back

=head1 AUTHOR

Tatsuhiko Miyagawa E<lt>miyagawa@bulknews.netE<gt>

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.

=head1 SEE ALSO

L<Mail::Address>, http://www.mag2.com/faq/mobile.htm

=cut