File Coverage

blib/lib/Email/Extractor.pm

Criterion	Covered	Total	%
statement	55	76	72.3
branch	4	12	33.3
condition	0	6	0.0
subroutine	12	14	85.7
pod	7	7	100.0
total	78	115	67.8

package Email::Extractor;
$Email::Extractor::VERSION = '0.01';

# ABSTRACT: Fast email crawler


use HTML::Encoding 'encoding_from_html_document';
use List::Compare;
use List::Util qw(uniq);
use Email::Find;
use Mojo::DOM;

use Email::Extractor::Utils qw[:ALL];


sub new {
    my ( $class, %param ) = @_;
    $param{ua} = LWP::UserAgent->new;
    $param{only_lang} = 'ru' if !defined $param{only_lang};
    bless {%param}, $class;
}


sub search_until_attempts {
    my ( $self, $uri, $attempts ) = @_;

    $attempts = 10 if !defined $attempts;
    my $links_checked = 1;
    my $a             = $self->get_emails_from_uri($uri);

    return $a if @$a;

    while ( !@$a && $links_checked <= $attempts )
    {    # but no more than 10 iterations

        my $urls = $crawler->extract_contact_links;
        for my $u (@$urls) {
            $a = $crawler->get_emails_from_uri($u);
            $links_checked++;
        }
    }

    $self->{last_attempts} = $links_checked;
    return $a;
}


sub get_emails_from_uri {
    my ( $self, $addr ) = @_;
    @emails = ();
    $self->{last_uri} = $addr;
    my $text = load_addr_to_str($addr);
    $self->{last_text} =
      $text;    # store html in memory to speed up further search
    my $finder = Email::Find->new(
        sub {
            my ( $email, $orig_email ) = @_;
            push @emails, $orig_email;
        }
    );
    $finder->find( \$text );
    @emails = uniq @emails;
    return \@emails;
}


sub extract_contact_links {
    my ( $self, $text ) = @_;

    $text = $self->{last_text} if !defined $text;

    my $all_links = find_all_links($text);
    $self->{last_all_links} = $all_links;

    # TO-DO: do not remove links on social networks since there can be email too
    if ( $self->{last_uri} ) {
        $all_links = remove_external_links( $all_links, $self->{last_uri} );
        $all_links = absolutize_links_array( $all_links, $self->{last_uri} );
    }

    $all_links = remove_query_params($all_links);
    $all_links = drop_asset_links($all_links);
    $all_links = drop_anchor_links($all_links);

    my @potential_contact_links;

    if ( $self->{only_lang} ) {
        my $contacts_loc = $self->contacts->{ $self->{only_lang} };
        push @potential_contact_links,
          @{ find_links_by_text( $text, $contacts_loc ) };
    }
    else {
        for my $c ( @{ $self->contacts } ) {
            my $res = find_links_by_text( $text, $c );
            push @potential_contact_links, @$res;
        }
    }

    my $grep_url_expr = join( '|', $self->url_with_contacts );
    my @potential_contact_links_by_url =
      grep { $_ =~ /$grep_url_expr/ } @$all_links;

    my @contact_links =
      ( @potential_contact_links_by_url, @potential_contact_links );
    @contact_links = uniq @contact_links;

    $self->{non_contact_links} =
      List::Compare->new( $all_links, \@contact_links )->get_symdiff;

    return \@contact_links;

}


sub contacts {
    return {
        'en' => 'Contacts',
        'ru' => 'Контакты',
    };
}


sub url_with_contacts {
    return qw/
      contacts
      kontaktyi
      kontakty
      about
      /;
}


sub get_encoding {
    my ( $self, $html ) = @_;
    my $html_to_check = $html || $self->{last_text};
    return encoding_from_html_document($html_to_check);
}


sub contacts {
    return {
        'en' => 'Contacts',
        'ru' => 'Контакты',
    };
}


sub get_encoding {
    my ( $self, $html ) = @_;
    my $html_to_check = $html || $self->{last_text};
    return encoding_from_html_document($html_to_check);
}

1;

__END__