root/gsdl/trunk/perllib/plugins/EmailAddressExtractor.pm @ 19541

Revision 19541, 3.7 KB (checked in by kjdon, 11 years ago)

changed metadata name from emailAddress to EmailAddress?

  • Property svn:executable set to *
Line 
1###########################################################################
2#
3# EmailAddressExtractor - helper plugin that extracts email addresses from text
4#
5# A component of the Greenstone digital library software
6# from the New Zealand Digital Library Project at the
7# University of Waikato, New Zealand.
8#
9# Copyright (C) 2008 New Zealand Digital Library Project
10#
11# This program is free software; you can redistribute it and/or modify
12# it under the terms of the GNU General Public License as published by
13# the Free Software Foundation; either version 2 of the License, or
14# (at your option) any later version.
15#
16# This program is distributed in the hope that it will be useful,
17# but WITHOUT ANY WARRANTY; without even the implied warranty of
18# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
19# GNU General Public License for more details.
20#
21# You should have received a copy of the GNU General Public License
22# along with this program; if not, write to the Free Software
23# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
24#
25###########################################################################
26
27package EmailAddressExtractor;
28
29use PrintInfo;
30use strict;
31
32BEGIN {
33    @EmailAddressExtractor::ISA = ('PrintInfo');
34}
35
36my $arguments = [
37      { 'name' => "extract_email",
38    'desc' => "{EmailAddressExtractor.extract_email}",
39    'type' => "flag",
40    'reqd' => "no" },
41      { 'name' => "new_extract_email",
42    'desc' => "",
43    'type' => "flag",
44    'reqd' => "no",
45    'hiddengli' => "yes" }
46         ];
47
48my $options = { 'name'     => "EmailAddressExtractor",
49        'desc'     => "{EmailAddressExtractor.desc}",
50        'abstract' => "yes",
51        'inherits' => "yes",
52        'args'     => $arguments };
53
54
55sub new {
56    my ($class) = shift (@_);
57    my ($pluginlist,$inputargs,$hashArgOptLists) = @_;
58    push(@$pluginlist, $class);
59
60    push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});
61    push(@{$hashArgOptLists->{"OptList"}},$options);
62
63    my $self = new PrintInfo($pluginlist, $inputargs, $hashArgOptLists, 1);
64
65    return bless $self, $class;
66
67}
68
69# extract metadata
70sub extract_email_metadata {
71
72    my $self = shift (@_);
73    my ($doc_obj) = @_;
74   
75    if ($self->{'extract_email'}) {
76    my $thissection = $doc_obj->get_top_section();
77    while (defined $thissection) {
78        my $text = $doc_obj->get_text($thissection);
79        $self->extract_email (\$text, $doc_obj, $thissection) if $text =~ /./;
80        $thissection = $doc_obj->get_next_section ($thissection);
81    }
82    }
83
84}
85
86sub extract_email {
87    my $self = shift (@_);
88    my ($textref, $doc_obj, $thissection) = @_;
89    my $outhandle = $self->{'outhandle'};
90
91    gsprintf($outhandle, " {EmailAddressExtractor.extracting_emails}...\n")
92    if ($self->{'verbosity'} > 2);
93   
94    my @email = ($$textref =~ m/([-a-z0-9\.@+_=]+@(?:[-a-z0-9]+\.)+(?:com|org|edu|mil|int|net|[a-z][a-z]))/g);
95    @email = sort @email;
96   
97#    if($self->{"new_extract_email"} == 0)
98#    {
99#    my @email2 = ();
100#    foreach my $address (@email)
101#   {
102#   if (!(join(" ",@email2) =~ m/(^| )$address( |$)/ ))
103#       {
104#       push @email2, $address;
105#       $doc_obj->add_utf8_metadata ($thissection, "EmailAddress", $address);
106#       # print $outhandle "  extracting $address\n"
107#       &gsprintf($outhandle, "  {AutoExtractMetadata.extracting} $address\n")
108#           if ($self->{'verbosity'} > 3);
109#       }
110#   }
111#    }
112#    else
113#    {
114    my $hashExistMail = {};
115    foreach my $address (@email) {
116    if (!(defined $hashExistMail->{$address}))
117    {
118        $hashExistMail->{$address} = 1;
119        $doc_obj->add_utf8_metadata ($thissection, "EmailAddress", $address);
120        gsprintf($outhandle, "  {AutoExtractMetadata.extracting} $address\n")
121        if ($self->{'verbosity'} > 3);
122    }
123    }
124    gsprintf($outhandle, " {EmailAddressExtractor.done_email_extract}\n")
125    if ($self->{'verbosity'} > 2);
126}
127
128
1291;
Note: See TracBrowser for help on using the browser.