【问题标题】:How to disable help screen on perl for Windows如何在 perl for Windows 上禁用帮助屏幕
【发布时间】:2014-03-02 13:46:15
【问题描述】:

我从http://blog.mekk.waw.pl/archives/47-Scrap_email_addresses_from_GMail_inbox_or_other_folder.html得到这个 perl 脚本

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

目前当我不带任何参数运行它时,它会显示帮助屏幕。

如果没有给出参数(或错误的参数),如何让它退出(不需要显示帮助屏幕)?我以前从未在 perl 中进行过编程,但现在我需要修改脚本以满足我的需要。谷歌搜索,但一无所获。

感谢您的帮助!

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 moose


    【解决方案1】:

    不太清楚为什么如果参数不正确,为什么要静默脚本,但是如果传递的参数少于两个,则退出的一种简单方法是添加

    exit if scalar @ARGV < 2;
    

    package main; 行之后。

    【讨论】:

    • 丹,谢谢,它有效!但是,如果我希望它在给出任何错误参数时退出,不管参数有多少?
    猜你喜欢
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    相关资源
    最近更新 更多