-1

I got this perl script from http://blog.mekk.waw.pl/archives/47-Scrap_email_addresses_from_GMail_inbox_or_other_folder.html

I am able to run it on Windows with ActiveState Perl.

Currently when I run it without any parameter, it will display help screen.

How to make it just exit (doesn't need to display help screen) if no parameter (or wrong parameter) is given? I had never done programming in perl before, but now I'm in situation need to modify the script to suit my needs. Googling around but find nothing about this.

Thank you for your help!

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();
michaels
  • 23
  • 6

1 Answers1

0

Not quite sure why you'd want the script silently if the parameters are incorrect, but a simple way to exit if less than two parameters are passed is to add

exit if scalar @ARGV < 2;

after the package main; line.

Dan Dascalescu
  • 143,271
  • 52
  • 317
  • 404
  • Dan, thank you, it works! But what if I want it just exit if any wrong parameter given, no matter how many is the parameter? – michaels Mar 02 '14 at 14:12