The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
package Email::Send::Gmail;
use strict;
use warnings;
use Carp qw(croak);
use Email::Address;
use Net::SMTP::SSL;

our $VERSION = '0.33';

sub is_available {
    my ( $class, %args ) = @_;
    return 1;
}

sub get_env_sender {
    my ( $class, $message ) = @_;

    my $from
        = ( Email::Address->parse( $message->header('From') ) )[0]->address;
}

sub get_env_recipients {
    my ( $class, $message ) = @_;

    my %to = map { $_->address => 1 }
        map { Email::Address->parse( $message->header($_) ) } qw(To Cc Bcc);

    return keys %to;
}

# mostly cribbed from Email::Send::SMTP
sub send {
    my ( $class, $message, @args ) = @_;
    my %args = @args;
    my ( $username, $password ) = @args{qw[username password]};
    my $smtp = Net::SMTP::SSL->new(
        'smtp.gmail.com',
        Port  => 465,
        Debug => 0,
        )
        || croak(
        'Email::Send::Gmail: error connecting to server smtp.gmail.com');

    $smtp->auth( $username, $password )
        or
        croak("Email::Send::Gmail: error authenticating username $username");
        
    my @bad;
    eval {
        my $from = $class->get_env_sender($message);

        $smtp->mail($from)
            || croak("Email::Send::Gmail: error sending 'from' $from");

        my @to = $class->get_env_recipients($message);

        my @ok = $smtp->to( @to, { SkipBad => 1 } )
            || croak("Email::Send::Gmail: error sending 'to' @to");

        if ( @to != @ok ) {
            my %to;
            @to{@to} = (1) x @to;
            delete @to{@ok};
            @bad = keys %to;
        }

        croak("Email::Send::Gmail: no valid recipients") if @bad == @to;
    };

    croak($@) if $@;

    croak("Email::Send::Gmail: error sending data")
        unless $smtp->data( $message->as_string );

    $smtp->quit || croak("Email::Send::Gmail: error sending 'quit'");
    return 1;
}

1;

__END__

=head1 NAME

Email::Send::Gmail - Send Messages using Gmail

=head1 SYNOPSIS

  #!/usr/bin/perl
  use strict;
  use warnings;
  use Email::Send;
  use Email::Send::Gmail;
  use Email::Simple::Creator;

  my $email = Email::Simple->create(
      header => [
          From    => 'magic_monitoring@gmail.com',
          To      => 'acme@astray.com',
          Subject => 'Server down',
      ],
      body => 'The server is down. Start panicing.',
  );

  my $sender = Email::Send->new(
      {   mailer      => 'Gmail',
          mailer_args => [
              username => 'magic_monitoring@gmail.com',
              password => 'XXX',
          ]
      }
  );
  eval { $sender->send($email) };
  die "Error sending email: $@" if $@;

=head1 DESCRIPTION

Gmail is a free Web-based email service provided by Google. This
module is a mailer for C<Email::Send> that sends a message using
Gmail's authenticated SSL SMTP service. You must have a Gmail
account and you should send emails 'From' that account.
 
You should pass in the username and password for the Gmail account.
Sending emails can fail for many reasons and this module croaks
upon any errors.

=head2 ENVELOPE GENERATION

The envelope sender and recipients are, by default, generated by looking at the
From, To, Cc, and Bcc headers.  This behavior can be modified by replacing the
C<get_env_sender> and C<get_env_recipients> methods, both of which receive the
Email::Simple object and their only parameter, and return email addresses.

=head1 SEE ALSO

L<Email::Send>

=head1 COPYRIGHT

Copyright (C) 2008, Leon Brocard

=head1 LICENSE

This module is free software; you can redistribute it or modify it
under the same terms as Perl itself.

=cut