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.02";
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 defined' ),
_password => $args{password} || die( 'No password defined' ),
_login_url => $args{login_server} || $LOGIN_URL,
_mail_url => $args{mail_server} || $args{encrypt_session} ? $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() =~ /
=head1 SAMPLE TEST SCRIPTS
below is a listing of some of the tests that I use as I test various features
SAMPLE USAGE
my ( $gmail ) = Mail::Webmail::Gmail->new(
username => 'username', password => 'password', );
### Test Sending Message ####
my $msgid = $gmail->send_message( to => 'testuser@test.com', subject => 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 => 'create' );
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', subject => "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::Gmail::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::Gmail::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 through
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.
Please visit http://code.mincus.com for other projects that I am working on.
=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 Stutz (http://www.use-strict.net)
=back
=head1 BUGS
Please report them.
=cut