Catalyst: send warnings to the virtual host log file

So, you run Catalyst on mod_perl in a virtual host, but logs will not go where you expect them to go, which is to the log file defined in the virtual host.

This is the cause: all STDERR output send by mod_perl via core functions such as warn get dumped in the default Apache log (most likely at /var/log/apache2/error_log or /var/log/httpd/error_log). To send to the virtual host log you need to read this: Apache2::Log : Virtual Hosts

Add this option to the virtual host apache config file:

        PerlOptions +GlobalRequest

Then make a custom logger object in your base Catalyst class, or override the log class with

__PACKAGE__->log( Blah::Logger->new({debug => 1}) );

and in the methods you call there use something like this

# http://perl.apache.org/docs/2.0/api/Apache2/Log.html#LogLevel_Methods
# emerg(), alert(), crit(), error(), warn(), notice(), info(), debug()

use Apache2::RequestUtil;

my %map = (
  info => 'info',
  warning => 'warn',
  error => 'error',
  debug => 'debug',
  summary => 'info',
);

sub warning {
  my ($self, $message, $message_type) = @_ ;

  my $r = Apache2::RequestUtil->request();
  my $method = $map{$message_type} || 'error';
  $r->log->$method($message);
}

This $r->log->$method($message) will send the log to the virtual host log.

To have all the warnings sent there, add this to the main class of your catalyst app.:

use Apache2::RequestUtil;

around dispatch => sub {
    my ($orig, $self) = (shift,shift);
    local $SIG{__WARN__} = sub {
      my $r = Apache2::RequestUtil->request();
      $r->log_error(@_);
    };

    return $self->$orig(@_);
};

This last trick will not fix the default Catalyst logging: as of now, Catalyst::Log uses "print STDERR" to dispatch your debug, info, warn etc. messages.

print STDERR will still send to the default apache log, and here is one solution:

in your main Catalyst class add the following

use MyApp::Log::STDERRHandler;

...

around dispatch => sub {
    my ($orig, $self) = (shift,shift);

    tie(*STDERR, 'MyApp::Log::STDERRHandler');

...

and create this:

package MyApp::Log::STDERRHandler;
use strict;
use warnings;

use Apache2::RequestUtil;
use Data::Dumper;

# http://perl.apache.org/docs/2.0/api/Apache2/Log.html#LogLevel_Methods
# emerg(), alert(), crit(), error(), warn(), notice(), info(), debug()
# map Catalyst error levels to Apache error levels
my %map = (
        # Apache::Log debug prints the name of the module that sends
        # the message; in this case the information is useless
 debug => 'info', 
 info => 'info',
 warn => 'warn',
 error => 'error',
    fatal => 'crit',
);


sub TIEHANDLE {
    my $class = shift;
    return bless {} , $class;
}


sub PRINT {
    my ($self, @data) = @_;
    my $r = Apache2::RequestUtil->request();
    
    # try to intercept Catalyst::Log calls, 
    # which should begin with [info] etc.
    # Catalyst gathers all the log messages in a buffer 
    # then prints them all at once
    my @chunks = ();

    # just in case there is more than one piece of data
    # Catalyst should send only one bunch of lines, but you never know
    foreach my $m (@data) {
        my @lines = split "\n", $m;
        @chunks = (@chunks, @lines) if @lines;
    }
    
    for (my $i = 0; $i <= $#chunks; $i++) {
        my $log_level = '[info]';
        if ($chunks[$i] =~ /^\[(debug|info|warn|error|fatal)\]/ ) {
            $log_level = $1;
        }
        
        # uncomment this if you want to remove the original Catalyst log levels
        #if ($log_level) {
        #    my $remove_catalyst_log_level = '[' . $log_level . ']';
        #    $chunks[$i] =~ s/^\[(debug|info|warn|error|fatal)\]//i;
        #}

        $log_level ||= 'error';

        my $method = $map{$log_level} || 'error';
        $r->log->$method($chunks[$i]);
    }
}

1;

Zombie game with Perl

Zumbis