Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

splits into ::Cmdline and ::role::HTTPtoken

* Facebook::Graph::role::HTTPtoken provides the http server
  and requests code and token.
* Facebook::Graph::Cmdline use ::role::HTTPtoken and
  Mo*seX::SimpleConfig and Mo*seX::Getopt to provide a
  configfile.  provides save_token method to update configfile
  with token.
* Yes, maintaining Any::Moose compat is a pain.
  • Loading branch information...
commit 5ac02a33961d7784f6d2eed882562c5da69a06f6 1 parent a3a64d5
@spazm authored
Showing with 149 additions and 111 deletions.
  1. +31 −111 lib/Facebook/Graph/Cmdline.pm
  2. +118 −0 lib/Facebook/Graph/role/HTTPtoken.pm
View
142 lib/Facebook/Graph/Cmdline.pm
@@ -1,129 +1,49 @@
package Facebook::Graph::Cmdline;
-#ABSTRACT: Authorization handling for Commandline Facebook apps
+#Abstract: Example usage of Facebook::Graph::role::HTTPtoken
-use v5.10;
use Any::Moose;
-extends 'Facebook::Graph' => { -version => 1.0401 };
-
-use HTTP::Daemon 6.00;
-use Data::Dumper;
+use v5.10;
-has postback_host => (
- is => 'ro',
- default => 'localhost',
-);
-has postback_port => (
- is => 'ro',
- default => '8123',
-);
-has postback_path => (
- is => 'ro',
- default => '/',
-);
-has postback => (
- is => 'ro',
- lazy_build => 1
-);
-sub _build_postback
+extends 'Facebook::Graph';
+with 'Facebook::Graph::role::HTTPtoken';
+#Is there a better way to do MooseX vs MouseX 'with' loading?
+#can import with "use Any::Moose 'X::SimpleConfig'" but that doesn't
+#provide the action of "with," Mo*se::Util::apply_all_roles()
+if (Any::Moose::moose_is_preferred) {
+ with 'MooseX::SimpleConfig';
+ with 'MooseX::Getopt';
+}
+else
{
- my $self = shift;
- sprintf("http://%s:%s%s",
- $self->postback_host,
- $self->postback_port,
- $self->postback_path
- );
+ with 'MouseX::SimpleConfig';
+ with 'MouseX::Getopt';
}
-has code => (
- is => 'rw',
- lazy_build => 1,
-);
-has token => (
- is => 'rw',
- lazy_build => 1,
-);
-has permissions => (
- is => 'ro',
- default => sub {
- [ qw(
- email
- offline_access
- publish_stream
- publish_actions
- create_event
- rsvp_event
- manage_pages
- user_groups)
- ];
- }
-);
-sub _build_code
-{
- my $self = shift;
- my $uri = $self
- ->authorize
- ->extend_permissions( @{$self->permissions} )
- ->uri_as_string;
- say "Please visit this url to authorize app:\n$uri";
+=method save_token
- use HTTP::Daemon;
- my $d = HTTP::Daemon->new(
- LocalAddr => $self->postback_host,
- LocalPort => $self->postback_port)
- || die;
- say "url: " . $d->url;
+Updates token value in configfile and saves as YAML if modified.
- my $code = '';
- until($code)
- {
- my $c = $d->accept;
- my $r = $c->get_request;
- next unless $r;
+If configfile is not defined, the token is printed to STDOUT for manual saving.
- if ($r->url->path eq $self->postback_path and
- $r->url->query_param('code'))
- {
- $code = $r->url->query_param('code');
- $c->send_response( HTTP::Response->new( 200,undef,undef, "success!" ) );
- }
- else
- {
- $c->send_error('500');
- }
- }
- say "success: got code: $code";
- $code
-}
+=cut
-sub _build_token
-{
- my $self = shift;
- my $resp = $self->request_access_token($self->code);
- my $token = $resp->token;
- say Dumper { token => $token, expires => $resp->expires };
- $token;
-}
-
-sub verify_token
-{
+sub save_token {
my $self = shift;
+ if (!$self->configfile)
+ {
+ say "please save token: " . $self->token ;
+ return 1;
+ }
- say "verifying token";
- $self->access_token($self->token);
- my $resp;
- eval { $resp = $self->fetch('me') };
- if ($@) {
- say "problem with access token, let's get new one";
- print Dumper { resp => $resp };
- $self->clear_token;
- return 0;
+ my $config = $self->get_config_from_file( $self->configfile );
+ if (!exists $config->{token} or $self->token ne $config->{token})
+ {
+ $config->{token} = $self->token;
+ say "saving updated token!"; ## DEBUG
+ use YAML::Any;
+ YAML::Any::DumpFile( $self->configfile, $config);
}
- return 1;
-}
-sub verify_code
-{
- #TODO: try and request something with the code and see if it works?
}
no Any::Moose;
View
118 lib/Facebook/Graph/role/HTTPtoken.pm
@@ -0,0 +1,118 @@
+package Facebook::Graph::role::HTTPtoken;
+
+#ABSTRACT: Authorization handling for 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
+);
+
+has +postback => ( is => 'ro', required => 1 );
+
+use HTTP::Daemon 6.00;
+use URI;
+
+###
+# provides code, token
+# requires permissions
+# can override prompt_message, success_message
+
+has code => (
+ is => 'rw',
+ lazy_build => 1,
+);
+has token => (
+ is => 'rw',
+ lazy_build => 1,
+);
+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"
+);
+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_token
+{
+ my $self = shift;
+ return $self->request_access_token( $self->code )->token;
+
+ #my $resp = $self->request_access_token($self->code);
+ #$resp->token;
+}
+
+sub verify_token
+{
+ my $self = shift;
+ return 0 unless $self->has_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_token;
+ return 0;
+ }
+ return 1;
+}
+
+1;
Please sign in to comment.
Something went wrong with that request. Please try again.