Beefy Boxes and Bandwidth Generously Provided by pair Networks
XP is just a number
 
PerlMonks  

Gmail

by mincus (Chaplain)
on Jul 07, 2004 at 17:38 UTC ( [id://372475]=sourcecode: print w/replies, xml ) Need Help??
Category: webstuff
Author/Contact Info mincus \at mincus \dot com
Description: This module is intended to be an API to Gmail webmail.
see Mail::Webmail::Gmail for current version!
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\>&raquo;\</b\>&nbsp;","\<b\>Subject\</b\>","Blurb &hellip;"
+,["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
Replies are listed 'Best First'.
Re: gmail
by rjray (Chaplain) on Jul 09, 2004 at 07:35 UTC

    This is some very nice work. A few notes:

    • You don't refer to the package name consistently in the docs. Or rather, you do, but you consistently refer to it as "gmail" (all lc) rather than "Gmail".
    • When formatted via perldoc or similar, the formatting of the same code is a little wacky. Not sure why this is... the code seems to display OK in my browser, but maybe you are using tabs rather than more conventional 4-space indenting?
    • When fetching message info, Gmail is apparently escaping the < and > characters. You might want to look at those strings when you get the data back and clean them up a bit, just as an ease to users.

    Again, nice work!

    --rjray

      I have a unhealthy liking for tabs that I suppose releasing code publically should break me of.

      In the new version,
    • I have replaced all tabs with 4 spaces
    • Fixed all documentation that called the module gmail instead of Gmail (or even Mail::Webmail::Gmail)
    • Data will now be returned unencoded.

      Thanks for all of your pointers! Its things like this that often get over-looked. Hopefully I will get the new version up sometime today.

        Hmmm... have you seen WWW::Gmail? I just saw it in the daily mailing from use.perl. I'm not sure I'd put a Gmail module in the WWW namespace; the service may in fact be web-based, but they've gone to some effort in their interface to abstract that. I think Mail::Gmail would ultimately be a better place...

        --rjray

Re: Gmail
by mincus (Chaplain) on Jul 15, 2004 at 17:03 UTC
    I have since uploaded this module to CPAN and while I make every effort to update the code here as I update the version on CPAN, I may forget. So please check CPAN for the newest version!
Re: gmail
by ysth (Canon) on Jul 07, 2004 at 19:16 UTC
    Could use some doc.
      Your wish is my command ;)
      Thanks for the feedback ysth. I have been compiling documentation along with the program, but I was unsure if I should post that as POD along with the code. Do monks usually do that?
        Short bits of POD are often included inline with the code. If there are particularly long bits, they can be included at the end of the code, or in a seperate file.
Re: Gmail
by initself (Monk) on Sep 17, 2006 at 19:35 UTC
    Does this work with Gmail for Domains? I made an attempt to send a message from Gmail for Domains account with no luck. As far as I know, it not report any errors but I only checked errors by checking the value that $gmail returned upon sending the message.

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: sourcecode [id://372475]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others wandering the Monastery: (6)
As of 2024-03-19 07:56 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found