I am reading the section of Mojolicious::Guides::Growing where it tells you how to grow a Mojolicious::Lite into a "well organized" cpan-uploadable application. First, it tells you to split the M::L app into a launch script and an application class.
package MyApp;
use Mojo::Base 'Mojolicious';
use MyUsers;
sub startup {
my $self = shift;
# ...auth stuff omitted...
my $r = $self->routes;
$r->any('/' => sub {
my $self = shift;
my $user = $self->param('user') || '';
my $pass = $self->param('pass') || '';
return $self->render unless $self->users->check($user, $pass);
$self->session(user => $user);
$self->flash(message => 'Thanks for logging in.');
$self->redirect_to('protected');
} => 'index');
$r->get('/protected' => sub {
my $self = shift;
return $self->redirect_to('index') unless $self->session('user');
});
$r->get('/logout' => sub {
my $self = shift;
$self->session(expires => 1);
$self->redirect_to('index');
});
}
1;
This makes sense to me. But then it goes on to say that this application class can further be refactored into a controller class with the actions, and the application class itself can be reduced to the routing information:
package MyApp::Login;
use Mojo::Base 'Mojolicious::Controller';
sub index {
my $self = shift;
my $user = $self->param('user') || '';
my $pass = $self->param('pass') || '';
return $self->render unless $self->users->check($user, $pass);
$self->session(user => $user);
$self->flash(message => 'Thanks for logging in.');
$self->redirect_to('protected');
}
sub protected {
my $self = shift;
return $self->redirect_to('index') unless $self->session('user');
}
sub logout {
my $self = shift;
$self->session(expires => 1);
$self->redirect_to('index');
}
1;
package MyApp;
use Mojo::Base 'Mojolicious';
use MyUsers;
sub startup {
my $self = shift;
# ...auth stuff omitted...
my $r = $self->routes;
$r->any('/')->to('login#index')->name('index');
$r->get('/protected')->to('login#protected')->name('protected');
$r->get('/logout')->to('login#logout')->name('logout');
}
1;
I don't see why this is superior to the "hybrid" version where routes and actions are intermingled, because now in order to redirect between the actions with redirect_to() in the controller, you need to look at the routing infomration in a different file, and if you want to change a url, you have to do it in two different files instead of one. This:
$r->get('/protected' => sub {
my $self = shift;
return $self->redirect_to('index') unless $self->session('user');
});
turns into:
sub protected {
my $self = shift;
return $self->redirect_to('index') unless $self->session('user');
}
$r->get('/protected')->to('login#protected')->name('protected');
Which has the word "protected" 4 times in two different files (although I'm not sure what the name("protected") does yet).
I'm a complete novice when it comes to web development, by the way.
It's not superior; rather, it's different.
As soon as you move beyond one developer, having your app in one file is no longer a benefit; you'll end up stepping on each others toes. Even if you're the only dev, it's never easy to keep track of locations in files of 1000+ lines. In addition, being able to look at one file and determine all your routes at a glance is quite useful when you have more than just a few routes, not to mention 100+.
Also, you don't have to change a redirect url in a controller action when the route changes. Mojolicious will do the work for you if you're making use of named routes.
Related
I'm trying to implement a dispatch table which calls functions inside a Perl module. I know how to implement dispatch tables generally, but I can't seem to get it right when referencing an object method from within $self. Maybe I haven't Googled enough, but so far, the right syntax is elusive.
I have traced the parameters though the calls, and I know what is happening -- the function references are not receiving a reference to $self as their first parameter. This is what I currently have inside $self. I believe I copied this over properly; if I made a mistake and it doesn't run, I apologize.
package MyRefHashTest;
use strict;
use warnings;
sub new {
my $class = shift;
my $self = {
DISPATCH => {
ONE => \&funcOne,
TWO => \&funcTwo,
THREE => \&funcThree,
FOUR => \&funcFour
}
};
bless $self, $class;
return $self;
}
sub funcOne {
my ($self, $param) = #_;
print "func1 $param \n";
}
sub funcTwo {
my ($self, $param) = #_;
print "func2 $param \n";
}
sub funcThree {
my ($self, $param) = #_;
print "func3 $param \n";
}
sub funcFour {
my ($self, $param) = #_;
print "func4 $param \n";
}
sub runTesting {
my ($self, $type) = #_;
($self->{DISPATCH}{$type} || sub {})->("string");
}
1;
# To Test:
$test = MyRefHashTest->new;
$test->runTesting("ONE");
$test->runTesting("TWO");
$test->runTesting("THREE");
$test->runTesting("FOUR");
The actual output I get is that $param is undefined in the function calls from the dispatch table, when it should not be. This is how I know that the references to $self are not where they should be. The functions think that $type is $self.
I have tried editing the hash table references so they look like \$self->functionName, but that only results in a compilation error for $self not being properly defined on that line.
Can anyone guide me to the right syntax for this, please?
Thanks!
EDIT: After much more work, I finally found a solution. It's some very interesting syntax, a lot more complicated than I thought. Essentially, I'm building the hash from the inside out:
my $self = {
DISPATCH => undef
};
$self->{DISPATCH} = {
ONE => sub { $self->funcOne(#_); },
TWO => sub { $self->funcTwo(#_); },
THREE => sub { $self->funcThree(#_); },
FOUR => sub { $self->funcFour(#_); }
};
It works, but it seems like a lot of hassle for what it is. If anyone knows of an easier way to do this, I would still be very interested in it. If there isn't an easier way, on the other hand, I hope this can help somebody.
What follows are four approaches for implementing a method-based dispatch table. The differences explained afterwards.
my %DISPATCH = (
ONE => \&funcOne,
TWO => \&funcTwo,
THREE => \&funcThree,
FOUR => \&funcFour,
);
sub runTesting {
my ($self, $type) = #_;
my $method = $DISPATCH{$type};
return $self->$method("string");
}
or
my %DISPATCH = (
ONE => __PACKAGE__->can('funcOne'),
TWO => __PACKAGE__->can('funcTwo'),
THREE => __PACKAGE__->can('funcThree'),
FOUR => __PACKAGE__->can('funcFour'),
);
sub runTesting {
my ($self, $type) = #_;
my $method = $DISPATCH{$type};
return $self->$method("string");
}
or
my %DISPATCH = (
ONE => 'funcOne',
TWO => 'funcTwo',
THREE => 'funcThree',
FOUR => 'funcFour',
);
sub runTesting {
my ($self, $type) = #_;
my $method_name = $DISPATCH{$type};
return $self->$method_name("string");
}
or
my %DISPATCH = (
ONE => sub { shift->funcOne(#_) },
TWO => sub { shift->funcTwo(#_) },
THREE => sub { shift->funcThree(#_) },
FOUR => sub { shift->funcFour(#_) },
);
sub runTesting {
my ($self, $type) = #_;
my $cb = $DISPATCH{$type};
return $cb->($self, "string");
}
All four approaches allow the methods to be defined in the same class.
The last three approaches allow the methods to be defined in a superclass as well.
The last two approaches allow a subclass to provide or override the method as well. These are your best options.
How about passing in $self in the dynamic dispatch method:
sub runTesting {
my ($self, $type) = #_;
($self->{DISPATCH}{$type} || sub {})->($self,"string");
^^^^^
}
I believe the problem is that you are invoking the methods as plain functions and not object methods.
I'm writing a Mojolicious module/controller that needs to make two GET requests; one after the other. The second GET request depends on response data from the first.
I would like both requests to be non-blocking. However I can't easily "return" from the context of the first non-blocking callback to supply values to the second request.
sub my_controller {
my ($self) = #_;
$self->ua->get($first_endpoint, sub {
# handle response - extract value for second request?
});
my $second_endpoint = 'parameter not available here';
$self->ua->get($second_endpoint, sub {});
}
I would prefer not to nest the second request into the first callback if possible?
First need to call render_later method in controller because you write non-blocking code.
Exist 2 ways how to pass data:
1)
sub action_in_controller {
my $c = shift->render_later;
$c->delay(
sub {
my $delay = shift;
$c->ua->get('http://one.com' => $delay->begin);
},
sub {
my ($delay, $tx) = #_;
$c->ua->post('http://second.com' => $delay->begin);
},
sub {
my ($delay, $tx) = #_;
$c->render(text => 'la-la-la');
}
);
}
2)
sub action_in_controller {
my $c = shift->render_later;
$c->ua->get('http://one.com' => sub {
my ($ua, $tx) = #_;
$c->ua->post('http://second.com' => sub {
my ($ua, $tx) = #_;
$c->render(text => 'la-la-la');
});
});
}
UPD
Found another variant of calling using Coro.
But in perl 5.22 it not work and need to apply patch to repair it.
You need additionally to write plugin Coro.
Here example. You need only ua.pl and plugin Mojolicious::Plugin::Core.
How can I hide a "tie" call from the user so calling an accessor will implicitly do it for them?
I want to do this, because I have a data structure that can be accessed by the user, but values stored in this structure can be modified without the user's knowledge.
If an attribute in the data structure changes, I want any variables referencing that attribute modified as well so the user will always be using fresh data. Since the user will always want fresh data, it's simpler and more intuitive if the user doesn't even need to know it's happening.
This is what I have so far... it doesn't seem to work though, the output is:
hello
hello
What I want is:
hello
goodbye
Code:
#!/usr/bin/perl
use warnings;
use strict;
use feature qw{ say };
{
package File;
use Moose;
has '_text' => (is => 'rw', isa => 'Str', required => 1);
sub text {
my ($self) = #_;
tie my $text, 'FileText', $self;
return $text;
}
}
{
package FileText;
use Tie::Scalar;
sub TIESCALAR {
my ($class, $obj) = #_;
return bless \$obj, $class;
}
sub FETCH {
my ($self) = #_;
return $$self->_text();
}
sub STORE {
die "READ ONLY";
}
}
my $file = 'File'->new('_text' => 'hello');
my $text = $file->text();
say $text;
$file->_text('goodbye');
say $text;
I would not recommend doing this. You're introducing "action at a distance" which leads to some very difficult to catch bugs. The user thinks they're getting a string. A lexical string can only be altered by changing it directly and obviously. It has to be altered in place or obviously passed into a function or a reference attached to something.
my $text = $file->text;
say $text; # let's say it's 'foo'
...do some stuff...
$file->text('bar');
...do some more stuff...
# I should be able to safely assume it will still be 'foo'
say $text;
That block of code is easy to understand because all the things which could affect $text are immediately visible. This is what lexical context is all about, isolating what can change a variable.
By returning a thing which can change at any time, you've quietly broken this assumption. There's no indication to the user that assumption has been broken. When they go to print $text and get bar it is non-obvious what changed $text. Anything in the whole program could change $text. That small block of code is now infinitely more complicated.
Another way to look at it is this: scalar variables in Perl have a defined interface. Part of that interface says how they can be changed. You are breaking this interface and lying to the user. This is how overloaded/tied variables are typically abused.
Whatever problem you're trying to solve, you're solving it by adding more problems, by making the code more complex and difficult to understand. I would step back and ask what problem you're trying to solve with tying.
What I would do instead is to just return a scalar reference. This alerts the user that it can be changed out from under them at any time. No magic to cover up a very important piece of information.
#!/usr/bin/perl
use warnings;
use strict;
use feature qw{ say };
{
package File;
use Moose;
has 'text_ref' => (
is => 'rw',
isa => 'Ref',
default => sub {
return \("");
}
);
sub BUILDARGS {
my $class = shift;
my %args = #_;
# "Cast" a scalar to a scalar ref.
if( defined $args{text} ) {
$args{text_ref} = \(delete $args{text});
}
return \%args;
}
sub text {
my $self = shift;
if( #_ ) {
# Change the existing text object.
${$self->text_ref} = shift;
return;
}
else {
return $self->text_ref;
}
}
}
my $file = 'File'->new('text' => 'hello');
my $text = $file->text();
say $$text;
$file->text('goodbye');
say $$text;
That said, here's how you do what you want.
I would recommend against using tie. It is very slow, considerably slower than a method call, buggy and quirky. One of its quirks is that the tied nature is attached to the variable itself, not the referenced data. That means you can't return a tied variable.
Instead, I would recommend using an overloaded object to store your changing text.
{
package ChangingText;
# Moose wants class types to be in a .pm file. We have to explciitly
# tell it this is a class type.
use Moose::Util::TypeConstraints qw(class_type);
class_type('ChangingText');
use overload
'""' => sub {
my $self = shift;
return $$self;
},
fallback => 1;
sub new {
my $class = shift;
my $text = shift;
return bless \$text, $class;
}
sub set_text {
my $self = shift;
my $new_text = shift;
$$self = $new_text;
return;
}
}
Overloaded objects have their own caveats, mostly due to code which expects strings writing things like if !ref $arg, but they are easier to deal with than the deep tie bugs.
To make this transparent, store the ChangingText object in the File object and then put a hand made text accessor around it to handle plain strings. The accessor makes sure to reuse the same ChangingText object.
To complete the illusion, BUILDARGS is used to change plain text initialization arguments into a ChangingText object.
{
package File;
use Moose;
has 'text_obj' => (
is => 'rw',
isa => 'ChangingText',
default => sub {
return ChangingText->new;
}
);
sub BUILDARGS {
my $class = shift;
my %args = #_;
# "Cast" plain text into a text object
if( defined $args{text} ) {
$args{text_obj} = ChangingText->new(delete $args{text});
}
return \%args;
}
sub text {
my $self = shift;
if( #_ ) {
# Change the existing text object.
$self->text_obj->set_text(shift);
return;
}
else {
return $self->text_obj;
}
}
}
Then it works transparently.
my $file = File->new('text' => 'hello');
my $text = $file->text();
say $text; # hello
$file->text('goodbye');
say $text; # goodbye
return $text just returns the value of the variable, not the variable itself. You can return a reference to it, though:
sub text {
my ($self) = #_;
tie my $text, 'FileText', $self;
return \$text;
}
You then have to use $$text to dereference it:
my $file = 'File'->new('_text' => 'hello');
my $text = $file->text();
say $$text;
$file->_text('goodbye');
say $$text;
I have an existing application (my website) that I'm doing some code tidying in, and the tidy up is following the same sort of idea as the Mojo::Pg example here, with separate model and controller files to keep things defined. My site accesses both Flickr and Last.fm's APIs, and I have a helper defined in Site::Helpers:
$app->helper(
get_base_rest_url => sub {
my ( $self, $config ) = #_;
sswitch ( $config ) {
case 'photos': {
my $base_url = 'https://api.flickr.com/services/rest/';
my $user_id = '7281432#N05';
my $api_key = $self->app->config->{ 'api_token' }{ 'flickr' };
my $url =
"$base_url"
. "?user_id=$user_id"
. "&api_key=$api_key"
. "&per_page=" . $self->session->{ per_page }
. '&format=json'
. '&nojsoncallback=1';
return $url;
}
case 'music': {
my $base_url = 'https://ws.audioscrobbler.com/2.0/';
my $username = 'virtualwolf';
my $api_key = $self->app->config->{ 'api_token' }{ 'last_fm' };
my $per_page = $self->session->{ 'per_page' };
my $url = "$base_url?user=$username&limit=$per_page&api_key=$api_key&format=json";
return $url;
}
}
}
);
The problem I'm running into is that I don't know how to access that helper from the Site::Model::Photos module. The error is
Can't locate object method "get_base_rest_url" via package "Site::Model::Photos"
which is fair enough, but I can't work out how to actually get at that get_base_rest_url helper (or alternatively, how to access the api_token config).
The problem is that your module have not got app attribute/method which get access to your app.
So, when you create instance of Site::Model::Photos you need to pass app to it in param and make it weaken something like that:
package Site::Model::Photos
use Scalar::Util 'weaken';
sub new {
my $class = shift;
my $app = shift;
my $hash = {app => $app, ...};
weaken $hash->{app};
return bless $hash, $class;
}
sub your_method {
my $self = shift;
$self->{app}->get_base_rest_url(...);
}
1;
Or you may to use this module https://metacpan.org/release/Mojolicious-Plugin-Model which do it for you:
package Site::Model::Photos
use Mojo::Base 'MojoX::Model';
... code of your module ...
sub your_method {
my $self = shift;
$self->app->get_base_rest_url(...);
}
1;
And in your App.pm need to add this:
$app->plugin('Model', {namespaces => ['Site::Model']});
And use it that in controller:
$c->model('photos');
$c->app->model('photos');
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.