package Mail::Webmail::Gmail;
use lib qw(lib);
use strict;
require LWP::UserAgent;
require HTTP::Headers;
require HTTP::Cookies;
require HTTP::Request::Common;
require Crypt::SSLeay;
require Exporter;
our $VERSION = "1.01";
our @ISA = qw(Exporter);
our @EXPORT_OK = ();
our @EXPORT = ();
our $USER_AGENT = "Mozilla/5.0 (Windows; U; Windows NT 5.1; en-US; rv:
+1.7) Gecko/20040626 Firefox/0.8";
our $MAIL_URL = "http://gmail.google.com/gmail";
our $SSL_MAIL_URL = "https://gmail.google.com/gmail";
our $LOGIN_URL = "https://www.google.com/accounts/ServiceLoginBoxAuth?
+service=mail&continue=http://gmail.google.com/gmail";
our %FOLDERS = (
'INBOX' => '^I',
'STARRED' => '^T',
'SPAM' => '^S',
'TRASH' => '^K',
);
sub new {
my $class = shift;
my %args = @_;
my $ua = new LWP::UserAgent( agent => $USER_AGENT, keep_alive => 1
+ );
push( @LWP::Protocol::http::EXTRA_SOCK_OPTS, SendTE => 0 );
my $self = bless {
_username => $args{username} || die( 'No username de
+fined' ),
_password => $args{password} || die( 'No password de
+fined' ),
_login_url => $args{login_server} || $LOGIN_URL,
_mail_url => $args{mail_server} || $args{encrypt_sessio
+n} ? $SSL_MAIL_URL : $MAIL_URL,
_proxy_user => $args{proxy_username}|| '',
_proxy_pass => $args{proxy_password}|| '',
_proxy_name => $args{proxy_name} || '',
_logged_in => 0,
_err_str => '',
_cookies => { },
_ua => $ua,
_debug_level => 0,
_error => 0,
}, $class;
if ( defined( $args{proxy_name} ) ) {
$self->{_proxy_enable}++;
if ( defined( $args{proxy_username} ) && defined( $args{proxy_
+password} ) ) {
$self->{_proxy_enable}++;
}
}
return $self;
}
sub error {
my ( $self ) = @_;
return( $self->{_error} );
}
sub error_msg {
my ( $self ) = @_;
my $error_msg = $self->{_err_str};
$self->{_error} = 0;
$self->{_err_str} = '';
return( $error_msg );
}
sub login {
my ( $self ) = @_;
return 0 if $self->{_logged_in};
if ( $self->{_proxy_enable} && $self->{_proxy_enable} >= 1 ) {
$ENV{HTTPS_PROXY} = $self->{_proxy_name};
if ( $self->{_proxy_enable} && $self->{_proxy_enable} >= 2 ) {
$ENV{HTTPS_PROXY_USERNAME} = $self->{_proxy_user};
$ENV{HTTPS_PROXY_PASSWORD} = $self->{_proxy_pass};
}
}
my $req = HTTP::Request->new( POST => $self->{_login_url} );
my ( $cookie );
$req->content_type( "application/x-www-form-urlencoded" );
$req->content( 'Email=' . $self->{_username} . '&Passwd=' . $self-
+>{_password} . '&null=Sign%20in' );
my $res = $self->{_ua}->request( $req );
if ( $res->is_success() ) {
update_tokens( $self, $res );
if ( $res->content() =~ /top.location = "(.*)";/ ) {
$req = HTTP::Request->new( GET => "https://www.google.com/
+accounts/$1" );
$req->header( 'Cookie' => $self->{_cookie} );
$res = $self->{_ua}->request( $req );
if ( $res->content() =~ /location.replace\("(.*)"\)/ ) {
update_tokens( $self, $res );
$req = HTTP::Request->new( GET => $1 );
$req->header( 'Cookie' => $self->{_cookie} );
$res = $self->{_ua}->request( $req );
if ( $res->content() =~ /frame name=js src=\/gmail(.*?
+) / ) {
update_tokens( $self, $res );
if ( $self->{_proxy_enable} ) {
if ( $self->{_proxy_enable} >= 1 ) {
$self->{_ua}->proxy( 'http', $self->{_prox
+y_name} );
delete ( $ENV{HTTPS_PROXY} );
}
if ( $self->{_proxy_enable} >= 2 ) {
delete ( $ENV{HTTPS_PROXY_USERNAME} );
delete ( $ENV{HTTPS_PROXY_PASSWORD} );
}
}
$self->{_logged_in} = 1;
get_page( $self, start => '', search => '', view =
+> '', req_url => $self->{_mail_url} . $1 );
return( 1 );
} else {
$self->{_error} = 1;
$self->{_err_str} .= "Error: Could not login with
+those credentials\n";
$self->{_err_str} .= " Additionally, HTTP error:
+" . $res->status_line . "\n";
return;
}
} else {
$self->{_error} = 1;
$self->{_err_str} .= "Error: Could not login with thos
+e credentials\n";
$self->{_err_str} .= " Additionally, HTTP error: " .
+$res->status_line . "\n";
return;
}
} else {
$self->{_error} = 1;
$self->{_err_str} .= "Error: Could not login with those cr
+edentials\n";
$self->{_err_str} .= " Additionally, HTTP error: " . $res
+->status_line . "\n";
return;
}
} else {
$self->{_error} = 1;
$self->{_err_str} .= "Error: Could not login with those creden
+tials\n";
$self->{_err_str} .= " Additionally, HTTP error: " . $res->st
+atus_line . "\n";
return;
}
}
sub check_login {
my ( $self ) = @_;
if ( !$self->{_logged_in} ) {
unless ( $self->login() ) {
$self->{_error} = 1;
$self->{_err_str} .= "Error: Could not Login.\n";
return;
}
}
return ( $self->{_logged_in} );
}
sub update_tokens {
my ( $self, $res ) = @_;
my $previous = $res->previous();
if ( $previous ) {
update_tokens( $self, $previous );
}
my $header = $res->header( 'Set-Cookie' );
if ( defined( $header ) ) {
my ( @cookies ) = split( ',', $header );
foreach( @cookies ) {
$_ =~ s/^\s*//;
if ( $_ =~ /(.*?)=(.*?);/ ) {
if ( $2 eq '' ) {
delete( $self->{_cookies}->{$1} );
} else {
unless ( $1 =~ /\s/ ) {
if ( $1 ne '' ) {
$self->{_cookies}->{$1} = $2;
} else {
$self->{_cookies}->{'Session'} = $2;
}
}
}
}
}
$self->{_cookie} = join( '; ', map{ "$_=$self->{_cookies}->{$_
+}"; }( sort keys %{ $self->{_cookies} } ) );
}
}
sub get_page {
my ( $self ) = shift;
my ( %args ) = (
search => 'all',
view => 'tl',
start => 0,
method => '',
req_url => $self->{_mail_url},
@_, );
my ( $res, $req, $req_url );
unless ( check_login( $self ) ) { return };
if ( defined( $args{ 'label' } ) ) {
$args{ 'label' } = validate_label( $self, $args{ 'label' } );
if ( $self->error ) {
return;
} else {
$args{ 'cat' } = $args{ 'label' };
delete( $args{ 'label' } );
$args{ 'search' } = 'cat';
}
}
$req_url = $args{ 'req_url' };
delete( $args{ 'req_url' } );
my ( $url, $method, $view ) = '' x 3;
$method = $args{ 'method' };
delete( $args{ 'method' } );
if ( $method eq 'post' ) {
$view = $args{ 'view' };
delete( $args{ 'view' } );
}
foreach ( keys %args ) {
if ( defined( $args{ $_ } ) ) {
if ( $args{ $_ } eq '' ) {
delete( $args{ $_ } );
}
} else {
delete( $args{ $_ } );
}
}
if ( $method eq 'post' ) {
$req = HTTP::Request::Common::POST( $req_url,
Content_Type => 'multipart/form-data',
Connection => 'Keep-Alive',
'Keep-Alive' => 300,
Cookie => $self->{_cookie},
Content => [ view => $view, %args ] );
if ( $self->{_proxy_enable} && $self->{_proxy_enable} >= 2 ) {
$req->proxy_authorization_basic( $self->{_proxy_user}, $se
+lf->{_proxy_pass} );
}
$res = $self->{_ua}->request( $req );
} else {
$url = join( '&', map{ "$_=$args{ $_ }"; }( keys %args ) );
if ( $url ne '' ) {
$url = '?' . $url;
}
$req = HTTP::Request->new( GET => $req_url . "$url" );
$req->header( 'Cookie' => $self->{_cookie} );
if ( $self->{_proxy_enable} && $self->{_proxy_enable} >= 2 ) {
$req->proxy_authorization_basic( $self->{_proxy_user}, $se
+lf->{_proxy_pass} );
}
$res = $self->{_ua}->request( $req );
}
if ( $res ) {
if ( $res->is_success() ) {
update_tokens( $self, $res );
} elsif ( $res->previous() ) {
update_tokens( $self, $res->previous() );
}
}
return ( $res );
}
sub size_usage {
my ( $self, $res ) = @_;
unless ( check_login( $self ) ) { return };
unless ( $res ) {
$res = get_page( $self );
}
my %functions = %{ parse_page( $self, $res ) };
if ( $self->{_error} ) {
return;
}
if ( $res->is_success() ) {
if ( defined( $functions{ 'qu' } ) ) {
if ( wantarray ) {
pop( @{ $functions{ 'qu' } } );
foreach ( @{ $functions{ 'qu' } } ) {
s/"//g;
}
return( @{ $functions{ 'qu' } } );
} else {
$functions{ 'qu' }[0] =~ /"(.*)\s/;
my $used = $1;
$functions{ 'qu' }[1] =~ /"(.*)\s/;
my $size = $1;
return( $size - $used );
}
} else {
$self->{_error} = 1;
$self->{_err_str} .= "Error: Could not find free space inf
+o.\n";
return;
}
} else {
$self->{_error} = 1;
$self->{_err_str} .= "Error: While requesting: '$res->{_reques
+t}->{_uri}'.\n";
return;
}
}
sub edit_labels {
my ( $self ) = shift;
my ( %args ) = (
start => '',
search => '',
action => '',
label => '',
new_name => '',
view => 'up',
method => 'post',
@_,
);
unless ( check_login( $self ) ) { return };
my $action;
if ( $args{ 'action' } eq 'create' ) {
$action = 'cc_';
$args{ 'new_name' } = '';
} elsif ( $args{ 'action' } eq 'delete' ) {
$action = 'dc_';
$args{ 'new_name' } = '';
} elsif ( $args{ 'action' } eq 'remove' ) {
$action = 'rc_';
$args{ 'new_name' } = '';
} elsif ( $args{ 'action' } eq 'add' ) {
$action = 'ac_';
$args{ 'new_name' } = '';
unless ( defined( $args{ 'msgid' } ) ) {
$self->{_error} = 1;
$self->{_err_str} .= "To add a label to a message, you mus
+t supply a msgid.\n";
return;
} else {
$args{ 't' } = $args{ 'msgid' };
delete( $args{ 'msgid' } );
$args{ 'method' } = 'get';
$args{ 'search' } = 'all';
}
} elsif ( $args{ 'action' } eq 'rename' ) {
$args{ 'new_name' } = '^' . validate_label( $self, $args{ 'new
+_name' } );
if ( $self->{_error} ) {
return;
}
$action = 'nc_';
} else {
$self->{_error} = 1;
$self->{_err_str} .= "Error: No action defined.\n";
return;
}
$args{ 'act' } = $action . validate_label( $self, $args{ 'label' }
+ ) . $args{ 'new_name' };
if ( $self->{_error} ) {
return;
} else {
delete( $args{ 'label' } );
delete( $args{ 'action' } );
$args{ 'at' } = $self->{_cookies}->{GMAIL_AT};
}
my $res = get_page( $self, %args );
if ( $res->is_success() ) {
my %functions = %{ parse_page( $self, $res ) };
if ( defined( $functions{ 'ar' } ) ) {
unless ( $functions{ 'ar' }->[0] ) {
$self->{_error} = 1;
$self->{_err_str} .= "Error: " . $functions{ 'ar' }->[
+1] . "\n";
return;
} else {
return( 1 );
}
} else {
$self->{_error} = 1;
$self->{_err_str} .= "Error: Could not find label success
+message.\n";
return;
}
} else {
$self->{_error} = 1;
$self->{_err_str} .= "Error: While requesting: '$res->{_reques
+t}->{_uri}'.\n";
return;
}
}
sub get_labels {
my ( $self, $res ) = @_;
unless ( check_login( $self ) ) { return };
unless ( $res ) {
$res = get_page( $self, search => 'inbox' );
}
if ( $res->is_success() ) {
my %functions = %{ parse_page( $self, $res ) };
if ( $self->{_error} ) {
return;
}
unless ( defined( $functions{ 'ct' } ) ) {
return;
}
my @fields = @{ extract_fields( $functions{ 'ct' }->[0] ) };
foreach ( @fields ) {
$_ = ${ extract_fields( $_ ) }[0];
$_ = remove_quotes( $_ );
}
if ( @fields ) {
return( @fields );
} else {
$self->{_error} = 1;
$self->{_err_str} .= "Error: No Labels found.\n";
return;
}
} else {
$self->{_error} = 1;
$self->{_err_str} .= "Error: While requesting: '$res->{_reques
+t}->{_uri}'.\n";
return;
}
}
sub validate_label {
my ( $self, $label ) = @_;
if ( defined( $label ) ) {
$label =~ s/^\s//;
$label =~ s/\s$//;
if ( $label =~ /\^/ ) {
my $is_folder = 0;
foreach ( keys %FOLDERS ) {
if ( $FOLDERS{ $_ } eq uc( $label ) ) {
$is_folder = 1;
}
}
unless ( $is_folder ) {
$self->{_error} = 1;
$self->{_err_str} .= "Error: Labels cannot contain the
+ character '^'.\n";
return;
}
}
if ( length( $label ) > 40 ) {
$self->{_error} = 1;
$self->{_err_str} .= "Error: Labels cannot contain more th
+an 40 characters.\n";
return;
}
if ( length( $label ) == 0 ) {
$self->{_error} = 1;
$self->{_err_str} .= "Error: No labels specified.\n";
return;
}
return( $label );
} else {
$self->{_error} = 1;
$self->{_err_str} .= "Error: No labels specified.\n";
return;
}
}
sub edit_star {
my ( $self ) = shift;
my ( %args ) = (
start => '',
action => '',
view => 'up',
@_,
);
unless ( check_login( $self ) ) { return };
my $action;
if ( $args{ 'action' } eq 'add' ) {
$args{ 'act' } = 'st';
} elsif ( $args{ 'action' } eq 'remove' ) {
$args{ 'act' } = 'xst';
} else {
$self->{_error} = 1;
$self->{_err_str} .= "Error: No action defined.\n";
return;
}
delete( $args{ 'action' } );
if ( defined( $args{ 'msgid' } ) ) {
$args{ 'm' } = $args{ 'msgid' };
delete( $args{ 'msgid' } );
} else {
$self->{_error} = 1;
$self->{_err_str} .= "Error: No msgid sent.\n";
return;
}
$args{ 'at' } = $self->{_cookies}->{GMAIL_AT};
my $res = get_page( $self, %args );
if ( $res->is_success() ) {
my %functions = %{ parse_page( $self, $res ) };
if ( defined( $functions{ 'ar' } ) ) {
unless ( $functions{ 'ar' }->[0] ) {
$self->{_error} = 1;
$self->{_err_str} .= "Error: " . $functions{ 'ar' }->[
+1] . "\n";
return;
} else {
return( 1 );
}
} else {
$self->{_error} = 1;
$self->{_err_str} .= "Error: Could not find label success
+message.\n";
return;
}
} else {
$self->{_error} = 1;
$self->{_err_str} .= "Error: While requesting: '$res->{_reques
+t}->{_uri}'.\n";
return;
}
}
sub edit_archive {
my ( $self ) = shift;
my ( %args ) = (
action => '',
msgid => '',
method => 'post',
@_,
);
unless ( check_login( $self ) ) { return };
if ( $args{ 'action' } eq 'archive' ) {
$args{ 'act' } = 'rc_' . lc( $FOLDERS{ 'INBOX' } );
} elsif ( $args{ 'action' } eq 'unarchive' ) {
$args{ 'act' } = 'ib';
} else {
$self->{_error} = 1;
$self->{_err_str} .= "Error: No action defined.\n";
return;
}
delete( $args{ 'action' } );
if ( defined( $args{ 'msgid' } ) ) {
$args{ 't' } = $args{ 'msgid' };
delete( $args{ 'msgid' } );
} else {
$self->{_error} = 1;
$self->{_err_str} .= "Error: No msgid sent.\n";
return;
}
$args{ 'at' } = $self->{_cookies}->{GMAIL_AT};
my $res = get_page( $self, %args );
if ( $res->is_success() ) {
my %functions = %{ parse_page( $self, $res ) };
if ( defined( $functions{ 'ar' } ) ) {
unless ( $functions{ 'ar' }->[0] ) {
$self->{_error} = 1;
$self->{_err_str} .= "Error: " . $functions{ 'ar' }->[
+1] . "\n";
return;
} else {
return( 1 );
}
} else {
$self->{_error} = 1;
$self->{_err_str} .= "Error: Could not find archive succes
+s message.\n";
return;
}
} else {
$self->{_error} = 1;
$self->{_err_str} .= "Error: While requesting: '$res->{_reques
+t}->{_uri}'.\n";
return;
}
}
sub multi_email_addr {
my $array_ref = shift;
my $email_list;
foreach( @{ $array_ref } ) {
$email_list .= "<$_>, ";
}
return( $email_list );
}
sub send_message {
my ( $self ) = shift;
my ( %args ) = (
start => '',
search => '',
action => '',
view => 'sm',
cmid => '1' || $_{cmid},
to => '' || $_{to},
cc => '' || $_{cc},
bcc => '' || $_{bcc},
subject => '' || $_{subject},
msgbody => '' || $_{msgbody},
method => 'post',
@_,
);
unless ( check_login( $self ) ) { return };
$args{ 'at' } = $self->{_cookies}->{GMAIL_AT};
if ( ( $args{to} ne '' ) || ( $args{cc} ne '' ) || ( $args{bcc} ne
+ '' ) ) {
foreach( 'to', 'cc', 'bcc' ) {
if ( ref( $args{$_} ) eq 'ARRAY' ) {
$args{$_} = multi_email_addr( $args{$_} );
}
}
foreach( keys %args ) {
if ( defined( $args{ $_ } ) ) {
$args{ $_ } =~ s/&/%26/g;
}
}
my $res = get_page( $self, %args );
if ( $res->is_success() ) {
my %functions = %{ parse_page( $self, $res ) };
if ( $self->{_error} ) {
return;
}
unless ( defined( $functions{ 'sr' } ) ) {
return;
}
if ( $functions{ 'sr' }->[1] ) {
if ( $functions{ 'sr' }->[3] eq '"0"' ) {
$self->{_error} = 1;
$self->{_err_str} .= "This message has already bee
+n sent.\n";
return;
} else {
$functions{ 'sr' }->[3] =~ s/"//g;
return( $functions{ 'sr' }->[3] );
}
} else {
$self->{_error} = 1;
$self->{_err_str} .= "Message could not be sent.\n";
return;
}
}
} else {
$self->{_error} = 1;
$self->{_err_str} .= "One of the following must be filled out:
+ to, cc, bcc.\n";
return;
}
}
sub get_messages {
my ( $self ) = shift;
my ( %args ) = (
start => 0,
@_, );
my ( $res, $req );
if ( defined( $args{ 'label' } ) ) {
$args{ 'label' } = validate_label( $self, $args{ 'label' } );
if ( $self->error ) {
return;
} else {
$args{ 'cat' } = $args{ 'label' };
delete( $args{ 'label' } );
$args{ 'search' } = 'cat';
}
}
unless ( check_login( $self ) ) { return };
$res = get_page( $self, %args );
if ( $res->is_success() ) {
my %functions = %{ parse_page( $self, $res ) };
if ( $self->{_error} ) {
return;
}
my ( @emails, @letters );
unless ( defined( $functions{ 't' } ) ) {
return;
}
foreach ( @{ $functions{ 't' } } ) {
my @email_line = @{ extract_fields( $_ ) };
my %indv_email;
$indv_email{ 'id' } = remove_quotes( $email_lin
+e[0] );
$indv_email{ 'new' } = remove_quotes( $email_lin
+e[1] );
$indv_email{ 'starred' } = remove_quotes( $email_lin
+e[2] );
$indv_email{ 'date_received' } = remove_quotes( $email_lin
+e[3] );
$indv_email{ 'sender_email' } = remove_quotes( $email_lin
+e[4] );
$indv_email{ 'sender_email' } =~ /'\\>(.*?)\\/;
$indv_email{ 'sender_name' } = remove_quotes( $1 );
$indv_email{ 'sender_email' } =~ /_user_(.*?)\\/;
$indv_email{ 'sender_email' } = remove_quotes( $1 );
$indv_email{ 'subject' } = remove_quotes( $email_lin
+e[6] );
$indv_email{ 'blurb' } = remove_quotes( $email_lin
+e[7] );
$indv_email{ 'labels' } = [ map{ remove_quotes( $_ ) }@{ e
+xtract_fields( $email_line[8] ) } ];
$email_line[9] = remove_quotes( $email_line[9] );
$indv_email{ 'attachments' } = extract_fields( $email_line
+[9] ) if ( $email_line[9] ne '' );
push ( @emails, \%indv_email );
}
if ( @emails == @{ $functions{ 'ts' } }[1] ) {
my $start = $args{ 'start' };
delete( $args{ 'start' } );
if ( $args{ 'cat' } ) {
$args{ 'label' } = $args{ 'cat' };
delete ( $args{ 'cat' } );
delete ( $args{ 'search' } );
}
@emails = ( @emails, @{ get_messages( $self, start => ( $s
+tart + @emails ), %args ) } );
}
return ( \@emails );
} else {
$self->{_error} = 1;
$self->{_err_str} .= "Error: While requesting: '$res->{_reques
+t}->{_uri}'.\n";
return;
}
}
sub delete_message {
my ( $self ) = shift;
my ( %args ) = (
act => 'tr',
method => 'post',
at => '',
del_message => 1,
@_, );
if ( defined( $args{ 'msgid' } ) ) {
$args{ 't' } = $args{ 'msgid' };
delete( $args{ 'msgid' } );
} else {
$self->{_error} = 1;
$self->{_err_str} .= "Error: No msgid provided.\n";
return;
}
my $del_message = $args{ 'del_message' };
delete( $args{ 'del_message' } );
unless ( check_login( $self ) ) { return };
$args{ 'at' } = $self->{_cookies}->{GMAIL_AT};
my $res = get_page( $self, %args );
if ( $res->is_success() ) {
my %functions = %{ parse_page( $self, $res ) };
if ( $self->{_error} ) {
return;
}
unless ( defined( $functions{ 'ar' } ) ) {
return;
}
if ( $functions{ 'ar' }->[0] ) {
if ( $del_message ) {
$args{ 'act' } = 'dl';
$args{ 'search' } = 'trash';
$res = get_page( $self, %args );
if ( $res->is_success() ) {
my %functions = %{ parse_page( $self, $res ) };
if ( $self->{_error} ) {
return;
}
unless ( defined( $functions{ 'ar' } ) ) {
return;
}
if ( $functions{ 'ar' }->[0] ) {
return( 1 );
} else {
$self->{_error} = 1;
$self->{_err_str} .= remove_quotes( $functions
+{ 'ar'}->[1] ) . "\n";
return;
}
} else {
$self->{_error} = 1;
$self->{_err_str} .= "Error: While requesting: '$r
+es->{_request}->{_uri}'.\n";
return;
}
} else {
return( 1 );
}
} else {
$self->{_error} = 1;
$self->{_err_str} .= remove_quotes( $functions{ 'ar'}->[1
+] ) . "\n";
return;
}
} else {
$self->{_error} = 1;
$self->{_err_str} .= "Error: While requesting: '$res->{_reques
+t}->{_uri}'.\n";
return;
}
}
sub get_indv_email {
my ( $self ) = shift;
my ( %args ) = (
view => 'pt',
@_, );
if ( defined( $args{ 'id' } ) && defined( $args{ 'label' } ) ) {
$args{ 'label' } = validate_label( $self, $args{ 'label' } );
if ( $self->error() ) {
return;
} else {
$args{ 'cat' } = $args{ 'label' };
delete( $args{ 'label' } );
$args{ 'search' } = 'cat';
}
$args{ 'th' } = $args{ 'id' };
delete( $args{ 'id' } );
} elsif ( defined( $args{ 'msg' } ) ) {
if ( defined( $args{ 'msg' }->{ 'id' } ) ) {
$args{ 'th' } = $args{ 'msg' }->{ 'id' };
} else {
$self->{_error} = 1;
$self->{_err_str} .= "Error: Not a valid msg reference.\n"
+;
return;
}
if ( defined( @{ $args{ 'msg' }->{ 'labels' } } ) ) {
if ( $args{ 'msg' }->{ 'labels' }->[0] ne '' ) {
$args{ 'label' } = validate_label( $self, $args{ 'msg'
+ }->{ 'labels' }->[0] );
delete( $args{ 'msg' }->{ 'label' } );
if ( $self->error ) {
return;
} else {
if ( $args{ 'label' } =~ /^\^.$/ ) {
$args{ 'label' } = cat_to_search( $args{ 'labe
+l' } );
$args{ 'search' } = $args{ 'label' };
} else {
$args{ 'cat' } = $args{ 'label' };
$args{ 'search' } = 'cat';
}
delete( $args{ 'label' } );
}
}
}
delete( $args{ 'msg' } );
} else {
$self->{_error} = 1;
$self->{_err_str} .= "Error: Must specify either id and label
+or send a reference to a valid message with msg.\n";
return;
}
unless ( check_login( $self ) ) { return };
my $res = get_page( $self, %args );
if ( $res->is_success() ) {
my %functions = %{ parse_page( $self, $res ) };
if ( defined( $functions{ 'mi' } ) ) {
my %messages;
my @thread;
foreach ( @{ $functions{ 'mi' } } ) {
my %message;
my @email = @{ extract_fields( $_ ) };
$email[2] = remove_quotes( $email[2] );
if ( $email[16] ne '' ) {
my @attachments = @{ extract_fields( $email[16] )
+};
my @files;
foreach ( @attachments ) {
my @attachment = @{ extract_fields( $_ ) };
my %indv_attachment;
$indv_attachment{ 'id' } = remove_quotes
+( $attachment[0] );
$indv_attachment{ 'name' } = remove_quotes
+( $attachment[1] );
$indv_attachment{ 'encoding' } = remove_quotes
+( $attachment[2] );
$indv_attachment{ 'th' } = $email[2];
push( @files, \%indv_attachment );
}
$message{ 'attachments' } = \@files;
}
$message{ 'id' } = $email[2];
$message{ 'sender' } = remove_quotes( $email[6] );
$message{ 'sent' } = remove_quotes( $email[8] );
$message{ 'to' } = remove_quotes( $email[9] );
$message{ 'read' } = remove_quotes( $email[13] );
$message{ 'subject' } = remove_quotes( $email[14] );
if ( $args{ 'th' } eq $email[2] ) {
foreach ( @{ $functions{ 'mb' } } ) {
my $body = extract_fields( $_ );
$message{ 'body' } .= $body->[0];
}
if ( defined( $functions{ 'cs' } ) ) {
if ( $functions{ 'cs' }[8] ne '' ) {
$message{ 'ads' } = get_ads( $self, adkey
+=> remove_quotes( $functions{ 'cs' }[8] ) );
}
}
}
$messages{ $email[2] } = \%message;
}
return ( \%messages );
}
} else {
$self->{_error} = 1;
$self->{_err_str} .= "Error: While requesting: '$res->{_reques
+t}->{_uri}'.\n";
return;
}
}
sub get_mime_email {
my ( $self ) = shift;
my ( %args ) = (
view => 'om',
@_, );
if ( defined( $args{ 'id' } ) && defined( $args{ 'label' } ) ) {
$args{ 'label' } = validate_label( $self, $args{ 'label' } );
if ( $self->error() ) {
return;
} else {
$args{ 'cat' } = $args{ 'label' };
delete( $args{ 'label' } );
$args{ 'search' } = 'cat';
}
$args{ 'th' } = $args{ 'id' };
delete( $args{ 'id' } );
} elsif ( defined( $args{ 'msg' } ) ) {
if ( defined( $args{ 'msg' }->{ 'id' } ) ) {
$args{ 'th' } = $args{ 'msg' }->{ 'id' };
} else {
$self->{_error} = 1;
$self->{_err_str} .= "Error: Not a valid msg reference.\n"
+;
return;
}
if ( defined( @{ $args{ 'msg' }->{ 'labels' } } ) ) {
if ( $args{ 'msg' }->{ 'labels' }->[0] ne '' ) {
$args{ 'label' } = validate_label( $self, $args{ 'msg'
+ }->{ 'labels' }->[0] );
delete( $args{ 'msg' }->{ 'label' } );
if ( $self->error ) {
return;
} else {
if ( $args{ 'label' } =~ /^\^.$/ ) {
$args{ 'label' } = cat_to_search( $args{ 'labe
+l' } );
$args{ 'search' } = $args{ 'label' };
} else {
$args{ 'cat' } = $args{ 'label' };
$args{ 'search' } = 'cat';
}
delete( $args{ 'label' } );
}
}
}
delete( $args{ 'msg' } );
} else {
$self->{_error} = 1;
$self->{_err_str} .= "Error: Must specify either id and label
+or send a reference to a valid message with msg.\n";
return;
}
unless ( check_login( $self ) ) { return };
my $res = get_page( $self, %args );
if ( $res->is_success() ) {
my $content = $res->content;
$content =~ s/\r\n/\n/g;
$content =~ s/^(\s*\n)+//;
return $content;
} else {
$self->{_error} = 1;
$self->{_err_str} .= "Error: While requesting: '$res->{_reques
+t}->{_uri}'.\n";
return;
}
}
sub get_contacts {
my ( $self ) = shift;
my ( %args ) = (
@_, );
my ( $res, $req );
$args{ 'view' } = 'cl';
$args{ 'search' } = 'contacts';
$args{ 'start' } = undef;
$args{ 'method' } = 'get';
$args{ 'pnl' } = $args{ 'frequent' } ? 'p' : 'a';
delete $args{ 'frequent' };
unless ( check_login( $self ) ) { return };
$res = get_page( $self, %args );
if ( $res->is_success() ) {
my %functions = %{ parse_page( $self, $res ) };
if ( $self->{_error} ) {
return;
}
my ( @contacts );
unless ( defined( $functions{ 'a' } ) ) {
return;
}
foreach ( @{ $functions{ 'a' } } ) {
my @contact_line = @{ extract_fields( $_ ) };
my %indv_contact;
$indv_contact{ 'id' } = remove_quotes( $contact
+_line[0] );
$indv_contact{ 'name1' } = remove_quotes( $contact
+_line[1] );
$indv_contact{ 'name2' } = remove_quotes( $contact
+_line[2] );
$indv_contact{ 'email' } = remove_quotes( $contact
+_line[3] );
$indv_contact{ 'note' } = remove_quotes( $contact
+_line[4] );
push ( @contacts, \%indv_contact );
}
return ( \@contacts );
} else {
$self->{_error} = 1;
$self->{_err_str} .= "Error: While requesting: '$res->{_reques
+t}->{_uri}'.\n";
return;
}
}
sub get_ads {
my ( $self ) = shift;
my ( %args ) = (
adkey => '',
view => 'ad',
search => '',
start => '',
@_, );
unless ( check_login( $self ) ) { return };
if ( $args{ 'adkey' } ne '' ) {
my $res = get_page( $self, %args );
if ( $res->is_success() ) {
my $ad_text = $res->content();
$ad_text =~ s/\n//g;
$ad_text =~ /\[\[(.*?)\]\],/;
$ad_text = $1;
my @indv_ads = @{ extract_fields( $ad_text ) };
my @ads;
foreach ( @indv_ads ) {
my @split_ad = @{ extract_fields( $_ ) };
my %ad_hash = (
title => remove_quotes( $split_ad[0] ),
body => remove_quotes( $split_ad[1] ),
vendor_link => remove_quotes( $split_ad[2] ),
link => remove_quotes( $split_ad[3] ), );
push( @ads, \%ad_hash );
}
return( \@ads );
} else {
$self->{_error} = 1;
$self->{_err_str} .= "Error: " . $res->status_line();
}
} else {
$self->{_error} = 1;
$self->{_err_str} .= "Error: Must send adkey.\n";
}
return;
}
sub get_attachment {
my ( $self ) = shift;
my ( %args ) = (
view => 'att',
disp => 'attd',
search => '',
@_, );
if ( defined( $args{ 'attid' } ) && defined( $args{ 'msgid' } ) )
+{
$args{ 'th' } = $args{ 'msgid' };
delete( $args{ 'msgid' } );
} elsif ( defined( $args{ 'attachment' } ) ) {
if ( defined( $args{ 'attachment' }->{ 'id' } ) ) {
$args{ 'attid' } = $args{ 'attachment' }->{ 'id' };
} else {
$self->{_error} = 1;
$self->{_err_str} .= "Error: Not a valid attachment.1\n";
return;
}
if ( defined( $args{ 'attachment' }->{ 'th' } ) ) {
$args{ 'th' } = $args{ 'attachment' }->{ 'th' };
} else {
$self->{_error} = 1;
$self->{_err_str} .= "Error: Not a valid attachment.2\n";
return;
}
delete( $args{ 'attachment' } );
} else {
$self->{_error} = 1;
$self->{_err_str} .= "Error: Must supply attid and msgid or a
+reference to an attachment through 'attachment'.\n";
return;
}
unless ( check_login( $self ) ) { return };
my $res = get_page( $self, %args );
if ( $res->is_success() ) {
my $attachment = $res->content();
return( \$attachment );
} else {
$self->{_error} = 1;
$self->{_err_str} .= "Error: While requesting attachment: '$re
+s->{_request}->{_uri}'.\n";
return;
}
}
sub update_prefs {
my ( $self ) = shift;
my ( %args ) = (
view => 'tl',
act => 'prefs',
search => 'inbox',
@_, );
unless ( check_login( $self ) ) { return };
$args{ 'at' } = $self->{_cookies}->{GMAIL_AT};
my ( %pref_mappings ) = (
bx_hs => 'keyboard_shortcuts',
ix_nt => 'max_page_size',
bx_sc => 'indicators',
sx_dn => 'display_name',
bx_ns => 'snippets',
sx_rt => 'reply_to',
sx_sg => 'signature', );
my ( %pref_args ) = (
view => 'pr',
pnl => 'g',
search => '',
start => '',
method => '',
);
my $pref_res = get_page( $self, %pref_args );
if ( $pref_res->is_success() ) {
my %functions = %{ parse_page( $self, $pref_res ) };
if ( $self->{_error} ) {
return;
}
unless ( defined( $functions{ 'p' } ) ) {
return;
}
### Delete if equal to the string '' ###
foreach ( 'signature', 'reply_to', 'display_name' ) {
if ( defined( $args{ $_ } ) ) {
if ( $args{ $_ } eq '' ) {
$args{ $_ } = '%0A%0D';
}
}
}
### Load Prefs if not redefined ###
foreach ( @{ $functions{ 'p' } } ) {
my ( @setting ) = @{ extract_fields( $_ ) };
foreach ( @setting ) {
$_ = remove_quotes( $_ );
}
unless ( defined( $args{ $pref_mappings{ $setting[0] } } )
+ ) {
$args{ 'p_' . $setting[0] } = $setting[1];
} else {
$args{ 'p_' . $setting[0] } = $args{ $pref_mappings{ $
+setting[0] } };
}
delete( $args{ $pref_mappings{ $setting[0] } } );
}
### Add preferences to be added ###
my %rev_pref_mappings;
foreach ( keys %pref_mappings ) {
$rev_pref_mappings{ $pref_mappings{ $_ } } = $_;
}
foreach ( keys %args ) {
if ( $rev_pref_mappings{ $_ } ) {
$args{ 'p_' . $rev_pref_mappings{ $_ } } = $args{ $_ }
+;
delete( $args{ $_ } );
}
}
my $res = get_page( $self, %args );
if ( $res->is_success() ) {
my %functions = %{ parse_page( $self, $res ) };
if ( @{ $functions{ 'ar' } }[0] == 1 ) {
return( 1 );
} else {
$self->{_error} = 1;
$self->{_err_str} .= "Error: While updating user prefe
+rences: '" . remove_quotes( @{ $functions{ 'ar' } }[1] ) . "'.\n";
return;
}
} else {
$self->{_error} = 1;
$self->{_err_str} .= "Error: While updating user preferenc
+es: '$res->{_request}->{_uri}'.\n";
return;
}
} else {
$self->{_error} = 1;
$self->{_err_str} .= "Error: While requesting user preferences
+: '$pref_res->{_request}->{_uri}'.\n";
return;
}
}
sub recurse_slash {
my ( $field ) = @_;
my $count_slashes = 0;
my $end_slash = 0;
my $cnt = length( $field );
while ( ( $cnt > 0 ) && ( !$end_slash ) ){
$cnt--;
my $char = substr( $field, $cnt, 1 );
if ( $char eq '\\' ) {
if ( $count_slashes ) {
$count_slashes = 0;
} else {
$count_slashes = 1;
}
} else {
$end_slash = 1;
}
}
return( $count_slashes );
}
sub extract_fields {
my ( $line ) = @_;
my @fields;
my $in_quotes = 0;
my $in_brackets = 0;
my $in_brackets_quotes = 0;
my $delim_count = 0;
my $end_field = 0;
my $field = '';
my $char;
my $cnt;
for ( $cnt=0; $cnt < length( $line ); $cnt++ ) {
$char = substr( $line, $cnt, 1 );
if ( $in_quotes ) {
if ( ( $char eq '"' ) && ( !recurse_slash( $field ) ) ) {
$in_quotes = 0;
$end_field = 1;
}
$field .= $char;
} elsif ( $in_brackets ) {
if ( $in_brackets_quotes ) {
if ( ( $char eq '"' ) && ( !recurse_slash( $field ) )
+) {
$in_brackets_quotes = 0;
}
$field .= $char;
} elsif ( $char eq '"' ) {
$in_brackets_quotes = 1;
$field .= $char;
} else {
if ( $char eq '[' ) {
$delim_count++;
$field .= $char;
} elsif ( $char eq ']' ) {
$delim_count--;
if ( $delim_count == 0 ) {
$in_brackets = 0;
$end_field = 1;
if ( $field eq '' ) {
push( @fields, '' );
}
} else {
$field .= $char;
}
} else {
$field .= $char;
}
}
} elsif ( $char eq '"' ) {
$in_quotes = 1;
$field .= $char;
} elsif ( $char eq '[' ) {
$in_brackets = 1;
$delim_count = 1;
} elsif ( $char ne ',' ) {
$field .= $char;
} elsif ( $char eq ',' ) {
$end_field = 1;
}
if ( $end_field ) {
if ( $field ne '' ) {
push ( @fields, $field );
} $field = '';
$end_field = 0;
}
}
if ( $field ne '' ) {
push ( @fields, $field );
}
return( \@fields );
}
sub remove_quotes {
my ( $field ) = @_;
if ( defined( $field ) ) {
$field =~ s/^"(.*)"$/$1/;
}
return ( $field );
}
sub cat_to_search {
my ( $cat ) = @_;
my %REVERSE_CAT = map{ $FOLDERS{ $_ } => $_ }(keys %FOLDERS);
if ( defined( $REVERSE_CAT{ uc( $cat ) } ) ) {
return( lc( $REVERSE_CAT{ uc( $cat ) } ) );
} else {
return( $cat );
}
}
sub parse_page {
my ( $self, $res ) = @_;
if ( $res->is_success() ) {
my $page;
$res->content() =~ /<!--(.*)\/\/-->/s;
$page = $1;
my ( %functions );
while ( $page =~ /D\((.*?)\);\n/mgs ) {
my $line = $1;
$line =~ s/\n//g;
$line =~ s/^\["(.*?)",?//;
my $function = $1;
$line =~ s/\]$//;
if ( ( uc( $function ) eq 'MI' ) || ( uc( $function ) eq '
+MB' ) ) {
$functions{ $function } .= "[$line],";
} else {
$functions{ $function } .= "$line,";
}
}
foreach ( keys %functions ) {
chop( $functions{ $_ } );
my $fields = extract_fields( $functions{ $_ } );
$functions{ $_ } = $fields;
}
return ( \%functions );
} else {
$self->{_error} = 1;
$self->{_err_str} .= "Error: While requesting: '$res->{_reques
+t}->{_uri}'.\n";
return;
}
}
1;
__END__
=head1 NAME
Mail::Webmail::Gmail - An interface to Google's webmail service
=head1 SYNOPSIS
# Perl script that logs in to Gmail, retrieves the user defined la
+bels
# Then prints out all new messages under the first label
use Mail::Webmail::Gmail;
my $gmail = Mail::Webmail::Gmail->new(
username => 'username', password => 'password',
);
my @labels = $gmail->get_labels();
my $messages = $gmail->get_messages( label => $labels[0] );
foreach ( @{ $messages } ) {
if ( $_->{ 'new' } ) {
print "Subject: " . $_->{ 'subject' } . " / Blurb: " . $_-
+>{ 'blurb' } . "\n";
}
}
=head1 ABSTRACT
This perl module uses objects to make it easy to interface with Gmail.
+ I eventually hope to
implement all of the functionality of the Gmail website, plus addition
+al features.
=head1 DESCRIPTION
Because Gmail is currently in Beta testing, expect this module to brea
+k as they make updates
to thier interface. I will attempt to keep this module in line with t
+he changes they make, but,
if after updating to the newest version of this module, the feature th
+at you require still doesn't
work, please contact me with the issue.
=head2 STARTING A NEW GMAIL SESSION
The standard call for starting a new Gmail session is simply
my $gmail = Mail::Webmail::Gmail->new( username => 'username', pas
+sword => 'password', );
This module does support the use of a proxy server
my $gmail = Mail::Webmail::Gmail->new( username => 'username', pas
+sword => 'password',
proxy_username => 'proxy_username',
proxy_password => 'proxy_password',
proxy_name => 'proxy_server' );
By default, this module only encrypts the logon process. To encrypt t
+he entire session, use
the argument encrypt_session
my $gmail = Mail::Webmail::Gmail->new( username => 'username', pas
+sword => 'password', encrypt_session => 1 );
After that, you are free to start making requests for data.
=head2 RETRIEVING LABELS
Returns an array of all user defined labels.
my @labels = $gmail->get_labels();
=head2 EDITING LABELS
There are five actions that can currently be preformed on labels. As
+a note, this module enforces Gmail's
limits on label creation. A label cannot be over 40 characters, and a
+ label cannot contain the character '^'.
On failure, error and error_msg are set.
#creating new labels.
$gmail->edit_labels( label => 'label_name', action => 'create' );
#renaming existing labels.
$gmail->edit_labels( label => 'label_name', action => 'rename', ne
+w_name => 'renamed_label' );
#deleting labels.
$gmail->edit_labels( label => 'label_name', action => 'delete' );
#adding a label to a message.
$gmail->edit_labels( label => 'label_name', action => 'add', msgid
+ => $message_id );
#removing a label from a message.
$gmail->edit_labels( label => 'label_name', action => 'remove', ms
+gid => $message_id );
=head2 UPDATING PREFERENCES
The following are the seven preferences and the allowed values that ca
+n currently be changed through Mail::Webmail::Gmail
keyboard_shortcuts = ( 0, 1 )
indicators = ( 0, 1 )
snippets = ( 0, 1 )
max_page_size = ( 25, 50, 100 )
display_name = ( '', string value up to 96 Characters )
reply_to = ( '', string value up to 320 Characters )
signature = ( '', string value up to 1000 Characters )
Changing preferences can be accomplished by simply sending the prefere
+nce(s) that you want to change, and the new value.
$gmail->update_prefs( indicators => 0, reply_to => 'test@test.com'
+ );
To delete display_name, reply_to, or signature simply send a blank str
+ing as in the following example.
$gmail->update_prefs( signature => '' );
=head2 STARRING A MESSAGE
To star or unstar a message use these examples
#star
$gmail->edit_star( action => 'add', 'msgid' => $msgid );
#unstar
$gmail->edit_star( action => 'remove', 'msgid' => $msgid );
=head2 ARCHIVING
To archive or unarchive a message use these examples
#archive
$gmail->edit_archive( action => 'archive', 'msgid' => $msgid );
#unarchive
$gmail->edit_archive( action => 'unarchive', 'msgid' => $msgid );
=head2 RETRIEVING MESSAGE LISTS
By default, get_messages returns a reference to an AoH with the messag
+es from the 'all'
folder. To change this behavior you can either send a label
my $messages = $gmail->get_messages( label => 'work' );
Or request a Gmail provided folder using one of the provided variables
'INBOX'
'STARRED'
'SPAM'
'TRASH'
Ex.
my $messages = $gmail->get_messages( label => $Mail::Webmail::Gmai
+l::FOLDERS{ 'INBOX' } );
The Array of hashes is in the following format
$indv_email{ 'id' }
$indv_email{ 'new' }
$indv_email{ 'starred' }
$indv_email{ 'date_received' }
$indv_email{ 'sender_email' }
$indv_email{ 'subject' }
$indv_email{ 'blurb' }
@{ $indv_email{ 'labels' } }
@{ $indv_email{ 'attachments' } }
=head2 SPACE REMAINING
Returns a scalar with the amount of MB remaining in you account.
my $remaining = $gmail->size_usage();
If called in list context, returns an array as follows.
[ Used, Total, Percent Used ]
[ "0 MB", "1000 MB", "0%" ]
=head2 INDIVIDUAL MESSAGES
There are two ways to get an individual message:
By sending a reference to a specific message returned by get_messa
+ges
#prints out the message body for all messages in the starred folde
+r
my $messages = $gmail->get_messages( label => $Mail::Webmail::Gmai
+l::FOLDERS{ 'STARRED' } );
foreach ( @{ $messages } ) {
my $message = $gmail->get_indv_email( msg => $_ );
print "$message->{ $_->{ 'id' } }->{ 'body' }\n";
}
Or by sending a message ID and Label that the message resides in
#retrieve specific email message for review
my $msgid = 'F000000000';
my $message = $gmail->get_indv_email( id => $msgid, label => 'labe
+l01' );
print "$message->{ $msgid }->{ 'body' }\n";
returns a Hash of Hashes containing the data from an individual messag
+e in the following format:
Hash of messages in thread by ID
$indv_email{ 'id' }
$indv_email{ 'sender_email' }
$indv_email{ 'sent' }
$indv_email{ 'to' }
$indv_email{ 'read' }
$indv_email{ 'subject' }
@{ $indv_email{ 'attachments' } }
#If it is the main message in the thread
$indv_email{ 'body' }
%{ $indv_email{ 'ads' } } = (
title => '',
body => '',
vendor_link => '',
link => '', );
=head2 MIME MESSAGES
This will return an individual message in MIME format.
The parameters to this function are the same as get_indv_email.
#prints out the MIME format for all messages in the inbox
my $messages = $gmail->get_messages( label => $Mail::Webmail::Gmai
+l::FOLDERS{ 'INBOX' } );
foreach ( @{ $messages } ) {
my $message = $gmail->get_mime_email( msg => $_ );
print $message
}
returns a string that contains the MIME formatted email.
=head2 RETRIEVING CONTACTS
The get_contacts method returns a reference to an AoH with all of the
Contacts. This can be limited to the 'Frequently Mailed' contacts
with a flag:
my $contacts = $gmail->get_contacts( frequent => 1 );
The Array of hashes is in the following format
$indv_contact{ 'id' }
$indv_contact{ 'name1' }
$indv_contact{ 'name2' }
$indv_contact{ 'email' }
$indv_contact{ 'note' }
=head2 SENDING MAIL
The basic format of sending a message is
$gmail->send_message( to => 'user@domain.com', subject => 'Test Me
+ssage', msgbody => 'This is a test.' );
To send to multiple users, send an arrayref containing all of the user
+s
my $email_addrs = [
'user1@domain.com',
'user2@domain.com',
'user3@domain.com', ];
$gmail->send_message( to => $email_addrs, subject => 'Test Message
+', msgbody => 'This is a test.' );
You may also send mail using cc and bcc.
To attach files to a message
$gmail->send_message( to => 'user@domain.com', subject => 'Test Me
+ssage', msgbody => 'This is a test.', file0 => ["/tmp/foo"], file1 =>
+ ["/tmp/bar"] );
=head2 DELETE MESSAGES
Use the following to move a message to the trash bin
$gmail->delete_message( msgid => $msgid, del_message => 0 );
To permanently delete a message, just send a msgid
$gmail->delete_message( msgid => $msgid );
=head2 GETTING ATTACHMENTS
There are two ways to get an attachment:
By sending a reference to a specific attachment returned by get_in
+dv_email
#creates an array of references to every attachment in your accoun
+t
my $messages = $gmail->get_messages();
my @attachments;
foreach ( @{ $messages } ) {
my $email = $gmail->get_indv_email( msg => $_ );
if ( defined( $email->{ $_->{ 'id' } }->{ 'attachments' } ) )
+{
foreach ( @{ $email->{ $_->{ 'id' } }->{ 'attachments' } }
+ ) {
push( @attachments, $gmail->get_attachment( attachment
+ => $_ ) );
if ( $gmail->error() ) {
print $gmail->error_msg();
}
}
}
}
Or by sending the attachment ID and message ID
#retrieve specific attachment
my $msgid = 'F000000000';
my $attachid = '0.1';
my $attach_ref = $gmail->get_attachment( attid => $attachid, msgid
+ => $msgid );
Returns a reference to a scalar that holds the data from the attachmen
+t.
=head1 SAMPLE GMAIL OUTPUT
This is included so you can get an idea of what the underlying HTML lo
+oks like for
Gmail. It is also included to somewhat document what the current inte
+rface needs to
manipulate to extract data from Gmail.
<html><head><meta content="text/html; charset=UTF-8" http-equiv="c
+ontent-type"></head>
<script>D=(top.js&&top.js.init)?function(d){top.js.P(window,d)}:fu
+nction(){};
if(window==top){top.location='/gmail?search=inbox&view=tl&start=0&
+init=1&zx=VERSION + RANDOM 9 DIGIT NUMBER&fs=1';}
</script><script><!--
D(["v","fc5985703d8fe4f8"]
);
D(["p",["bx_hs","1"]
,["bx_show0","1"]
,["bx_sc","1"]
,["sx_dn","username"]
]
);
D(["i",0]
);
D(["qu","0 MB","1000 MB","0%","#006633"]
);
D(["ds",1,0,0,0,0,0]
);
D(["ct",[["label 1",1]
,["label 2",0]
,["label 3",1]
]
]
);
D(["ts",0,50,10,0,"Inbox","",13]
);
D(["t",["MSG ID",1,0,"\<b\>12:53am\</b\>","\<span id=\'_user_sende
+r@domain.com\'\>Sender Name\</span\>
","\<b\>»\</b\> ","\<b\>Subject\</b\>","Blurb …"
+,["label1","label 2"]
,"attachment name1, attachment name2","MSG ID",0]
]
);
D(["te"]);
//--></script><script>var fp='';</script><script>var loaded=true;D
+(['e']);</script>
=head1 SAMPLE TEST SCRIPTS
below is a listing of some of the tests that I use as I test various f
+eatures
SAMPLE USAGE
my ( $gmail ) = Mail::Webmail::Gmail->new(
username => 'username', password => 'password', );
### Test Sending Message ####
my $msgid = $gmail->send_message( to => 'testuser@test.com', subje
+ct => time(), msgbody => 'Test' );
print "Msgid: $msgid\n";
if ( $msgid ) {
if ( $gmail->error() ) {
print $gmail->error_msg();
} else {
### Create new label ###
my $test_label = "tl_" . time();
$gmail->edit_labels( label => $test_label, action => 'crea
+te' );
if ( $gmail->error() ) {
print $gmail->error_msg();
} else {
### Add this label to our new message ###
$gmail->edit_labels( label => $test_label, action => '
+add', 'msgid' => $msgid );
if ( $gmail->error() ) {
print $gmail->error_msg();
} else {
print "Added label: $test_label to message $msgid\
+n";
}
}
}
}
###
### Move message to trash ###
my $msgid = $gmail->send_message( to => 'testuser@test.com', subje
+ct => "del_" . time(), msgbody => 'Test Delete' );
if ( $gmail->error() ) {
print $gmail->error_msg();
} else {
$gmail->delete_message( msgid => $msgid, del_message => 0 );
if ( $gmail->error() ) {
print $gmail->error_msg();
} else {
print "MSG: $msgid moved to trash\n";
}
}
###
### Delete all SPAM folder messages ###
my $messages = $gmail->get_messages( label => $Mail::Webmail::Gmai
+l::FOLDERS{ 'SPAM' } );
if ( @{ $messages } ) {
foreach ( @{ $messages } ) {
$gmail->delete_message( msgid => $_->{ 'id' }, search => '
+spam', del_message => 1 );
if ( $gmail->error() ) {
print $gmail->error_msg();
} else {
print "MSG: " . $_->{ 'id' } . " deleted\n";
}
}
}
###
### Prints out new messages attached to the first label
my @labels = $gmail->get_labels();
my $messages = $gmail->get_messages( label => $labels[0] );
if ( defined( $messages ) ) {
foreach ( @{ $messages } ) {
if ( $_->{ 'new' } ) {
print "Subject: " . $_->{ 'subject' } . " / Blurb: " .
+ $_->{ 'blurb' } . "\n";
}
}
}
###
### Prints out all attachments
my $messages = $gmail->get_messages();
foreach ( @{ $messages } ) {
my $email = $gmail->get_indv_email( msg => $_ );
if ( defined( $email->{ $_->{ 'id' } }->{ 'attachments' } ) )
+{
foreach ( @{ $email->{ $_->{ 'id' } }->{ 'attachments' } }
+ ) {
print ${ $gmail->get_attachment( attachment => $_ ) }
+. "\n";
if ( $gmail->error() ) {
print $gmail->error_msg();
}
}
}
}
###
### Prints out the vendor link from Ads attached to a message
my $messages = $gmail->get_messages( label => $Mail::Webmail::Gmai
+l::FOLDERS{ 'INBOX' } );
print @{ $messages } . "\n";
foreach ( @{ $messages } ) {
print "ID: " . $_->{ 'id' } . "\n";
my %email = %{ $gmail->get_indv_email( msg => $_ ) };
if ( $email{ $_->{ 'id' } }->{ 'ads' } ) {
my $ads;
foreach $ads ( @{ $email{ $_->{ 'id' } }->{ 'ads' } } ) {
print "AD LINK: $ads->{vendor_link}\n";
}
}
}
###
### Shows different ways to look through your email
my $messages = $gmail->get_messages();
print "By folder\n";
foreach ( keys %Mail::Webmail::Gmail::FOLDERS ) {
print "KEY: $_\n";
my $messages = $gmail->get_messages( label => $Mail::Webmail::
+Gmail::FOLDERS{ $_ } );
print "\t$_:\n";
if ( @{ $messages } ) {
foreach ( @{ $messages } ) {
print "\t\t$_->{ 'subject' }\n";
}
}
}
print "By label\n";
foreach ( $gmail->get_labels() ) {
$messages = $gmail->get_messages( label => $_ );
print "\t$_:\n";
if ( defined( $messages ) ) {
if ( @{ $messages } ) {
foreach ( @{ $messages } ) {
print "\t\t$_->{ 'subject' }\n";
}
}
}
}
print "All (Note: the All folder skips trash)";
$messages = $gmail->get_messages();
if ( @{ $messages } ) {
foreach ( @{ $messages } ) {
print "\t\t$_->{ 'subject' }\n";
}
}
###
### Update preferences
if ( $gmail->update_prefs( signature => 'Test Sig.', max_page_
+size => 100 ) ) {
print "Preferences Updated.\n";
} else {
print "Unable to update preferences.\n";
}
###
### Show all contact email addresses
my ( @contacts ) = @{ $gmail->get_contacts() };
foreach ( @contacts ) {
print $_->{ 'email' } . "\n";
}
###
=head1 AUTHOR INFORMATION
Copyright 2004-2005, Allen Holman. All rights reserved.
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
Address bug reports and comments to: mincus \at cpan \. org. Or throu
+gh
AIM at mincus c03.
When sending bug reports, please provide the version of Gmail.pm, the
+version of
Perl and the name and version of the operating system you are using.
=head1 CREDITS
I'd like to thank the following people who gave me a little direction
+in getting
this module started (whether they know it or not)
=over 4
=item Simon Drabble (Mail::Webmail::Yahoo)
=item Erik F. Kastner (WWW::Scraper::Gmail)
=item Abiel J. (C# Gmail API - http://www.migraineheartache.com/)
=item Daniel
|