Perl Net::OAuth problem - perl

I'm trying to use the Net::OAuth module to authorise with the Yammer API and I have the following code snippet, pretty much taken from the Synopsis on CPAN.
$Net::OAuth::PROTOCOL_VERSION = Net::OAuth::PROTOCOL_VERSION_1_0A;
my $q = new CGI;
my $request = Net::OAuth->request("request token")->from_hash($q->Vars,
request_url => $self->_request_token_url,
request_method => $q->request_method,
consumer_secret => $self->consumer_private,
);
But if I try and run my test it throws an error as follows:
Expected a hash! at /Library/Perl/5.8.8/Net/OAuth/Message.pm line 241.
Have I made an obvious syntax error or am I going to have to look at the OAuth module itself?

$q->Vars returns a hash reference in scalar context and a flattened hash in list context. Subroutine arguments create list context. Therefore, you should do:
my $request = Net::OAuth->request("request token")->from_hash(
scalar $q->Vars,
request_url => $self->_request_token_url,
request_method => $q->request_method,
consumer_secret => $self->consumer_private,
);
Thanks to Adam Bellaire for the comment that made me check this.

In the Net::OAuth::Message
sub from_hash {
my $proto = shift;
my $class = ref $proto || $proto;
my $hash = shift;
if (ref $hash ne 'HASH') {
die 'Expected a hash!';
}
my %api_params = #_;
Maybe you can make sure that $q->Vars returns a hash ref
my $vars = $q->Vars;
print ref($vars);

Related

Can't read from app.conf file in Perl

I have subroutine in perl that accepts parameters. Now I am trying to read from the config file using the below code.
sub user{
my $self = shift;
my $apiBaseUrl = $self->app->config->{"apiBaseUrl"};
my $apiToken = $self->app->config->{"apiToken"};
}
But I am getting the error
Can't locate object method "app" via package "test#example.com" (perhaps you forgot to load "test#example.com"?)
The parameters I am passing to the subroutine are $username and $password
This is how I am calling that subroutine, with an email and password which I get from login form.
my $username = $self->param('username');
my $password = $self->param('password');
user($username, $password);
Below is the full code in the file.
use Mojo::Base 'Mojolicious::Controller';
use Mojo::UserAgent;
sub is_logged_in {
my $self = shift;
return 1 if $self->session('logged_in');
$self->render(
inline => "<h2>Forbidden</h2><p>You're not logged in. <%= link_to 'Go to login page.' => 'login_form' %>",
status => 403
);
}
sub user {
my ($username, $password) = #_;
my $self = shift;
my %returnResult;
my $apiBaseUrl = $self->app->config->{'apiBaseUrl'};
my $apiToken = $self->app->config->{'apiToken'};
my $url = $apiBaseUrl.'/auth/login/check?email='.$username.'&password='.$password.'';
my $header = {'api-token' => $apiToken};
my $ua = Mojo::UserAgent->new;
my $res = $ua->post( $url => $header )->result;
if($res->is_success)
{
my $content= $res -> json;
my $decoded_email = $content->{'email'};
$returnResult{'fn'} = $content->{'fn'};
$returnResult{'ln'} = $content->{'ln'};
$returnResult{'roles'} = $content->{'roles'};
if($username eq $decoded_email)
{$returnResult{'logged_in'} = 1;}
else
{$returnResult{'logged_in'} = 0;}
return %returnResult;
}
else
{
return $res->status_line;
}
}
sub on_user_login {
my $self = shift;
my $username = $self->param('username');
my $password = $self->param('password');
my %userDetails = user($username, $password);
if ($userDetails{'logged_in'} == 1) {
$self->session(logged_in => 1);
$self->session(username => $username);
$self->session(userDetails => \%userDetails);
$self->redirect_to('restricted');
} else {
$self->flash(message => 'Incorrect username/password!');
$self->redirect_to('/');
}
}
1;
What am I doing wrong?
my $username = $self->param('username');
my $password = $self->param('password');
user($username, $password);
You are using your user sub as a function, and not as a method. Perl is a very flexible programming language that allows you to mix functional, procedural and object oriented programming styles in the same program. Sometimes that can get confusing.
You can recognize OOP (object oriented programming) in Perl when a sub has $self as the first argument because there is a convention to always name the object itself like that. Other languages use this instead. Another giveaway is when there is a variable followed by an arrow -> followed by an identifier.
$obj->method(#args);
You've already done that in your code when you got the parameters from $self. I suspect you are using this in a Mojolicious::Controller, and you've put your sub user in the same file.
The error message you are seeing is because your first argument to the function is the email address in $username. You left out the $self-> part, which tells Perl to call this as a method on $self. Under the hood, it will look into the identifier on the left (which is $self) to see what class that thing has. It will then look into the namespaces (called packages in Perl) of all the things in the inheritance tree of that class to find the identifier on the right (which is user). In our case, it will find a sub user right in this same package. It then calls that function user and passes the thing on the left ($self) as the first argument, and $username and $password as the second and third arguments.
So what you need to do is:
$self->user($username, $password);
The code in your sub is correct (but does not actually use the two arguments).

perl -- call method from hash

I have a hash table of methods:
my %makefileMacroSimplifiers = (
"or" => \&makefileSimplifyOr,
"and" => \&makefileSimplifyAnd,
"strip" => \&makefileSimplifyStrip,
);
sub makefileSimplifyStrip {
my $self = shift;
my $prefix = shift;
my $paramsRef = shift;
...
}
where each method requires $self. What I have is:
$makefileMacroSimplifiers{$macroName}->($self, $macroName.$ws1, \#parms);
This seems to work, but it seems a bit odd to me to explicitly pass in $self to a method. Is there a better way of doing this, or is this considered a normal coding practice? (I didn't find any better ways to do this on the web, but I thought I would ask in case I'm not using the right search criteria).
You can also call a code ref on an object. That way the thing on the left will be passed in.
my $coderef = sub { ... };
$self->$coderef(#args);
Using a hash element does not work like this.
$self->$dispatch{foo}(1, 2, 3); # BOOM
This is a syntax error. So you need to grab the code reference first. Borodin also explains this above in their comment.
my %dispatch = (
foo => sub { print "#_" },
);
require HTTP::Request;
my $obj = HTTP::Request->new;
my $method = $dispatch{foo};
$obj->$method(1, 2, 3);
I've used HTTP::Request here as an example of an arbitrary class/object.

Perl objects error: Can't locate object method via package

I realise there are several questions like this out in the ether, but I can't a solution for my problem. Maybe I should improve my lateral thinking.
I have a module which I am testing. This module looks something like:
package MyModule;
use strict;
use warnings;
... # a bunch of 'use/use lib' etc.
sub new {
my $class = shift;
my ($name,$options) = #_;
my $self = {
_name => $name,
_features => $options,
_ids => undef,
_groups => undef,
_status => undef,
};
bless $self,$class;
return $self;
}
sub init {
my ($self) = #_;
my ($ids,$groups,$status) = ...; # these are from a working module
$self->{_ids} = $ids;
$self->{_groups} = $groups;
$self->{_status} = $status;
return $self;
}
This is my test file:
#!/usr/bin/perl -w
use strict;
use MyModule;
use Test::More tests => 1;
use Data::Dumper;
print "Name: ";
my $name;
chomp($name = <STDIN>);
print "chosen name: $name\n";
my %options = (
option1 => 'blah blah blah',
option2 => 'blu blu blu',
);
my $name_object = MyModule->new($name,\%options);
print Dumper($name_object);
isa_ok($name_object,'MyModule');
$name_object->init;
print Dumper($name_object);
Now it works down to the isa_ok, but then comes up with:
Can't locate object method "init" via package "MyModule" at test_MyModule.t line 31, <STDIN> line 1.
This has only occurred now that I'm trying (and somewhat failing it seems) to use objects. So thus I reckon I'm misunderstanding the applications of objects in Perl! Any help would be appreciated...
I think you're loading a different file than the one you think you are loading.
print($INC{"MyModule.pm"}, "\n");
will tell you which file you actually loaded. (If the module name is really of the form Foo::Bar, use $INC{"Foo/Bar.pm"}.) Make sure the capitalisation of the package and the file name match.

How to print out JSON object in perl using AnyEvent::Twitter::Stream

I'm using the AnyEvent::Twitter::Stream module to grab tweets. Ultimately I'm trying to print the tweets to a file but I'm unable (I think) to get the tweet as a JSON object. My code is as follows:
#!/Applications/XAMPP/xamppfiles/bin/perl
use AnyEvent::Twitter::Stream;
my $done = AnyEvent->condvar;
BEGIN {
use Exporter;
our #ISA = qw(Exporter);
our #EXPORT = qw{
&init
};
}
sub print_tweet {
my $tweet = shift;
print $tweet;
}
# receive updates from #following_ids
my $listener = AnyEvent::Twitter::Stream->new(
username => XXXXXX
password => XXXXXX
method => 'sample', # "firehose" for everything, "sample" for sample timeline
decode_json => 1,
on_tweet => sub {
my $tweet = shift;
print_tweet($tweet);
},
on_keepalive => sub {
warn "ping\n";
},
on_delete => sub {
my ($tweet_id, $user_id) = #_; # callback executed when twitter send a delete notification
},
timeout => 45,
);
$done->recv;
Yet when I print out the tweet in the print_tweet subroutine all I get is:
HASH(0x8f0ad0)HASH(0x8f0640)HASH(0x875990)HASH(0x8f0ab0)HASH(0x8e0d80)HASH(0x8f06e0)HASH(0x8f08f0)HASH(0x93ef30)HASH(0x876190)HASH(0x93ee60)HASH(0x8f0610)HASH(0x8f0b00)HASH(0x8e13e0)HASH(0x93ee20)HASH(0x8f0a20)HASH(0x8e1970)HASH(0x8f0900)
I've even tried to print out the tweet assuming it is a hash as follows:
sub print_tweet {
my ($jsonref, $tweet) = #_;
my $tweet = shift;
print %tweet;
}
Yet that produced nothing. It appears that AnyEvent::Twitter::Stream is returning $tweet as an object based on their sample code of:
on_tweet => sub {
my $tweet = shift;
warn "$tweet->{user}{screen_name}: $tweet->{text}\n";
},
And I know I can print out individual objects, but can I get teh raw JSON object? I must be missing something or my 'noob'ness is greater than I thought...
UPDATE
I was able to ALMOST get it by changing print_tweet to the following:
sub print_tweet {
my $tweet = shift;
my $json_output = to_json($tweet);
print $json_output;
}
It prints out MOST of the JSON object but complains about wide characters, which I believe is an issue with the output being utf8 format? I'm unsure how to solve this issue though....
Looks like it's returning a hashref. If you're not sure, you could try doing something like this.
use Data::Dumper;
...
print Dumper $tweet;
That should give you an idea of what's being passed, then you can grab what you want - probably something like this:
print "$tweet->{user}{screen_name}: $tweet->{text}\n";
In print_tweet, you're declaring $tweet twice. First, you assign it the second element of the #_ array, then you redeclare it and assign it the first element of #_, because shift operated on #_ by default.
Of course, if you had use warnings turned on, you would have seen
"my" variable $tweet masks earlier declaration in same scope
That's why you should always use strict; use warnings; at the top of your code.
The strings of output that you're seeing are hash references, the result of printing what's in the first argument to print_tweet (what you initially assign to $json_ref). If you want to print out the value of $tweet, get rid of the line where you clobber it with shift.
Figured it out. Need to use the JSON module and encode. When encoding you MUST use the {utf8 => 1} option to account for the utf8 characters you get form Twitter. Final code is here:
#!/Applications/XAMPP/xamppfiles/bin/perl
use JSON;
use utf8;
use AnyEvent::Twitter::Stream;
my $done = AnyEvent->condvar;
BEGIN {
use Exporter;
our #ISA = qw(Exporter);
our #EXPORT = qw{
&init
};
}
sub print_tweet {
my $tweet = shift;
my $json_output = to_json($tweet, {utf8 => 1});
print $json_output;
print "\n";
}
# receive updates from #following_ids
my $listener = AnyEvent::Twitter::Stream->new(
username => XXXXXXXX
password => XXXXXXXX
method => 'sample', # "firehose" for everything, "sample" for sample timeline
on_tweet => sub {
my $tweet = shift;
print_tweet($tweet);
},
on_keepalive => sub {
warn "ping\n";
},
on_delete => sub {
my ($tweet_id, $user_id) = #_; # callback executed when twitter send a delete notification
},
timeout => 45,
);
$done->recv;
Thanks to the help you guys gave, the DataDumper at least let me verify the format, it just didn't produce the final result.

Having trouble accessing object's instance variable in Perl SOAP server code

I'm working through example SOAP client/server code using SOAP::Transport::HTTP:Daemon and SOAP::Lite, and I've noticed that I cannot access an instance variable declared in an object's new() method. I'm sure I'm doing something wrong, but I'm not sure what (although it has been years since I was a half-decent Perl programmer).
Here's my server:
#! /usr/bin/env perl
use lib '/a/valid/directory/modules';
use SOAP::Transport::HTTP;
my $port = 9810;
my $dispatchers = {
'urn:remote_call' => 'ExampleLibrary::MyExample'
};
my $daemon = SOAP::Transport::HTTP::Daemon
-> new (LocalAddr => 'localhost', LocalPort => $port)
-> dispatch_with($dispatchers)
-> on_action(sub {return})
;
print "Connect to SOAP server at ", $daemon->url, "\n";
$daemon->handle;
Here's my client (located in a directory specified in the server's use lib line, modules/ExampleLibrary/MyExample.pm):
package ExampleLibrary::MyExample;
use vars qw(#ISA);
#ISA = qw(Exporter SOAP::Server::Parameters);
use SOAP::Lite;
sub new {
my($class, %args) = #_;
my $self = bless({}, $class);
$self->{somevar} = 'somedata';
return $self;
}
sub remote_call {
my $self = shift;
my $envelope = pop;
# Swap out return statements and the data is returned correctly
# return SOAP::Data->type('xml' => 'foo');
return SOAP::Data->type('xml' => "$self->{somevar}");
}
1;
I'm sure I'm hitting the client correctly--I can put in static text in the remote_call's return statement (the commented out code) and see it--but the object data specified as $self->{somevar} is never visible, with or without quotes. (I'm using SoapUI to hit the server.)
Does anyone see what I'm missing? (Oh, I'm using Perl v5.10.1 on Cygwin.)
Thanks...
The docs say
dispatch_with({
URI => MODULE, # 'http://www.soaplite.com/' => 'My::Class',
SOAPAction => MODULE, # 'http://www.soaplite.com/method' => 'Another::Class',
URI => object, # 'http://www.soaplite.com/obj' => My::Class->new,
})
You have
my $dispatchers = {
'urn:remote_call' => 'ExampleLibrary::MyExample'
};
maybe that should be
my $dispatchers = {
'urn:remote_call' => 'ExampleLibrary::MyExample->new'
};
Otherwise (I speculate that) your method may be being invoked as a static method not as an instance method (no instance having been instantiated).
P.S. The absence of single-quotes for the object instantiation string in the docs puzzles me as it suggests that a single instance is used to handle all requests (and that seems wrong to me) but maybe that is indeed what this experimental feature needs and you should omit the single quotes too.
I got this working after tweaking the code a bit from #RedGrittyBrick's suggestion (or perhaps it's exactly what he suggested and I just didn't understand it). Thanks also to #Axeman--you came back multiple times to try and help out--I appreciate that very much. I put comments in the server to indicate the two lines that fixed things.
Here's the revised server:
#! /usr/bin/env perl
use lib '/a/valid/directory/modules';
use ExampleLibrary::MyExample; # new!
use SOAP::Transport::HTTP;
my $port = 9810;
my $dispatchers = {
# new--no quotes around the hash value
'urn:remote_call' => ExampleLibrary::MyExample->new
};
my $daemon = SOAP::Transport::HTTP::Daemon
-> new (LocalAddr => 'localhost', LocalPort => $port)
-> dispatch_with($dispatchers)
-> on_action(sub {return})
;
print "Connect to SOAP server at ", $daemon->url, "\n";
$daemon->handle;
Here's the revised client. Really, the only changes were to put localtime() calls in so that I could verify that variables set in new() remained unchanged over the lifetime of the server.
package ExampleLibrary::MyExample;
use vars qw(#ISA);
#ISA = qw(Exporter SOAP::Server::Parameters);
use SOAP::Lite;
sub new {
my($class, %args) = #_;
my $self = bless({}, $class);
$self->{'somevar'} = localtime();
return $self;
}
sub remote_call {
my $self = shift;
my $envelope = pop;
$now = localtime();
return SOAP::Data->type('xml' => "now = $now, started at $self->{somevar}");
}
1;