How do I cleanup at request end in Catalyst? - perl

I'm trying to get some code called after each request completes using Catalyst. Basically, I want to run some code as part of finalize. Supposedly Catalyst::Plugin::Observe will do this, but it appears completely broken (just loading the plugin breaks Catalyst).
I'm trying to fix the Observe plugin, but that's proving stubborn.
So, is there a better way to do get some cleanup code called at the end of each request?
(Note: This is in a model, not a controller, so I can't just use sub end { ... })

You can actually just add the code directly to your "MyApp" class:
package MyApp;
use Catalyst ...;
...
sub finalize {
my $c = shift;
$c->NEXT::finalize(#_);
# do your thing
}
This is how all plugins work; they are just methods that become part of your app.
I do agree that making "finalize" generate an event to observe is cleaner... but this is what we have to work with for now :) Join #catalyst on irc.perl.org, and we can discuss further. (I am jrockway, as you may guess.)
Edited to reply to:
(Note: This is in a model, not a controller, so I can't just use sub end { ... })
You do know that you have $c in end, right?
package Your::Model;
sub cleanup {
my $self = shift;
...
}
package Your::Controller;
sub end :Private {
my ($self, $c) = #_;
$c->model('Your::Model')->cleanup( ... )
}
Or you can do it from MyApp::finalize, as I suggested above.
The real question is, why does your model need to know about the request cycle? That sounds like awfully tight coupling.

Related

How to turn off caching in Mojolicious::Renderer [duplicate]

I'm currently developing a small single-page Web app using Mojolicious. The app has a Javascript frontend (using Backbone) that talks to a REST-ish API; the layout of the source is roughly:
use Mojolicious::Lite;
# ... setup code ...
get '/' => sub {
my $c = shift;
# fetch+stash data for bootstrapped collections...
$c->render('app_template');
};
get '/api_endpoint' => sub {
my $c = shift;
# fetch appropriate API data...
$c->render(json => $response);
};
# ... more API endpoints ...
app->start;
The app template uses EP, but very minimally; the only server-side template directives just insert JSON for bootstrapped collections. It's deployed via Apache as a plain CGI script. (This isn't optimal, but it's for low-traffic internal use, and more intricate server configuration is problematic in context.) Perl CGI is configured via mod_perl.
This works most of the time, but occasionally the renderer somehow gets the idea that it should cache the template and ignore changes to it. The debug records in error_log show "Rendering cached template" rather than the normal "Rendering template", and my new changes to the template stop appearing in the browser. I can't find a reliable way to stop this, though it will eventually stop on its own according to conditions I can't discern.
How can I make the app notice template changes reliably? Alternatively, how can I disable template caching completely?
How can I make the app notice template changes reliably?
This is what the morbo development server is for. Morbo wouldn't be used for your live code deployment, but for a development environment where you are continually changing your code and templates. Generally changes to live code and templates are meant to be handled by restarting the application server, or Apache in your case. (Hypnotoad has a hot-restart capability for this purpose)
Alternatively, how can I disable template caching completely?
To do this, add the following setup code (outside of routes, after use Mojolicious::Lite):
app->renderer->cache->max_keys(0);
For old answer see below.
I turned the findings of this answer into a plugin and released it on CPAN as Mojolicious::Plugin::Renderer::WithoutCache after discussing wit Grinnz on IRC, where they encouraged a release.
You can use it like this:
use Mojolicious::Lite;
plugin 'Renderer::WithoutCache';
It will create a new Cache object that does nothing, and install that globally into the renderer. That way, it doesn't need to be created every time like my initial answer below did.
In theory, this should be faster than Grinnz' approach (which is more sensible), and since you explicitly don't want to cache, you obviously want things to be as fast as possible, right? It's supposedly faster because the real Mojo::Cache would still need to go and try to set the cache, but then abort because there are no more free keys, and it also would try to look up the values from the cache every time.
I benchmarked this with both Dumbbench and Benchmark. Both of them showed negligible results. I ran them each a couple of times, but they fluctuated a lot, and it's not clear which one is faster. I included output of a run where my implementation was faster, but it still shows how minuscule the difference is.
Benchmark with Dumbbench:
use Dumbbench;
use Mojolicious::Renderer;
use Mojolicious::Controller;
use Mojolicious::Plugin::Renderer::WithoutCache::Cache;
my $controller = Mojolicious::Controller->new;
my $renderer_zero_keys = Mojolicious::Renderer->new;
$renderer_zero_keys->cache->max_keys(0);
my $renderer_nocache = Mojolicious::Renderer->new;
$renderer_nocache->cache( Mojolicious::Plugin::Renderer::WithoutCache::Cache->new );
my $bench = Dumbbench->new(
target_rel_precision => 0.005,
initial_runs => 5000,
);
$bench->add_instances(
Dumbbench::Instance::PerlSub->new(
name => 'max_keys',
code => sub {
$renderer_zero_keys->render( $controller, { text => 'foobar' } );
}
),
Dumbbench::Instance::PerlSub->new(
name => 'WithoutCache',
code => sub {
$renderer_nocache->render( $controller, { text => 'foobar' } );
}
),
);
$bench->run;
$bench->report;
__END__
max_keys: Ran 8544 iterations (3335 outliers).
max_keys: Rounded run time per iteration: 5.19018e-06 +/- 4.1e-10 (0.0%)
WithoutCache: Ran 5512 iterations (341 outliers).
WithoutCache: Rounded run time per iteration: 5.0802e-06 +/- 5.6e-09 (0.1%)
Benchmark with Benchmark:
use Benchmark 'cmpthese';
use Mojolicious::Renderer;
use Mojolicious::Controller;
use Mojolicious::Plugin::Renderer::WithoutCache::Cache;
my $controller = Mojolicious::Controller->new;
my $renderer_zero_keys = Mojolicious::Renderer->new;
$renderer_zero_keys->cache->max_keys(0);
my $renderer_nocache = Mojolicious::Renderer->new;
$renderer_nocache->cache( Mojolicious::Plugin::Renderer::WithoutCache::Cache->new );
cmpthese(
-5,
{
'max_keys' => sub {
$renderer_zero_keys->render( $controller, { text => 'foobar' } );
},
'WithoutCache' => sub {
$renderer_nocache->render( $controller, { text => 'foobar' } );
},
}
);
__END__
Rate max_keys WithoutCache
max_keys 190934/s -- -2%
WithoutCache 193846/s 2% --
I recon in a heavy load environment with lots of calls it would eventually make a difference, but that is very hard to prove. So if you don't like to think about the internals of the cache, this plugin might be useful.
Old answer:
Looking at Mojolicious::Plugin::EPRenderer I found out that there is a cache. It's a Mojo::Cache instance, which has the methods get, set and max_keys, and inherits from Mojo::Base (like probably everything in Mojolicious).
The ::EPRenderer gets a $renderer, which is a Mojolicious::Renderer. It holds the Mojo::Cache instance. I looked at $c with Data::Printer, and found out that there is a $c->app that holds all of those.
Knowing this, you can easily make your own cache class that does nothing.
package Renderer::NoCache;
use Mojo::Base -base;
sub get {}
sub set {}
sub max_keys {}
Now you stick it into $c.
package Foo;
use Mojolicious::Lite;
get '/' => sub {
my $c = shift;
$c->app->renderer->cache( Renderer::NoCache->new );
$c->render(template => 'foo', name => 'World');
};
app->start;
__DATA__
## foo.html.ep
Hello <%= $name =%>.
Now every attempt to get or set the cache simply does nothing. It will try caching, but it will never find anything.
Of course it's not great to make a new object every time. It would be better to make that object once at startup and get it into the internal permanent version of app. You have CGI, so it might not make a difference.
You could also just monkey-patch the get out of Mojo::Cache. This more hacky approach will do the same thing:
package Foo;
use Mojolicious::Lite;
*Mojo::Cache::get = sub { };
get '/' => sub {
my $c = shift;
$c->render(template => 'foo', name => 'World');
};
app->start;
But beware: we just disabled fetching from every cache in your application that uses Mojo::Cache. This might not be what you want.

In a Bugzilla extension, how does one detect a new comment being added?

Which hook does one need to hook into to determine when a new comment is being added to a bug?
My use case is that whenever a comment is being added I need to process all comments, and perform some action based on that. However, this action is “expensive”, so I don't want to perform the action unless a comment has really been added.
The only way that I have found so far to determine this is to hook into object_end_of_update with the code:
sub object_end_of_update {
my ($self, $args) = #_;
my ($object, $old_object, $changes) = #$args{qw(object old_object changes)};
print STDERR "--- Object Type: " . ref $object;
if ($object->isa('Bugzilla::Bug')) {
# Load comments on the old object here, otherwise by the time we get
# to bug_end_of_update it is too late, and we cannot determine if a
# new comment has been added or not.
$old_object->comments({order=>'oldest_to_newest'});
}
}
and then to hook into bug_end_of_update, whereupon I can do something like:
sub bug_end_of_update {
my ($self, $args) = #_;
my ($bug, $old_bug, $timestamp, $changes) = #$args{qw(bug old_bug timestamp changes)};
# Note that this will only work if the old comments have already been
# loaded in object_end_of_update, otherwise when we get the old comments
# here, it just goes to the DB, and gets all of the comments, including
# the new one, if there is one.
my $oldComments = $old_bug->comments({order=>'oldest_to_newest'});
my $newComments = $bug->comments({order=>'oldest_to_newest'});
if (scalar(#$newComments) > scalar(#$oldComments)) {
# If we added a new comment, then perform processing.
do_slow_action($bug);
}
}
However, this feels fragile, and even if it isn't, is definitely not clear code.
What is the correct way to determine that a comment has been added to a bugzilla bug?
Instead of adding a hook to the Bugzilla source code.
You could add a database trigger that is fired whenever an update occurred on the field comments.
The advantage is that as long as the database schema doesn't change too much with newer versions, the trigger will keep working. (more information: Database triggers).
Here is an example:
use bugs;
create TRIGGER new_comment
AFTER UPDATE ON bugs_fulltext
FOR EACH ROW BEGIN
IF NEW.comments <> OLD.comments
THEN
.... //execute your script
END IF
END;

In Perl, can I dynamically add methods to only one object of a package?

I'm working with WWW::Mechanize to automate web-based back office clicking I need to do to get my test e-commerce orders into the state I need them to be to test changes I have made to a particular part of a long, multi-part workflow. To process a lot of orders in a batch, I need to click the Home link often. To make that shorter, I hacked a method into WWW::Mechanize at run time like this (based on an example in Mastering Perl by brian d foy):
{ # Shortcut to go back to the home page by calling $mech->go_home
# I know I'll get a warning and do not want it!
no warnings 'once';
my $homeLink = $mech->find_link( text => 'Home' )->url_abs();
$homeLink =~ s/system=0/system=1/;
*WWW::Mechanize::go_home = sub {
my ($self) = #_;
return $self->get($homeLink);
};
}
This works great, and does not hurt anyone because the script I'm using it in is only used by me and is not part of the larger system.
But now I wonder if it is possible to actually only tell one $mech object that is has this method, while another WWW::Mechanize object that might be created later (to, say, do some cross-referencing without mixing up the other one that has an active session to my back office) cannot use that method.
I'm not sure if that is possible at all, since, if I understand the way objects work in Perl, the -> operator tells it to look for the subroutine go_home inside the package WWW::Mechanize and pass the $mech as the first argument to it. Please correct me if this understanding is wrong.
I've experimented by adding a sort of hard-coded check that only lets the original $mech object use the function.
my $onlyThisMechMayAccessThisMethod = "$mech";
my $homeLink = $mech->find_link( text => 'Home' )->url_abs();
$homeLink =~ s/system=0/system=1/;
*WWW::Mechanize::go_home = sub {
my ($self) = #_;
return undef unless $self eq $onlyThisMechMayAccessThisMethod;
return $self->get($homeLink);
};
Since "$mech" contains the address of where the data is stored (e.g. WWW::Mechanize=HASH(0x2fa25e8)), another object will look differently when stringified this way.
I am not convinced however that this is the way to go. So my question is: Is there a better way to only let one object of the WWW::Mechanize class have this method? I'm also glad about other suggestions regarding this code.
This is just
$mech->follow_link(text => 'Home')
and I don't think it's special enough to warrant a method of its own, or to need restricting to an exclusive club of objects.
It's also worth noting that there is no need to mess with typeglobs to declare a subroutine in a different package. You just have to write, for example
sub WWW::Mechanize::go_home {
my ($self) = #_;
return $self->get($homeLink);
};
But the general solution is to subclass WWW::Mechanize and declare as members only those objects you want to have the new method.
File MyMechanize.pm
package MyMechanize;
use strict;
use warnings;
use parent 'WWW::Mechanize';
sub go_home {
my $self = shift;
my $homeLink = $self->find_link(text => 'Home')->url_abs;
$homeLink =~ s/system=0/system=1/;
return $self->get($homeLink);
}
1;
File test.pl
use strict;
use warnings;
use MyMechanize;
my $mech = MyMechanize->new;
$mech->get('http://mydomain.com/path/to/site/page.html')
$mech->go_home;

RequestTracker and Mason destroying my class over and over again

I'm hacking on Request Tracker, which is written in perl and uses Mason
for the web interface. I'm trying to make a customized page, that involves an autohandler, an html page, and pulls in some methods in other comps. I have a simple class that I want to use to track a few things that I need for my parts of the interface. Right now all it
tracks is a database handle.
package RTx::FooBar::Web;
use strict;
use warnings;
use RTx::FooBar::Handle;
sub new
{
my $proto = shift;
$RT::Logger->debug("creating new");
my $class = ref($proto) || $proto;
my $self = {};
bless( $self, $class);
my $handle = RTx::FooBar::Handle->new();
$handle->Connect();
$self->{cfHandle} = $handle;
return $self;
}
sub DESTROY {
my $self = shift;
$RT::Logger->debug("destroy");
delete $self->{cfHandle};
}
sub CFHandle
{
my $self = shift;
return $self->{cfHandle};
}
1;
I tried sticking that into the session so I could use it wherever I needed
it in the web interface. So I try to use it in one web page - the autohandler does:
% $m->call_next;
<%INIT>
$RT::Logger->debug("my autohandler");
use RTx::FooBar::Web;
$session{cfWeb} ||= RTx::FooBar::Web->new();
</%INIT>
The thing that's bugging me right now (other than the fact that it's not
working) is that the logging in the "new" method prints out once, but the
logging in the DESTROY method prints out 56 times. And each time, the
debug in RTx::FooBar::Handle->DESTROY prints out as well, indicating that
$self->{cfHandle} wasn't removed. Can anybody suggest why this might be
happening? Is it because session is a tied hash?
*Update* I'm no longer using $session, and it's STILL destroying my handle 56 times after creating it once.
Just a guess here - $session is re-creating your objects from an externalized version (perhaps via Storable or the like). So it gets the object back without calling new so no logging. Not sure why it would be getting destroyed every time tho.
It looks like $session is in fact a tied hash, to an Apache::Session or something implementing the same interface (the docs talk about db backing for sessions).
If you want to have a global persistent object (i.e., not tied to a single request) then give it a fully-qualified name, e.g., $RTx::FooBar::Web::TheObject ||= RTx::FooBar::Web->new(); or use something like Cache::MemoryCache. Alternately, set up your own global variable in the MasonAllowGlobals setting, although you might need to get into RT's config files to change that.

Why does this conditional redirect in Catalyst not work?

I have a Catalyst application and would like to redirect based on a conditional statement. I am having trouble with this and I'm wondering if anyone might have insight into why this seemingly easy task is proving difficult.
In my Root.pm module I have a sub begin and can redirect to another website, e.g. www.perl.org, but I am unable to redirect to a page within my application. Any thoughts on how to do a conditional redirect?
sub begin : Private {
my ( $self, $c ) = #_;
$c->stash->{client_id} = somenumber; # I'm setting this manually for testing
$c->res->redirect('http://www.perl.org/') unless $c->stash->{client_id};
$c->res->redirect('http://www.mysite.com/success') if $c->stash->{client_id}; #does not
}
Maybe you're getting stuck in an infinite loop, in which your begin sub redirects the user to another page in your Catalyst application; once "the controller that will run has been identified, but before any URL-matching actions are called" (from the Catalyst::Manual::Intro man page), begin will be called again, causing another redirect and so on.
Try moving this code out of begin entirely; perhaps, as Htbaa suggested, auto might be what you're looking for. The standard $c->detach case (in controller controller) is:
sub check_login :Local {
# do something
$c->detach('controller/login_successful') if($success);
# display error message
}
sub login_successful :Local {
# do something with the logged in user.
}
In this case, doing a $c->res->redirect('http://example.com/login_successful') should work perfectly as well. Hope that helps!