File Coverage

blib/lib/Authen/GoogleAccount.pm

Criterion	Covered	Total	%
statement	21	21	100.0
branch			n/a
condition			n/a
subroutine	7	7	100.0
pod			n/a
total	28	28	100.0

package Authen::GoogleAccount;

use warnings;
use strict;

=head1 NAME

Authen::GoogleAccount - Simple Authentication with Google Account

=head1 VERSION

Version 0.02

=cut

our $VERSION = '0.02';

=head1 SYNOPSIS

    # step 1
    # redirect to goole to get token
    use CGI;
    use Authen::GoogleAccount;
    my $q = CGI->new;
    my $ga = Authen::GoogleAccount->new;

    # set callback url to verify token
    my $next = "http://www.example.com/googleauth.cgi";
    my $uri_to_login = $ga->uri_to_login($next);

    print $q->redirect($uri_to_login);



    # step 2
    # user will be redirected to http://www.example.com/googleauth.cgi?token=(token)
    # get token with CGI.pm and give it to verify()
    use CGI;
    use Authen::GoogleAccount;

    my $google_base_data_api_key = "fwioe2fqwoajieqawerq123ae...";

    my $q = CGI->new;
    my $ga = Authen::GoogleAccount->new(
    	key => $google_base_data_api_key,
    );

    my $token = $q->param('token');

    $ga->verify($token) or die $ga->errstr;
    print "login succeeded\n";
    print $ga->name, " ", $ga->email, "\n";
    #"email" may be unique.



=head1 FUNCTIONS

=head2 new(key => $google_base_data_api_key)

Creates a new object. Requires Google Base data API Key. L

=head2 uri_to_login($next)

Creates a URI to login Google Account.

User will be redirected to $next with token after a successful login.

=head2 verify($token)

Verifies given token and returns true when the token is successfully verified.

=head2 name

Returns user name.

=head2 email

Returns user email("anon-~~~~@base.google.com"). It may be unique.

=head2 errstr

Returns error message.

=head2 delete_item

=head2 get_item

=head2 post_item

=head2 upgrade_to_session_token

=head2 revoke_session_token

=head2 init

=head1 AUTHOR

Hogeist, C<<  >>, L

=head1 BUGS

Please report any bugs or feature requests to
C, or through the web interface at
L.
I will be notified, and then you'll automatically be notified of progress on
your bug as I make changes.

=head1 SUPPORT

You can find documentation for this module with the perldoc command.

    perldoc Authen::GoogleAccount

You can also look for information at:

=over 4

=item * AnnoCPAN: Annotated CPAN documentation

L

=item * CPAN Ratings

L

=item * RT: CPAN's request tracker

L

=item * Search CPAN

L

=back


=head1 COPYRIGHT & LICENSE

Copyright 2007 Hogeist, all rights reserved.

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

=cut
















use URI::Escape;
use LWP::UserAgent;
use HTTP::Request;
use Data::Dumper;
#use Smart::Comments;
use base qw(Class::Accessor::Fast);

__PACKAGE__->mk_accessors( qw/session_token base_key enable_session errstr name email/ );


my $insert_xml = << "END_OF_INSERT_XML";


  xmlns:g='http://base.google.com/ns/1.0'>

  Authen::GoogleAccount Temporary Data
  It will be deleted automatically.

  Jobs
  hoge hoge

END_OF_INSERT_XML


sub new {
	my $class = shift;
	my $self = {};
	bless $self, $class;
	$self->init(@_);
	return $self;
}

sub init {
	my $self = shift;
	my %fields = @_;

	$self->base_key($fields{key});
	$self->enable_session(1);
}

sub uri_to_login {
	my $self = shift;
	my ($next) = @_;
	my $scope = 'http://www.google.com/base/';

	return 'https://www.google.com/accounts/AuthSubRequest'
		. '?scope=' . uri_escape($scope)
		. '&session=' . 1
		. '&next=' . uri_escape($next);
}

sub verify {
	my $self = shift;
	my $token = shift;
	my $debug = shift;



	if($self->enable_session){
		if(!$debug){
			$self->upgrade_to_session_token($token) or return 0;
		}
		else{
			$self->session_token($token);
		}

		my $item = $self->post_item() or return 0;
		$self->get_item($item) or return 0;

		$self->revoke_session_token() if(!$debug);

		return 1;
	}
	else{
		#depreciated...
		my $ua = LWP::UserAgent->new();
		my $res = $ua->get(
			'https://www.google.com/accounts/AuthSubTokenInfo',
			'Authorization' => 'AuthSub token="' . $token . '"',
		);
		if ($res->is_success){
			return 1;
		}
		else{
			$self->errstr( $res->message );
			return 0;
		}
	}
}


sub upgrade_to_session_token {
	my $self = shift;
	my $token = shift;

	my $ua = LWP::UserAgent->new();
	my $res = $ua->get(
		'https://www.google.com/accounts/AuthSubSessionToken',
		'Content-Type' => 'application/x-www-form-urlencoded',
		'Authorization' => 'AuthSub token="' . $token . '"',
	);
	if ($res->is_success and $res->content =~ /^Token=(.+)$/){
		$self->session_token($1);
		return 1;
	}
	else{
		$self->errstr("failure of getting session token.($token)");
		return 0;
	}
}

sub revoke_session_token {
	my $self = shift;

	my $ua = LWP::UserAgent->new();
	my $res = $ua->get(
		'https://www.google.com/accounts/AuthSubRevokeToken',
		'Content-Type' => 'application/x-www-form-urlencoded',
		'Authorization' => 'AuthSub token="' . $self->session_token . '"',
	);
	if ($res->is_success){
		return 1;
	}
	else{
		return 0;
	}
}

sub post_item {
	my $self = shift;

	my $ua = LWP::UserAgent->new();
	my $req = HTTP::Request->new(
		'POST',
		'http://www.google.com/base/feeds/items/',
	);
	$req->header('Authorization' => 'AuthSub token="' . $self->session_token . '"');
	$req->header('X-Google-Key' => "key=" . $self->base_key);
	$req->header('Content-Type' => "application/atom+xml");
	$req->content($insert_xml);



	my $res = $ua->request($req);
	if ($res->is_success){
		$res->content =~ m{http://www.google.com/base/feeds/items/(\d+)};
		return $1;
	}
	else{
		$self->errstr( $res->message );
		return 0;
	}
}

sub get_item {
	my $self = shift;
	my $item = shift;

	my $ua = LWP::UserAgent->new();
	my $res = $ua->get(
		'http://www.google.com/base/feeds/items/' . $item,
		'Authorization' => 'AuthSub token="' . $self->session_token . '"',
		'X-Google-Key' => "key=" . $self->base_key,
		'Content-Type' => "application/atom+xml",
	);
	if ($res->is_success){
		$res->content =~ m{(.+?)(.+?)};
		$self->name($1);
		$self->email($2);
		return 1;
	}
	else{
		$self->errstr( $res->message );
		return 0;
	}

}


sub delete_item {
	my $self = shift;
	my $item = shift;

	my $ua = LWP::UserAgent->new();
	my $req = HTTP::Request->new(
		'DELETE',
		'http://www.google.com/base/feeds/items/' . $item,
	);
	$req->header('Authorization' => 'AuthSub token="' . $self->session_token . '"');
	$req->header('X-Google-Key' => "key=" . $self->base_key);
	$req->header('Content-Type' => "application/atom+xml");


	my $res = $ua->request($req);
	if ($res->is_success){
		return 1;
	}
	else{
		$self->errstr( $res->message );
		return 0;
	}

}








1; # End of Authen::GoogleAccount