Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
tree: b0fe50d862
Fetching contributors…

Cannot retrieve contributors at this time

158 lines (119 sloc) 3.4 kb
package Facebook::Graph::Cmdline::Role::HTTPAccessToken;
#ABSTRACT: Embeds an HTTP::Daemon to implement OAuth callback for Facebook Authorization of Commandline Facebook apps.
use v5.10;
use Any::Moose 'Role';
#all provided by Facebook::Graph
requires qw(
access_token
authorize
fetch
postback
request_access_token
);
=attr postback
Contains the URL (a L<URI> object) used for making the authentication
"postback" (an HTTP GET request).
=cut
has +postback => ( is => 'ro', required => 1 );
has +access_token => ( is => 'rw', lazy_build => 1 );
use HTTP::Daemon 6.00;
use URI;
###
# provides code, token
# requires permissions
# can override prompt_message, success_message
=attr code
Contains the authorization code that is returned once the Facebook app
is successfully authorized during the postback.
=cut
has code => (
is => 'rw',
lazy_build => 1,
);
=attr permissions
An arrayref containing the app's requested permissions. A list of
possible values is available in the L<Facebook API Reference (Login)|https://developers.facebook.com/docs/reference/login/#permissions>.
=cut
has permissions => (
is => 'ro',
default => sub { [] }
);
# fmt will be called with url as arg
has prompt_message_fmt => (
is => 'rw',
default => "Please visit this url to authorize application:\n%s\n"
);
=attr success_message
Contains the text to be put in the content of a 200 HTTP response that
is generated when L</code> is defined at run time.
=cut
has success_message => (
is => 'rw',
default => 'Success!'
);
sub _build_code
{
my $self = shift;
my $uri = $self
->authorize
->extend_permissions( @{ $self->permissions } )
->uri_as_string;
printf $self->prompt_message_fmt, $uri;
use HTTP::Daemon;
my $postback = URI->new( $self->postback );
my $d = HTTP::Daemon->new(
LocalAddr => $postback->host,
LocalPort => $postback->port,
) || die;
my $code = '';
until ($code)
{
my $c = $d->accept;
my $r = $c->get_request;
next unless $r;
if ( $r->url->path eq $postback->path
and $r->url->query_param('code') )
{
$code = $r->url->query_param('code');
$c->send_response(
HTTP::Response->new(
200, undef, undef, $self->success_message
)
);
}
else
{
$c->send_response('204');
}
}
$code;
}
sub _build_access_token
{
my $self = shift;
return $self->request_access_token( $self->code )->token;
}
sub verify_access_token
{
my $self = shift;
return 0 unless $self->has_access_token();
say "verifying token"; ## DEBUG
#$self->access_token( $self->token );
my $resp;
eval { $resp = $self->fetch('me') };
if ($@)
{
say "Bad access_token, deleting"; ## INFO
$self->clear_access_token;
return 0;
}
return 1;
}
=head1 SEE ALSO
=over
=item L<Facebook API signed_request fields|https://developers.facebook.com/docs/reference/login/signed-request/>
=item L<JT Smith's tutorial on authenticating with Facebook::Graph|http://www.perl.com/pub/2011/03/facebook-authentication-with-perl-and-facebookgraph.html>
=item L<Facebook::Graph::AccessToken>
=back
=cut
1;
Jump to Line
Something went wrong with that request. Please try again.