WWW::YouTube::Authenticate - Login handler for Google services

  Service                       Code
  ----------------------------  -------
  YouTube data API	        youtube
  Default Service               youtube

    perldoc WWW::YouTube::Authenticate

package WWW::YouTube::Authenticate;

use warnings;
use strict;

#our $VERSION = '0.01';
#For CVS , use following line
our $VERSION=sprintf("%d.%04d", q$Revision: 2008.0728 $ =~ /(\d+)\.(\d+)/);

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( youtube ) }

sub _default_service { 'youtube' }

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/youtube/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{ $_[0] } ? $codes{ $_[0] } : $codes{ 'Unknown' } }

  sub _codes { %codes } # This is for testing

}

1; # End of WWW::YouTube::Authenticate