Can't get Mojo::Redis2 to subscribe - perl

I wrote the following program (redis.pl), Redis is running locally with the default port settings, but when I run redis.pl with morbo redis.pl I never get ********* 1 on the screen. Why is that? It seems the subscription never happens. How can I fix this?
#!/usr/bin/perl
use v5.18;
use warnings;
use Mojolicious::Lite;
use Mojo::Redis2;
say "Welcome";
my $redis = Mojo::Redis2->new();
$redis->subscribe(['pubsub'] => sub {
say "********* 1";
});
get '/' => sub {
my $self = shift;
$self->render(json => {a => 1});
};
app->start;

I don't have a redis instance installed currently, but I think this should work.
#!/usr/bin/perl
use v5.18;
use warnings;
use Mojolicious::Lite;
use Mojo::Redis2;
say "Welcome";
helper redis => sub {state $redis = Mojo::Redis2->new()};
app->redis->subscribe(['pubsub'] => sub {
say "********* 1";
});
get '/' => sub {
my $self = shift;
$self->render(json => {a => 1});
};
app->start;
I suspect that once the redis instance goes out of scope, you lose it and its connections.

I solved it, by making sure I retain the return value of $redis->subscribe in a permanent variable, like so:
Instead of...
$redis->subscribe(['pubsub'] => sub {
say "********* 1";
});
...I wrote...
our $subscription = $redis->subscribe(['pubsub'] => sub {
say "********* 1";
});
That fixed the problem. I guess it's similar to AnyEvent, where the return value must stay alive.

Related

Pass value from one router to another using Mojolicious::Lite

from an ajax form this router foundname gets called, I need to process the value and pass it to another router, I can't figured it out how to do it, here is a sample of how I am trying:
#!/usr/bin/perl
use Mojolicious::Lite;
get '/foundname' => sub {
my $c = shift;
# Here I get the value from the form
my $name_on = $c->req->query_params->param('name');
if($name_on) {
# call another router and pass the name value to it
# It gives an error "Can't locate object method "get" ", I might not need to use "get", just don't know how to pass the value.
$c->get('/process_name')->to( searched => $name_on);
}
};
get '/process_name' => sub {
my $c = shift;
my $got_name = $c->req->query_params->param('searched');
...
};
Thank you!
You need to look up the routes through your Mojolicious::Routes object inside of your app. The name for the lookup is auto-generated by Mojolicious::Lite from the path-part of the URI, so /process_name has the name process_name.
You get back a Mojolicious::Routes::Route, which has a render method and you can pass your parameters along there.
use Mojolicious::Lite;
get '/foundname' => sub {
my $c = shift;
my $name_on = $c->req->query_params->param('name');
if( $name_on ) {
my $process_name = app->routes->lookup('process_name')->render( { searched => $name_on } );
$c->render( text => $process_name );
}
};
get '/process_name' => sub {
my $c = shift;
my $got_name = $c->req->query_params->param('searched');
$c->render( text => $got_name );
};
app->start;
When you curl this you get the parameter back as a response.
$ curl localhost:3000/foundname?name=foo
/process_name
However, this is probably not the right approach. If you want to implement business logic, you should not use internal or hidden routes for that. Remember that your application is still just Perl. You can write a sub and call that.
use Mojolicious::Lite;
get '/foundname' => sub {
my $c = shift;
my $name_on = $c->req->query_params->param('name');
if( $name_on ) {
my $got_name = process_name( $name_on );
$c->render( text => $got_name );
}
};
sub process_name {
my ( $got_name ) = #_;
# do stuff with $got_name
return uc $got_name;
};
app->start;
This will output
$ curl localhost:3000/foundname?name=foo
FOO
It's the more portable approach, as you can easily unit-test these functions. If you want to have $c, you have to pass it along. You also have the app keyword available in any sub you define.
For the original question, I would use
$c->redirect_to()
See this question for details on passing the variable over:
Passing arguments to redirect_to in mojolicious and using them in the target controller
======
But, I would look more into writing subs (as others have said).
If you have existing logic then you can wrap it in a helper or just toss the logic in a helper and call that.
helper('process_name'=> sub{
my $self,$args = #_;
# Do some logic with $args->{'name'}
return $something;
});
get '/foundname' => sub {
my $c = shift;
my $name_on = $c->req->query_params->param('name');
if( $name_on ) {
my $process_name = $c->process_name({name => $name_on});
$c->render( text => $process_name );
}else{
$c->redner(text => 'Error',status=>500);
}
};

