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.04";
our @ISA = qw(Exporter);
our @EXPORT_OK = ();
our @EXPORT = ();
our $USER_AGENT = "User-Agent: Mozilla/5.0 (Windows; U; Windows NT 5.1; en-US; rv:1.7.8) Gecko/20050511 Firefox/1.0.4";
our $MAIL_URL = "http://mail.google.com/mail";
our $SSL_MAIL_URL = "https://mail.google.com/mail";
our $LOGIN_URL = "https://www.google.com/accounts/ServiceLoginBoxAuth?rm=false&service=mail&continue=http://mail.google.com/mail/";
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} || '',
_proxy_enable => 0,
_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+in' );
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 } ) {
my @msgids;
foreach ( @{ $messages } ) {
push( @msgids, $_->{ 'id' } );
}
$gmail->delete_message( msgid => \@msgids, search => 'spam', del_message => 1 );
if ( $gmail->error() ) {
print $gmail->error_msg();
} else {
print "Deleted " . @msgids . " Messages\n";
}
}
###
### Print out all user defined labels
my @labels = $gmail->get_labels();
foreach ( @labels ) {
print "Label: '" . $_ . "'\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' } );
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";
}
###
### Print out space remaining in mailbox
my $remaining = $gmail->size_usage();
print "Remaining: '" . $remaining . "'\n";
###
=head1 AUTHOR INFORMATION
Copyright 2004-2005, Allen Holman. All rights reserved.
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
Address bug reports and comments to:
email: mincus \at cpan \. org
AIM: mincus c03
Website: http://code.mincus.com
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 Stutz (http://www.use-strict.net)
=back
=head1 BUGS
Please report them.
=cut