r34709 - in /branches/upstream/libnet-google-authsub-perl: ./ current/ current/lib/ current/lib/Net/ current/lib/Net/Google/ current/lib/Net/Google/AuthSub/ current/t/
mogaal-guest at users.alioth.debian.org
mogaal-guest at users.alioth.debian.org
Mon May 4 06:17:58 UTC 2009
Author: mogaal-guest
Date: Mon May 4 06:17:14 2009
New Revision: 34709
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=34709
Log:
[svn-inject] Installing original source of libnet-google-authsub-perl
Added:
branches/upstream/libnet-google-authsub-perl/
branches/upstream/libnet-google-authsub-perl/current/
branches/upstream/libnet-google-authsub-perl/current/Build.PL (with props)
branches/upstream/libnet-google-authsub-perl/current/Changes
branches/upstream/libnet-google-authsub-perl/current/MANIFEST
branches/upstream/libnet-google-authsub-perl/current/META.yml
branches/upstream/libnet-google-authsub-perl/current/Makefile.PL
branches/upstream/libnet-google-authsub-perl/current/lib/
branches/upstream/libnet-google-authsub-perl/current/lib/Net/
branches/upstream/libnet-google-authsub-perl/current/lib/Net/Google/
branches/upstream/libnet-google-authsub-perl/current/lib/Net/Google/AuthSub/
branches/upstream/libnet-google-authsub-perl/current/lib/Net/Google/AuthSub.pm
branches/upstream/libnet-google-authsub-perl/current/lib/Net/Google/AuthSub/Response.pm
branches/upstream/libnet-google-authsub-perl/current/t/
branches/upstream/libnet-google-authsub-perl/current/t/00use.t
branches/upstream/libnet-google-authsub-perl/current/t/pod-coverage.t
branches/upstream/libnet-google-authsub-perl/current/t/pod.t
Added: branches/upstream/libnet-google-authsub-perl/current/Build.PL
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnet-google-authsub-perl/current/Build.PL?rev=34709&op=file
==============================================================================
--- branches/upstream/libnet-google-authsub-perl/current/Build.PL (added)
+++ branches/upstream/libnet-google-authsub-perl/current/Build.PL Mon May 4 06:17:14 2009
@@ -1,0 +1,16 @@
+use strict;
+use Module::Build;
+
+my $build = Module::Build
+ ->new( module_name => "Net::Google::AuthSub",
+ version_from => 'lib/Net/Google/AuthSub.pm',
+ requires => {
+ 'Test::More' => '0.62',
+ 'LWP::UserAgent' => 0,
+ 'URI' => 0,
+ },
+ create_makefile_pl => 'traditional',
+ );
+
+$build->create_build_script;
+
Propchange: branches/upstream/libnet-google-authsub-perl/current/Build.PL
------------------------------------------------------------------------------
svn:executable =
Added: branches/upstream/libnet-google-authsub-perl/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnet-google-authsub-perl/current/Changes?rev=34709&op=file
==============================================================================
--- branches/upstream/libnet-google-authsub-perl/current/Changes (added)
+++ branches/upstream/libnet-google-authsub-perl/current/Changes Mon May 4 06:17:14 2009
@@ -1,0 +1,13 @@
+- 0.4 28th July 2008
+Allow proxies
+
+- 0.3 28th July 2007
+Dopplr have fixed API bugs, remove Dopplr compat and JSON.
+Make cuddled Auth requests the default
+Use GET instead of POST where required
+
+- 0.2 16th July 2007
+Forgot to have JSON dependency
+
+- 0.1 16th July 2007
+Initial relese
Added: branches/upstream/libnet-google-authsub-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnet-google-authsub-perl/current/MANIFEST?rev=34709&op=file
==============================================================================
--- branches/upstream/libnet-google-authsub-perl/current/MANIFEST (added)
+++ branches/upstream/libnet-google-authsub-perl/current/MANIFEST Mon May 4 06:17:14 2009
@@ -1,0 +1,10 @@
+Build.PL
+Changes
+lib/Net/Google/AuthSub.pm
+lib/Net/Google/AuthSub/Response.pm
+MANIFEST This list of files
+t/00use.t
+t/pod-coverage.t
+t/pod.t
+Makefile.PL
+META.yml
Added: branches/upstream/libnet-google-authsub-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnet-google-authsub-perl/current/META.yml?rev=34709&op=file
==============================================================================
--- branches/upstream/libnet-google-authsub-perl/current/META.yml (added)
+++ branches/upstream/libnet-google-authsub-perl/current/META.yml Mon May 4 06:17:14 2009
@@ -1,0 +1,21 @@
+---
+name: Net-Google-AuthSub
+version: 0.4
+author:
+ - 'Simon Wistow <simon at thegestalt.org>'
+abstract: interact with sites that implement Google style AuthSub
+license: unknown
+requires:
+ LWP::UserAgent: 0
+ Test::More: 0.62
+ URI: 0
+provides:
+ Net::Google::AuthSub:
+ file: lib/Net/Google/AuthSub.pm
+ version: 0.4
+ Net::Google::AuthSub::Response:
+ file: lib/Net/Google/AuthSub/Response.pm
+generated_by: Module::Build version 0.2808
+meta-spec:
+ url: http://module-build.sourceforge.net/META-spec-v1.2.html
+ version: 1.2
Added: branches/upstream/libnet-google-authsub-perl/current/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnet-google-authsub-perl/current/Makefile.PL?rev=34709&op=file
==============================================================================
--- branches/upstream/libnet-google-authsub-perl/current/Makefile.PL (added)
+++ branches/upstream/libnet-google-authsub-perl/current/Makefile.PL Mon May 4 06:17:14 2009
@@ -1,0 +1,16 @@
+# Note: this file was auto-generated by Module::Build::Compat version 0.03
+use ExtUtils::MakeMaker;
+WriteMakefile
+(
+ 'NAME' => 'Net::Google::AuthSub',
+ 'VERSION_FROM' => 'lib/Net/Google/AuthSub.pm',
+ 'PREREQ_PM' => {
+ 'LWP::UserAgent' => '0',
+ 'Test::More' => '0.62',
+ 'URI' => '0'
+ },
+ 'INSTALLDIRS' => 'site',
+ 'EXE_FILES' => [],
+ 'PL_FILES' => {}
+ )
+;
Added: branches/upstream/libnet-google-authsub-perl/current/lib/Net/Google/AuthSub.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnet-google-authsub-perl/current/lib/Net/Google/AuthSub.pm?rev=34709&op=file
==============================================================================
--- branches/upstream/libnet-google-authsub-perl/current/lib/Net/Google/AuthSub.pm (added)
+++ branches/upstream/libnet-google-authsub-perl/current/lib/Net/Google/AuthSub.pm Mon May 4 06:17:14 2009
@@ -1,0 +1,403 @@
+package Net::Google::AuthSub;
+
+use strict;
+use vars qw($VERSION $APP_NAME);
+use LWP::UserAgent;
+use HTTP::Request::Common;
+use Net::Google::AuthSub::Response;
+use URI;
+
+$VERSION = '0.4';
+$APP_NAME = __PACKAGE__."-".$VERSION;
+
+use constant CLIENT_LOGIN => 0;
+use constant AUTH_SUB => 1;
+
+=head1 NAME
+
+Net::Google::AuthSub - interact with sites that implement Google style AuthSub
+
+=head1 SYNOPSIS
+
+
+ my $auth = Net::Google::AuthSub->new;
+ my $response = $auth->login($user, $pass);
+
+ if ($response->is_success) {
+ print "Hurrah! Logged in\n";
+ } else {
+ die "Login failed: ".$response->error."\n";
+ }
+
+ my %params = $auth->auth_params;
+ $params{Content_Type} = 'application/atom+xml; charset=UTF-8';
+ $params{Content} = $xml;
+ $params{'X-HTTP-Method-Override'} = 'DELETE';
+
+ my $request = POST $url, %params;
+ my $r = $user_agent->request( $request );
+
+
+=head1 ABOUT AUTHSUB
+
+AuthSub is Google's method of authentication for their web
+services. It is also used by other web sites.
+
+You can read more about it here.
+
+ http://code.google.com/apis/accounts/Authentication.html
+
+A Google Group for AuthSub is here.
+
+ http://groups.google.com/group/Google-Accounts-API
+
+=head1 DEALING WITH CAPTCHAS
+
+If a login response fails then it may set the error code to
+'CaptchRequired' and the response object will allow you to
+retrieve the C<captchatoken> and C<captchaurl> fields.
+
+The C<captchaurl> will be the url to a captcha image or you
+can show the user the web page
+
+ https://www.google.com/accounts/DisplayUnlockCaptcha
+
+Then retry the login attempt passing in the parameters
+C<logintoken> (which is the value of C<captchatoken>) and
+C<logincaptcha> which is the user's answer to the CAPTCHA.
+
+
+ my $auth = Net::Google::AuthSub->new;
+ my $res = $auth->login($user, $pass);
+
+ if (!$res->is_success && $res->error eq 'CaptchaRequired') {
+ my $answer = display_captcha($res->captchaurl);
+ $auth->login($user, $pass, logintoken => $res->captchatoken, logincaptcha => $answer);
+ }
+
+
+You can read more here
+
+ http://code.google.com/apis/accounts/AuthForInstalledApps.html#Using
+
+=head1 METHODS
+
+=cut
+
+=head2 new [param[s]]
+
+Return a new authorisation object. The options are
+
+=over 4
+
+=item url
+
+The base url of the web service to authenticate against.
+
+Defaults to C<https://google.com/account>
+
+=item service
+
+Name of the Google service for which authorization is requested such as 'cl' for Calendar.
+
+Defaults to 'xapi' for calendar.
+
+=item source
+
+Short string identifying your application, for logging purposes.
+
+Defaults to 'Net::Google::AuthSub-<VERSION>'
+
+=item accountType
+
+Type of account to be authenticated.
+
+Defaults to 'HOSTED_OR_GOOGLE'.
+
+=back
+
+See http://code.google.com/apis/accounts/AuthForInstalledApps.html#ClientLogin for more details.
+
+=cut
+
+
+our %BUGS = (
+ 'not_dopplr_any_more' => {
+ 'cuddled' => 1,
+ 'json_response' => 1,
+ },
+);
+
+sub new {
+ my $class = shift;
+ my %params = @_;
+
+ $params{_ua} = LWP::UserAgent->new;
+ $params{_ua}->env_proxy;
+ $params{url} ||= 'https://www.google.com/accounts';
+ $params{service} ||= 'xapi';
+ $params{source} ||= $APP_NAME;
+ $params{accountType} ||= 'HOSTED_OR_GOOGLE';
+ $params{_compat} ||= {};
+
+ my $site = delete $params{_bug_compat};
+ if (defined $site && exists $BUGS{$site}) {
+ foreach my $key (keys %{$BUGS{$site}}) {
+ $params{_compat}->{$key} = $BUGS{$site}->{$key};
+ }
+ }
+
+
+ return bless \%params, $class;
+}
+
+=head2 login <username> <password> [opt[s]]
+
+Login to google using your username and password.
+
+Can optionally take a hash of options which will override the
+default login params.
+
+Returns a C<Net::Google::AuthSub::Response> object.
+
+=cut
+
+sub login {
+ my ($self, $user, $pass, %opts) = @_;
+
+ # setup auth request
+ my %params = ( Email => $user,
+ Passwd => $pass,
+ service => $self->{service},
+ source => $self->{source},
+ accountType => $self->{accountType} );
+ # allow overrides
+ $params{$_} = $opts{$_} for (keys %opts);
+
+
+ my $uri = URI->new($self->{url});
+ $uri->path($uri->path.'/ClientLogin');
+ my $tmp = $self->{_ua}->request(POST "$uri", [ %params ]);
+ return $self->_response_failure($tmp) unless $tmp->is_success;
+ my $r = Net::Google::AuthSub::Response->new($tmp, $self->{url}, _compat => $self->{_compat});
+
+
+ # store auth token
+ $self->{_auth} = $r->auth;
+ $self->{_auth_type} = CLIENT_LOGIN;
+ $self->{user} = $user;
+ $self->{pass} = $pass;
+ return $r;
+
+}
+
+sub _response_failure {
+ my $self = shift;
+ my $r = shift;
+ $@ = $r->content;
+ return undef;
+}
+
+
+=head2 authorised
+
+Whether or not we're authorised.
+
+=cut
+
+sub authorised {
+ my $self = shift;
+ return defined $self->{_auth};
+
+}
+
+=head2 auth <username> <token>
+
+Use the AuthSub method for access.
+
+See http://code.google.com/apis/accounts/AuthForWebApps.html
+for details.
+
+=cut
+
+sub auth {
+ my ($self, $username, $token) = @_;
+ $self->{_auth} = $token;
+ $self->{_auth_type} = AUTH_SUB;
+ $self->{user} = $username;
+ return 1;
+}
+
+
+
+=head2 request_token <next> <scope> [option[s]]
+
+Return a URI object representing the URL which the user
+should be directed to in order to aquire a single use token.
+
+The parameters are
+
+=over 4
+
+=item next (required)
+
+URL the user should be redirected to after a successful login.
+This value should be a page on the web application site, and
+can include query parameters.
+
+=item scope (required)
+
+URL identifying the service to be accessed. The resulting token
+will enable access to the specified service only. Some services
+may limit scope further, such as read-only access.
+
+For example
+
+ http://www.google.com/calendar/feed
+
+=item secure
+
+Boolean flag indicating whether the authentication transaction
+should issue a secure token (1) or a non-secure token (0).
+Secure tokens are available to registered applications only.
+
+=item session
+
+Boolean flag indicating whether the one-time-use token may be
+exchanged for a session token (1) or not (0).
+
+=back
+
+=cut
+
+sub request_token {
+ my $self = shift;
+ my ($next, $scope, %opts) = @_;
+ $opts{next} = $next;
+ $opts{scope} = $scope;
+
+ my $uri = URI->new($self->{url});
+
+ $uri->path($uri->path.'/AuthSubRequest');
+ $uri->query_form(%opts);
+ return $uri;
+}
+
+
+=head2 session_token
+
+Exchange the temporary token for a long-lived session token.
+
+The single-use token is acquired by visiting the url generated by
+calling request_token.
+
+Returns the token if success and undef if failure.
+
+=cut
+
+sub session_token {
+ my $self = shift;
+
+ my $uri = URI->new($self->{url});
+ $uri->path($uri->path.'/AuthSubSessionToken');
+
+ my %params = $self->auth_params();
+ my $tmp = $self->{_ua}->request(GET "$uri", %params);
+ return $self->_response_failure($tmp) unless $tmp->is_success;
+ my $r = Net::Google::AuthSub::Response->new($tmp, $self->{url}, _compat => $self->{_compat});
+
+ # store auth token
+ $self->{_auth} = $r->token;
+
+ return $r->token;
+}
+
+=head2 revoke_token
+
+Revoke a valid session token. Session tokens have no expiration date and
+will remain valid unless revoked.
+
+Returns 1 if success and undef if failure.
+
+=cut
+
+sub revoke_token {
+ my $self = shift;
+
+ my $uri = URI->new($self->{url});
+ $uri->path($uri->path.'/AuthSubRevokeToken');
+
+ my %params = $self->auth_params();
+ my $r = $self->{_ua}->request(GET "$uri", [ %params ]);
+ return $self->_response_error($r) unless $r->is_success;
+ return 1;
+
+}
+
+=head2 token_info
+
+Call AuthSubTokenInfo to test whether a given session token is valid.
+This method validates the token in the same way that a Google service
+would; application developers can use this method to verify that their
+application is getting valid tokens and handling them appropriately
+without involving a call to the Google service. It can also be used to
+get information about the token, including next URL, scope, and secure
+status, as specified in the original token request.
+
+Returns a C<Net::Google::AuthSub::Response> object on success or undef on failure.
+
+=cut
+
+sub token_info {
+ my $self = shift;
+
+ my $uri = URI->new($self->{url});
+ $uri->path($uri->path.'/AuthSubTokenInfo');
+
+ my %params = $self->auth_params();
+ my $tmp = $self->{_ua}->request(GET "$uri", [ %params ]);
+ my $r = Net::Google::AuthSub::Response->new($tmp, $self->{url}, _compat => $self->{_compat});
+ return $self->_response_failure($r) unless $r->is_success;
+ return $r;
+}
+
+=head2 auth_params
+
+Return any parameters needed in an HTTP request to authorise your app.
+
+=cut
+
+sub auth_params {
+ my $self = shift;
+
+ return () unless $self->authorised;
+ return ( Authorization => $self->_auth_string );
+}
+
+my %AUTH_TYPES = ( CLIENT_LOGIN() => "GoogleLogin auth", AUTH_SUB() => "AuthSub token" );
+
+sub _auth_string {
+ my $self = shift;
+ return "" unless $self->authorised;
+ if ($self->{_compat}->{uncuddled_auth}) {
+ return sprintf '%s=%s', $AUTH_TYPES{$self->{_auth_type}}, $self->{_auth};
+ } else {
+ return sprintf '%s="%s"', $AUTH_TYPES{$self->{_auth_type}}, $self->{_auth};
+ }
+}
+
+
+=head1 AUTHOR
+
+Simon Wistow <simon at thegestalt.org>
+
+=head1 COPYRIGHT
+
+Copyright, 2007 - Simon Wistow
+
+Released under the same terms as Perl itself
+
+=cut
+
+
+1;
Added: branches/upstream/libnet-google-authsub-perl/current/lib/Net/Google/AuthSub/Response.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnet-google-authsub-perl/current/lib/Net/Google/AuthSub/Response.pm?rev=34709&op=file
==============================================================================
--- branches/upstream/libnet-google-authsub-perl/current/lib/Net/Google/AuthSub/Response.pm (added)
+++ branches/upstream/libnet-google-authsub-perl/current/lib/Net/Google/AuthSub/Response.pm Mon May 4 06:17:14 2009
@@ -1,0 +1,175 @@
+package Net::Google::AuthSub::Response;
+
+use strict;
+our $AUTOLOAD;
+
+=head1 NAME
+
+Net::Google::AuthSub::Response - a response from a Net::Google::AuthSub request
+
+=head1 SYNOPSIS
+
+ my $response = $auth->login($user, $pass);
+
+ if ($response->is_success) {
+ print "Yay!\n";
+ } else {
+ if ($response->error eq 'CaptchaRequired') {
+ print "Captcha Image ".$response->captchaurl;
+ }
+ }
+
+=head1 METHODS
+
+=cut
+
+=head2 new C<HTTP::Response> C<base url>
+
+Create a new response.
+
+=cut
+
+sub new {
+ my ($class, $response, $url, %opts) = @_;
+
+
+ my %values;
+ if ($opts{_compat}->{json_response}) {
+ eval 'use JSON::Any';
+ die "You need to install JSON::Any to use JSON responses" if $@;
+ %values = %{JSON::Any->from_json($response->content)};
+ } else {
+ foreach my $line (split /\n/, $response->content) {
+ chomp($line);
+ my ($key, $value) = split '=', $line;
+ $values{lc($key)} = $value;
+ }
+ }
+
+ return bless { _response => $response, _values => \%values, _url => $url }, $class;
+
+}
+
+
+=head2 is_success
+
+Returns whether the response was a sucess or not.
+
+=cut
+
+sub is_success {
+ my $self = shift;
+ return $self->{_response}->is_success;
+}
+
+=head1 SUCCESS METHODS
+
+Methods available if the response was a success.
+
+=head2 auth
+
+The authorisation token if the response is a success.
+
+=head2 sid
+
+Not used yet.
+
+=head2 lsid
+
+Not used yet.
+
+
+=head1 ERROR METHODS
+
+Methods available if the response was an error.
+
+=head2 error
+
+The error code. Can be one of
+
+=over 4
+
+=item BadAuthentication
+
+The login request used a username or password that is not recognized.
+
+=item 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.
+
+=item 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.
+
+=item CaptchaRequired
+
+A CAPTCHA is required. (A response with this error code will also
+contain an image URL and a CAPTCHA token.)
+
+=item Unknown
+
+The error is unknown or unspecified; the request contained invalid input
+or was malformed.
+
+=item AccountDeleted
+
+The user account has been deleted.
+
+=item AccountDisabled
+
+The user account has been disabled.
+
+=item ServiceDisabled
+
+The user's access to the specified service has been disabled. (The user
+account may still be valid.)
+
+=item ServiceUnavailable
+
+The service is not available; try again later.
+
+=back
+
+=head2 url
+
+The url of a page describing the error.
+
+=head2 captchatoken
+
+The token required to authenticate a captcha.
+
+=head2 captchaurl
+
+The full url of the captcha image.
+
+=cut
+
+sub captchaurl {
+ my $self = shift;
+ my $url = $self->{_values}->{captchaurl};
+ return $self->{url}."/accounts/$url";
+}
+
+sub AUTOLOAD {
+ my $self = shift;
+
+ my $type = ref($self)
+ or die "$self is not an object";
+
+ my $name = $AUTOLOAD;
+ $name =~ s/.*://; # strip fully-qualified portion
+
+ if (@_) {
+ return $self->{_values}->{$name} = shift;
+ } else {
+ return $self->{_values}->{$name};
+ }
+}
+
+sub DESTROY {}
+
+1;
Added: branches/upstream/libnet-google-authsub-perl/current/t/00use.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnet-google-authsub-perl/current/t/00use.t?rev=34709&op=file
==============================================================================
--- branches/upstream/libnet-google-authsub-perl/current/t/00use.t (added)
+++ branches/upstream/libnet-google-authsub-perl/current/t/00use.t Mon May 4 06:17:14 2009
@@ -1,0 +1,7 @@
+#!perl -w
+
+use strict;
+use Test::More tests => 2;
+
+use_ok("Net::Google::AuthSub::Response");
+use_ok("Net::Google::AuthSub");
Added: branches/upstream/libnet-google-authsub-perl/current/t/pod-coverage.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnet-google-authsub-perl/current/t/pod-coverage.t?rev=34709&op=file
==============================================================================
--- branches/upstream/libnet-google-authsub-perl/current/t/pod-coverage.t (added)
+++ branches/upstream/libnet-google-authsub-perl/current/t/pod-coverage.t Mon May 4 06:17:14 2009
@@ -1,0 +1,8 @@
+#!perl -T
+
+use strict;
+use warnings;
+use Test::More;
+eval 'use Test::Pod::Coverage 1.04';
+plan skip_all => 'Test::Pod::Coverage 1.04 required for testing POD coverage' if $@;
+all_pod_coverage_ok();
Added: branches/upstream/libnet-google-authsub-perl/current/t/pod.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnet-google-authsub-perl/current/t/pod.t?rev=34709&op=file
==============================================================================
--- branches/upstream/libnet-google-authsub-perl/current/t/pod.t (added)
+++ branches/upstream/libnet-google-authsub-perl/current/t/pod.t Mon May 4 06:17:14 2009
@@ -1,0 +1,9 @@
+#!perl -T
+
+use strict;
+use warnings;
+
+use Test::More;
+eval 'use Test::Pod 1.14';
+plan skip_all => 'Test::Pod 1.14 required for testing POD' if $@;
+all_pod_files_ok();
More information about the Pkg-perl-cvs-commits
mailing list