File Coverage

lib/Net/Google/Authenticate.pm

Criterion	Covered	Total	%
statement	21	56	37.5
branch	0	18	0.0
condition			n/a
subroutine	7	16	43.7
pod	3	3	100.0
total	31	93	33.3

package Net::Google::Authenticate;

# ABSTRACT: would go here

use warnings;
use strict;

our $VERSION = '0.03'; # VERSION


use Carp;

## no critic( Tics::ProhibitUseBase )
use base qw( Class::Accessor Class::ErrorHandler );

## no critic( Modules::RequireExplicitInclusion )
__PACKAGE__->mk_accessors( qw(

    Email Passwd source _auth

) );
## use critic


sub _valid_accountType { return qw( HOSTED GOOGLE HOSTED_OR_GOOGLE ) }

sub _default_accountType { return 'HOSTED_OR_GOOGLE' } ## no critic( Subroutines::ProhibitUnusedPrivateSubroutines )

sub accountType { ## no critic( Subroutines::RequireArgUnpacking )

  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;

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

}


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

sub _default_service { return 'xapi' } ## no critic( Subroutines::ProhibitUnusedPrivateSubroutines )

sub service { ## no strict( Subroutines::RequireArgUnpacking )

  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;

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

}

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


sub login { ## no critic( Subroutines::RequireFinalReturn )

  my $self = shift;

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

  ## no critic( TestingAndDebugging::ProhibitNoWarnings )
  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 ) { ## no critic( ValuesAndExpressions::ProhibitMagicNumbers )

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

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

  } elsif ( $r->code == 200 ) { ## no critic( ValuesAndExpressions::ProhibitMagicNumbers )

    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 . ')';

  }
} ## end sub login


{
  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' };
  } ## no critic( Subroutines::RequireArgUnpacking )

  sub _codes { return %codes } ## no critic( Subroutines::ProhibitUnusedPrivateSubroutines )

}

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

__END__