Net::Google::Authenticate - Login handler for Google services

  Service                       Code
  ----------------------------  -------
  Calendar data API	        cl
  Blogger data API	        blogger
  Google Base data API	        gbase
  Spreadsheets data API	        wise
  Google Apps Provisioning API	apps
  Picasa Web Albums Data API	lh2
  Default Service               xapi

    perldoc Net::Google::Authenticate

package Net::Google::Authenticate;

use warnings;
use strict;

our $VERSION = '0.01';

use Carp;

use base qw( Class::Accessor Class::ErrorHandler );

__PACKAGE__->mk_accessors(qw(

  Email Passwd source _auth

));

sub _valid_accountType { qw( HOSTED GOOGLE HOSTED_OR_GOOGLE ) }

sub _default_accountType { 'HOSTED_OR_GOOGLE' }

sub accountType {

  my $self = shift;

  return $self->SUPER::get( 'accountType' )
    unless @_;

  my $type = uc shift;

  my @valid = _valid_accountType;

  return $self->error( "Invalid accountType: $type" )
    unless grep { $type eq $_ } @valid;

  $self->SUPER::set( 'accountType', $type );

}

sub _valid_service { qw( cl blogger gbase wise apps lh2 xapi ) }

sub _default_service { 'xapi' }

sub service {

  my $self = shift;

  return $self->SUPER::get( 'service' )
    unless @_;

  my $code = lc shift;

  my @known = _valid_service;

  $self->error( "Unknown service code: $code" )
    unless grep { $code eq $_ } @known;

  $self->SUPER::set( 'service', $code );

}

#=head2 logintoken (optional)
#
#Not implemented at this time.
#
#=head2 logincaptcha (optional)
#
#Not implemented at this time.

sub login {

  my $self = shift;

  my @required = qw( accountType Email Passwd service source );

  no warnings 'uninitialized';

  my $missing = join ', ', grep { $self->$_ eq '' } @required;

  return $self->error( "Missing required fields: $missing" )
    if $missing;

  use warnings 'uninitialized';

  my %params = map { ( $_ , $self->$_ ) } @required;

  no warnings 'uninitialized';

  my $r = $self->_ua->post( 'https://www.google.com/accounts/ClientLogin', \%params );

  if ( $r->code == 403 ) {

    my ( $error ) = $r->content =~ m!Error=(.+)(\s+|$)!i;

    return $self->error( "Invalid login: $error (" . _error_code( $error ) . ')' );

  } elsif ( $r->code == 200 ) {

    my ( $auth ) = $r->content =~ m!Auth=(.+)(\s+|$)!i;

    croak 'PANIC: Got a valid response from Google, but can\'t find Auth string'
      if $auth eq '';

    $self->_auth( $auth );

  } else {

    # If we get here then something's up with Google's website
    # http://code.google.com/apis/accounts/AuthForInstalledApps.html#Response
    # or else with our connection.

    croak 'PANIC: Got unexpected response (' . $r->code . ')';

  }
}

{ my %codes = (

    'BadAuthentication'  => 'The login request used a username or password that is not recognized.',

    'NotVerified'        => 'The account email address has not been verified. The user will need to '
                         .  'access their Google account directly to resolve the issue before logging '
			 .  'in using a non-Google application.',

    'TermsNotAgreed'     => 'The user has not agreed to terms. The user will need to access their '
                         .  'Google account directly to resolve the issue before logging in using a '
			 .  'non-Google application.',

    'CaptchaRequired'    => 'A CAPTCHA is required. (A response with this error code will also contain '
                         .  'an image URL and a CAPTCHA token.)',

    'Unknown'            => 'The error is unknown or unspecified; the request contained invalid input '
                         .  'or was malformed.',

    'AccountDeleted'     => 'The user account has been deleted.',

    'AccountDisabled'    => 'The user account has been disabled.',

    'ServiceDisabled'    => 'The user\'s access to the specified service has been disabled. (The user '
                         .  'account may still be valid.)',

    'ServiceUnavailable' => 'The service is not available; try again later.',

  );

  sub _error_code { return exists $codes{ $_[1] } ? $codes{ $_[1] } : $codes{ 'Unknown' } }

  sub _codes { %codes } # This is for testing

}

1; # End of Net::Google::GData