Perl for Windows-如何允许用户输入Gmail电子邮件地址提取器脚本的日期范围

我从

我可以用ActiveState Perl在Windows上运行它

我以前从未用perl进行过编程，但现在我需要修改脚本以满足我的需要

我需要允许用户能够通过日期范围，所以只有在该日期范围的电子邮件地址将被提取。例如，用户可以通过这种方式运行它，从2014年2月1日至2014年2月28日的邮件中提取电子邮件地址：

c:>extractor.pl——登录=abc@gmail.com--password=MyPassW--folder=INBOX--begindate=20140201--enddate=20140228

我发现类似的脚本支持的日期范围在，但我不知道如何组合它们

谢谢你的帮助

package Gmail::ExtractEmails;
use Moose;
use namespace::autoclean;
use Mail::IMAPClient;
use IO::Socket::SSL;
use Email::Address;
use Encode qw(decode encode);
use Text::CSV_XS;

with 'MooseX::Getopt';

has 'folder'  => (is => 'ro', isa => 'Str', default => "INBOX",
                  documentation => "GMail folder to scan (by default INBOX, use --list-folders to check which folders are available)");
has 'csv' => (is => 'ro', isa => 'Str', predicate => 'has_csv',
              documentation => "Name of created .csv file. Printing to stdout if not set");
has 'host'  => (is => 'ro', isa => 'Str', default => "imap.gmail.com",
                documentation => "GMail IMAP hostname (default imap.gmail.com, change if you are using some port mapping or tunelling)");
has 'port'  => (is => 'ro', isa => 'Int', default => 993,
                documentation => "GMail IMAP port (default 993, change if you are using some port mapping or tunelling)");
has 'verbose' => (is => 'rw', isa => 'Bool', default => 0);
has 'list-folders' => (is => 'rw', isa => 'Bool', default => 0, accessor => 'list_folders',
                       documentation => "Just print names of all known folders instead of running normally");
has 'login'   => (is => 'rw', isa => 'Str', required => 1,
                  documentation => "GMail username (either \"SomeBody\@gmail.com\", or \"SomeBody\")");
has 'password' => (is => 'rw', isa => 'Str', required => 1,
                   documentation => "GMail password");

has '_imap' => (is => 'ro', builder => '_build_imap', lazy => 1, init_arg => undef, predicate => '_has_imap');

sub DEMOLISH {
    my $self = shift;
    if($self->_has_imap) {
        $self->_imap->logout;
    }
}

sub _build_imap {
    my $self = shift;

    printf STDERR "Connecting to GMail as %s at %s:%s\n", $self->login, $self->host, $self->port
      if $self->verbose;

    my $socket = IO::Socket::SSL->new(
        Proto => 'tcp',
        PeerAddr => $self->host,
        PeerPort => $self->port);

    my $imap = Mail::IMAPClient->new(
        Socket => $socket,
        Server => $self->host,
        Port => $self->port,
        User => $self->login,
        Password => $self->password,
        Uid => 1,
       )
      or die "Gmail connection failed: $@\n";

    unless($imap->IsAuthenticated()) {
        #use Data::Dumper; print Dumper($imap->Report);
        die "Gmail authorization failed. Check your username and password.\n";
    }
    printf STDERR "... succesfully connected to GMail\n", $self->login
      if $self->verbose;

    return $imap;
}

sub run {
    my $self = shift;

    if($self->list_folders) {
        my $folders = $self->_imap->folders or die "Can't read folders list: " . $self->_imap->LastError . "\n";
        print "Known folders:\n    ", join("\n    ", @$folders), "\n";
        exit(0);
    }

    # Uniquifying emails. email -> label -> count
    my %emails;

    $self->_imap->select($self->folder);
    #my $messages = $self->_imap->fetch_hash("RFC822.HEADER"); # legacy
    #my $messages = $self->_imap->fetch_hash("BODY.PEEK[HEADER.FIELDS (FROM TO CC)]"); # all in one string,
    my $messages = $self->_imap->fetch_hash(
        "BODY.PEEK[HEADER.FIELDS (FROM)]",
        "BODY.PEEK[HEADER.FIELDS (TO)]",
        "BODY.PEEK[HEADER.FIELDS (CC)]"
       );

    foreach my $msg_id (keys %$messages) {
        my $msg_data = $messages->{$msg_id};
        foreach my $key (keys %$msg_data) {
            my @addresses = $self->get_addresses_from_email_field($msg_data->{$key});
            foreach my $a (@addresses) {
                #print STDERR "Found $a->{email} ($a->{label}) in $msg_id\n"
                #  if $self->verbose;
                $emails{ $a->{email} }->{ $a->{label} } += 1;
            }
        }
    }

    my $csv = Text::CSV_XS->new({
        binary => 1, always_quote => 1, auto_diag => 2,
    });

    my $csv_fh;
    if($self->has_csv) {
        open $csv_fh, ">:encoding(utf8)", $self->csv or die "Can't create " . $self->csv . ": $!\n";
    } else {
        open($csv_fh, ">>&STDOUT") or die "Can't rewrite stdout\n";
        binmode($csv_fh, ":encoding(utf8)");
    }

    $csv->combine("E-mail Address", "Name");
    print $csv_fh  $csv->string, "\n";

    foreach my $email (sort keys %emails) {
        $csv->combine($email, grep {$_} sort keys %{$emails{$email}});
        print $csv_fh $csv->string, "\n";
        #print $email, ": ", encode('utf8', join(", ", sort keys %{$emails{$email}})), "\n";
    }

    close $csv_fh or die "Can't save " .  $self->csv . ": $!\n";

    if($self->has_csv) {
        print "Saved to ", $self->csv, "\n"
          if $self->verbose;
    }
}

sub get_addresses_from_email_field {
    my ($self, $text) = @_;
    $text = decode('MIME-Header', $text);   # decode =?UTF-8?... and such
    $text =~ s/[ \r\n]*\Z//;   # strip trailing newlines
    $text =~ s/[ \r\n]+/ /;    # normalize separators to one space
    my @addresses;
    if($text =~ /\A(?:From|To|Cc|CC): *(.*)\Z/s) {
        @addresses = Email::Address->parse($1);
    }
    if($text && ! @addresses) {
        warn "Could not find any sensible address in the following email header:\n$text";
    }

    return map { { email => $_->address, label => $_->phrase || '' } } @addresses;
}

__PACKAGE__->meta->make_immutable;
1;

###########################################################################
# Main
###########################################################################

package main;
use Getopt::Long::Descriptive; # enforce sensible help
use Getopt::Long;
Getopt::Long::Configure("auto_help");

my $app = Gmail::ExtractEmails->new_with_options();
$app->run();

---

下面是一个Perl脚本，它将实现您的要求：

./scrape_addrs-S主机/用户/pwd-m邮箱-a在_日期之后-b在_日期之前

例如：

/刮除地址 -gmail.com:993/user/password -m收件箱 -a 2014年2月24日 -b 2014年2月28日

输出如下所示：

==========================================================
日期2014年2月26日23:07:17+0000
来自“谷歌+”
到rfs@gmail.com
复写的副本tom@xyz.net

---

====================================================

我建议您从学习一些perl开始。看