Beefy Boxes and Bandwidth Generously Provided by pair Networks
Problems? Is your data what you think it is?
 
PerlMonks  

Re^4: mod_perl give 404 not_found with content

by Anonymous Monk
on Apr 07, 2011 at 12:56 UTC ( [id://898038]=note: print w/replies, xml ) Need Help??


in reply to Re^3: mod_perl give 404 not_found with content
in thread mod_perl give 404 not_found with content

This works
<Location /perl> SetHandler perl-script PerlResponseHandler ModPerl::Registry Options +ExecCGI PerlOptions +ParseHeaders PerlOptions +SetupEnv </Location> #!/usr/bin/perl -- use strict; use warnings; use CGI; use Data::Dumper; Main(@ARGV); exit(0); sub Main { my $cgi = CGI->new; print $cgi->header( -status => 404, -nph => 0, ); print $cgi->start_html, $cgi->b(rand time, ' ', scalar gmtime), print '<table border="1" width="%100"><tr><td>', $cgi->Dump, '</td><td><div style="white-space: pre-wrap; overflow: scroll;">', $cgi->escapeHTML( Dumper( $cgi ) ), '</div></td></tr></table>', CGI->new( \%ENV )->Dump; print $cgi->hr; print $cgi->end_form, $cgi->end_html; }
This works
PerlModule Apache2::Hello404 <Location /hello404> SetHandler perl-script PerlResponseHandler Apache2::Hello404 </Location> package Apache2::Hello404; use Apache2::RequestRec; use Apache2::RequestIO; use Apache2::Const -compile => qw(OK NOT_FOUND); sub handler { my $r = shift; my $package = __PACKAGE__; my $req = Apache2::Request->new($r); my $val = $req->param('key') || ''; my $msg = $val ? qq{You passed in a value of "$val" for "key"} : 'No "key" parameter was passed '; my $time = scalar localtime; $r->status(Apache2::Const::NOT_FOUND); $r->content_type('text/html'); $r->print(<<"END"); <html> <head><title>$package handler</title></head> <body> Hello from $package. It is $time.<br /> $msg </body> </html> END return Apache2::Const::OK; } 1;
Using $r->status() is key

Replies are listed 'Best First'.
Different context
by Jaap (Curate) on Apr 07, 2011 at 13:16 UTC
    Unfortunately it doesn't work for me.
    My mod_perl/startup.pl looks like this:
    use strict; use Apache::DBI; use Apache2::Request; use File::Slurp; use Net::SMTP; #use CGI; #CGI->compile(':all'); Apache::DBI->connect_on_init('DBI:mysql:dbname::localhost', "user", "* +*****", { PrintError => 1, # warn() on errors RaiseError => 0, # don't die on error AutoCommit => 1, # commit executes mysql_enable_utf8 => 1, # immediately } ) or die "Cannot connect to database: $DBI::errstr";
    And then there's a myscript.pl in the mode_perl dir that looks like this:
    #!/usr/bin/perl use strict; use warnings; my $r = shift; my $cgi = Apache2::Request->new($r); my $QUERY; if ($cgi->param('q') =~ /^([a-zA-Z0-9\ \.\,\-_\:\;]+)$/) { $QUERY = $1; } my $ruri = $ENV{'REQUEST_URI'}; $ruri =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg; ... ... if ($sth->rows == 0) { #$r->err_headers_out->set(Location => "$ruri/"); $r->status(404); #$r->status(Apache2::Const::NOT_FOUND); $r->content_type('text/html'); $r->print(<<"END"); <html> <head><title>handler</title></head> <body> Hello from ME.<br /> </body> </html> END ModPerl::Util::exit(0); } ... ...
      Full blown browsers tend to replace 404 responses with their own, especially if the responses are small. Are you sure that the problem in on the server side?
      Unfortunately it doesn't work for me.

      My code, verbatim, doesn't work for you?

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: note [id://898038]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others lurking in the Monastery: (5)
As of 2024-04-25 19:59 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found