How do I properly shut down a Mojolicious::Lite server?

In a Mojolicious::Lite app I have a route that I want to kill the server and redirect to another site. Here is the snippet.
my $me = $$;
get '/kill' => sub {
my $self = shift;
$self->res->code(301);
$self->redirect_to('http://www.google.com');
$self->app->log->debug("Goodbye, $name.");
# I need this function to return so I delay the kill a little.
system("(sleep 1; kill $me)&");
};
This code does what I want, but it doesn't feel right. I have tried $self->app->stop but that is not available.
Is there a proper technique I should be using to get access to the server?
Update 2021:
This answer was referred to recently in an IRC discussion, so an update is warranted. The response below was a mechanism that I had used in a very specific case. While it may still be useful in rare cases, the more correct manner of stopping a service would be
https://docs.mojolicious.org/Mojo/IOLoop#stop_gracefully
or https://docs.mojolicious.org/Mojo/Server/Daemon#SIGNALS for a single-process server or https://docs.mojolicious.org/Mojo/Server/Prefork#MANAGER-SIGNALS for preforking
Original:
There are several ways to do this, of course.
Probably the best, is to simply attach a finish handler to the transaction:
#!/usr/bin/env perl
use Mojolicious::Lite;
get '/kill' => sub {
my $c = shift;
$c->redirect_to('http://google.com');
$c->tx->on( finish => sub { exit } );
};
app->start;
The method most like your example would be to setup a Mojo::IOLoop timer which would wait a few seconds and exit.
#!/usr/bin/env perl
use Mojolicious::Lite;
use Mojo::IOLoop;
get '/kill' => sub {
my $c = shift;
$c->redirect_to('http://google.com');
my $loop = Mojo::IOLoop->singleton;
$loop->timer( 1 => sub { exit } );
$loop->start unless $loop->is_running; # portability
};
app->start;
Joel mentioned Mojo::IOLoop, so here's what I've used for a simple Mojo Lite throwaway app:
get '/shutdown' => sub ($c) {
$c->render(text => "Shutting down" );
$c->tx->on( finish => sub { Mojo::IOLoop->stop_gracefully } );
};
Sending signals also works since this is a single process program:
get '/shutdown' => sub ($c) {
$c->render(text => "Shutting down" );
$c->tx->on( finish => sub { kill 'TERM', $$ } );
};

Mojolicious autostart/init() subroutine

Is there a method/feature to write auto-start subroutine/method for all available Mojolicious routes ?
Maybe an automatic helper, but I don't know how to do it yet.
I think this is useful especially to initialize database connection $self->{dbh} for nearly every available routes, ... so I can write like this:
helper DB => sub { state $dbh = Database->new };
get '/' => sub {
my $self = shift;
//$self->{dbh} // is automatically initialized & shared
};
get '/another_route' => sub {
my $self = shift;
//$self->{dbh} // also initialized & shared
};
instead of:
get '/' => sub {
my $self = shift;
$self->{dbh} = init_db();
};
get '/another_route' => sub {
my $self = shift;
$self->{dbh} = init_db();
};
P.S: I'm using Mojolicious:Lite, Perl 5.16, SQLite3
I'm not 100% sure I understand your question, helper does almost exactly what you want, but you shouldn't be using the object's hash. Here is how you would use your code:
helper db => sub { state $dbh = Database->new };
get '/' => sub {
my $self = shift;
$self->db->do_somthing();
};
get '/another_route' => sub {
my $self = shift;
my $dbh = $self->db;
...
};
helper methods are available for use by all controllers, templates and the main app.

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;