File Coverage

blib/lib/Email/Find.pm

Criterion	Covered	Total	%
statement	47	48	97.9
branch	3	4	75.0
condition	1	3	33.3
subroutine	12	12	100.0
pod	2	6	33.3
total	65	73	89.0

package Email::Find;

use strict;
use vars qw($VERSION @EXPORT);
$VERSION = "0.10";

# Need qr//.
require 5.005;

use base qw(Exporter);
@EXPORT = qw(find_emails);

use Email::Valid;
use Email::Find::addrspec;
use Mail::Address;

sub addr_regex { $Addr_spec_re }

{
    my $validator = Email::Valid->new(
	'-fudge'      => 0,
	'-fqdn'       => 1,
	'-local_rules' => 0,
	'-mxcheck'    => 0,
    );

    sub do_validate {
	my($self, $addr) = @_;
	$validator->address($addr);
    }
}

sub new {
    my($proto, $callback) = @_;
    my $class = ref $proto || $proto;
    bless { callback => $callback }, $class;
}

sub find {
    my($self, $r_text) = @_;

    my $emails_found = 0;
    my $re = $self->addr_regex;
    $$r_text =~ s{($re)}{
	my($replace, $found) = $self->validate($1);
	$emails_found += $found;
	$replace;
    }eg;
    return $emails_found;
}

sub validate {
    my($self, $orig_match) = @_;

    my $replace;
    my $found = 0;

    # XXX Add cruft handling.
    my($start_cruft) = '';
    my($end_cruft)   = '';


    if( $orig_match =~ s|([),.'";?!]+)$|| ) { #"')){
	$end_cruft = $1;
    }
    if( my $email = $self->do_validate($orig_match) ) {
	$email = Mail::Address->new('', $email);
	$found++;
	$replace = $start_cruft . $self->{callback}->($email, $orig_match) . $end_cruft;
    }
    else {
	# XXX Again with the cruft!
	$replace = $start_cruft . $orig_match . $end_cruft;
    }
    return $replace, $found;
}

# backward comaptibility
sub find_emails(\$&) {
    my($r_text, $callback) = @_;
    my $finder = __PACKAGE__->new($callback);
    $finder->find($r_text);
}

1;
__END__