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

Asynchronous HTTP Requests in Perl Using AnyEvent

Asynchronous HTTP Requests in Perl Using AnyEvent http://www.windley.com/archives/2012/03/asynchronous_http_requests_in_perl_using_anyevent.shtml simple example on how to do non-blocking stuff in perl

getting slash code

this will work

git clone --branch live  git://slashcode.git.sourceforge.net/gitroot/slashcode/slashcode

diff between two mysql databases

get differences between two iterations of the same database; requires the username and the password be set in ~/.my.cnf ; do not add the database name to ~/.my.cnf

... not perl, posting here so I'll have access to the script when not at home

#!/usr/bin/env bash

echo "" > differences.diff;

DB_ORIGINAL="db_old"
DB_MODIFIED="db_modified"

declare -A SKIP_TABLES
SKIP_TABLES[hits]=1
SKIP_TABLES[spam_reports]=1
SKIP_TABLES[searches]=1

for i in `mysql $DB_ORIGINAL --skip-column-names -e "show tables" | awk '{print $1}'`;
do 
    echo "looking at " $i;    
    echo "TABLE " $i >> differences.diff

    mysqldump --no-data $DB_MODIFIED $i > $i.definition.modified.sql; 
    mysqldump --no-data $DB_ORIGINAL $i > $i.definition.original.sql; 
    diff $i.definition.original.sql $i.definition.modified.sql >> differences.diff;
    
    #clean up
    rm $i.definition.original.sql 
    rm $i.definition.modified.sql
    # skip data
    if [[ ${SKIP_TABLES[$i]} = 1 ]]
    then
        echo "skipping data for " $i;
        continue;
    fi

    mysqldump --skip-extended-insert --no-create-info $DB_MODIFIED $i > $i.data.modified.sql; 
    mysqldump --skip-extended-insert --no-create-info $DB_ORIGINAL $i > $i.data.original.sql; 

    diff $i.data.original.sql $i.data.modified.sql | grep -v ' Host:'  >> differences.diff;
    
    # clean up
    rm $i.data.original.sql;
    rm $i.data.modified.sql;
done