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!
Related
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 one of my controllers, I'm doing some SSE async streaming (see here), and I have it working great in a barebones test project. In the test project, I don't have a default view set, so it seems to just pass through - perfect!
Now I'm trying to put it into my existing larger project, however, I'm finding that forwarding it to any view messes it up and I can't figure out how to simply skip the rendering of a view. Because I have a default view now, it refuses to just pass through.
I've blindly tried a few things: $c->detach, $c->forward(undef), overriding the "end" method. None have succeeded in skipping the view rendering - it always passes it on to my default view.
Any ideas?
Edit
Not super relevant, but the action in question:
sub time_server : Path('/events') {
my ( $self, $c ) = #_;
$c->res->content_type('text/event-stream');
$timer_model->( $c, $c->response->write_fh );
}
Catalyst::Action::Renderview has a small set of criteria it uses when deciding whether or not to call the view. It will skip running the view if:
The request was a HEAD request.
Something has already set $c->response->body to a defined value.
$c->response->status is set to 204 ("No Content") or any 3xx (redirection).
$c->error contains one or more errors and $c->stash->{template} hasn't been set (so that finalize_error can do its job instead).
Honestly this isn't the best possible arrangement, but what I would try in your situation is setting $c->res->body(""); in your time_server action. An empty body won't write anything, and your headers are already finalized since you've called write_fh, but an empty string is still defined so it'll keep RenderView from doing anything.
This is my solution to force the function in default Catalyst controller response JSON type. You should change the content type to stream.
I hope it can help you.
sub my_function{
my ( $self, $c ) = #_;
my $payload = {
"yourkey" => "backtooldschool",
"yourkey2" => "2020"
};
my $result = encode_json($payload);
$c->response->body($result);
$c->response->content_type('application/json');
$c->response->status(200);
}
I'm using Apache2::Cookie (i.e. Apache2 with mod_perl) to parse cookies.
my %cookies = Apache2::Cookie->fetch;
do_something($cookies{"cookie1"});
This code has been running in production for years without any problems. I just learned that a cookie with particular formatting causes this to throw an exception Expected token not present. The cookie in question is generated by client-side JavaScript:
document.cookie = "val=a,b"
Apache2::Cookie appears to not like the comma.
I can catch this error with eval, but the cookie retrieval is done in lots of places in the code (yes, it could have been factored out, but frankly the code is so simple there was no need). In any case, it's there now and I have to track down and catch the exception for this cookie that I didn't set and I don't need.
Is there an easier way to get rid of this exception than refactoring dozens of calls to Apache2::Cookie->fetch? Either by redefining Apache2::Cookie::fetch, or by setting a global flag for libapreq to not puke on this (there isn't any I could find), or some other bright idea I'm missing.
(yes, it could have been factored out, but frankly the code is so simple there was no need).
I would take this opportunity to fix this oversight, instead of making another
If you insist, you could learn something from CGI::Cookie
sub fetch {
my $class = shift;
my $raw_cookie = get_raw_cookie(#_) or return;
return $class->parse($raw_cookie);
}
sub get_raw_cookie {
my $r = shift;
$r ||= eval { $MOD_PERL == 2 ?
Apache2::RequestUtil->request() :
Apache->request } if $MOD_PERL;
return $r->headers_in->{'Cookie'} if $r;
die "Run $r->subprocess_env; before calling fetch()"
if $MOD_PERL and !exists $ENV{REQUEST_METHOD};
return $ENV{HTTP_COOKIE} || $ENV{COOKIE};
}
I faced the same issue and you can find the solution here :
“Expected token not present” error in my Apache log
I've been trying to switch from using PerlSetEnv to using custom configuration directives. I have my configuration module with a copy of set_val from the docs:
sub set_val
{
local our ($key, $self, $parms, $arg) = #_;
$self->{$key} = $arg;
unless ($parms->path)
{
local our $srv_cfg = Apache2::Module::get_config($self, $parms->server);
$srv_cfg->{$key} = $arg;
}
}
...which is called by every custom directive sub. Then I have in my .conf:
PerlLoadModule MyModule::ServerConfig
MyCustomDirective 'hello'
This works fine in that httpd -t okays the file's syntax. The problem is that I can't seem to get at the value from the config file from within a BEGIN block, which I need to do.
I've tried tinkering with all sorts of things:
BEGIN
{
use Apache2::CmdParms ();
# use Apache2::Directive ();
use Apache2::Module ();
# use Apache2::ServerUtil ();
# use Apache2::RequestUtil ();
use Data::Dump;
warn ddx(Apache2::Module::get_config('MyModule::ServerConfig', Apache2::CmdParms->server));
# warn ddx(Apache2::Directive->as_hash);
# warn Apache2::ServerUtil->dir_config('MyCustomDirective);
# warn Apache2::CmdParms->server->server_hostname();
}
...but to no avail. Most of my efforts (trying to access CmdParms->server for instance) result in Parent: child process exited with status 3221225477 -- Restarting and an automatic restart of Apache as it says. If I pass ServerUtil->server to get_config(), the server stays alive but the warning only prints out '1'.
I read somewhere that this is because you can't get at anything request-related within a BEGIN block, because requests vary. It kind of makes sense, except that with PerlOptions +GlobalRequest I have been able to see $ENV within a BEGIN block, so why wouldn't I be able to see my own directives, just as dependent as they are on how the request happens? Especially confusing is that if I try to pass Apache2::RequestUtil->request->per\_dir\_config() to get_config(), it says Global $r object is not available. If that's true in a BEGIN block, how is it I can get at $ENV?
Try add what you want to import function to other module and use this module in code where you usually put BEGIN block. It should work same. May be it helps.
Partly, Dump isn't being used correctly. This works better:
use Data::Dump qw(pp);
warn pp(Apache2::Module::get_config('MyModule::ServerConfig', Apache2::ServerUtil->server));
However, it doesn't show any directives that appear within <Directory> blocks.
In my particular case, though, I don't need that functionality, on second thought; that just happens to be where I had stuck them.
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.