renamed from "perl hunting" to "blue collar dev" to fit my current mood

profiling Catalyst applications with Devel::NYTProf

While attempting to profile a Catalyst application with Devel::NYTProf, I kept getting errors when processing the nytprof.out file because the file was not closed properly.

The solution from http://fkumro.blogspot.ro/2011/11/using-nytprof-with-catalyst.html did not work, kept getting "panic at nytprofcalls line 191" messages.

What worked was starting with

perl -d:NYTProf scripts/myapp_server.pl

adding a

sub stop :Path {
    exit(0);
}

in the Root.pm and loading that in  the browser to stop the server.

starman workers use too much memory and do not release it to the operating system in time

if your large data is a string, this might help http://www.perlmonks.org/?node_id=661900

if not, you can redefine the Net::Server::PreForkSimple's "done" method to mark the worker as "done" as soon as the request is finished: adjust

$memory_soft_cap 

to your liking and stick this in your psgi file

package Net::Server::PreForkSimple;
use strict;
use warnings;
use BSD::Resource;
no warnings 'redefine';
my $memory_soft_cap = 148680;
sub done {
    my $self = shift;
    my $prop = $self->{'server'};
    $prop->{'done'} = shift if @_;
    return 1 if $prop->{'done'};
    return 1 if $prop->{'requests'} >= $prop->{'max_requests'};
    return 1 if $prop->{'SigHUPed'};
    if (! kill 0, $prop->{'ppid'}) {
        $self->log(3, "Parent process gone away. Shutting down");
        return 1;
    } 

# above this is the original code 
# from Net::Server::PreForkSimple::done 

 my $rus = getrusage();
    if ( $rus->{maxrss} >= $memory_soft_cap ) {
        $self->log(3, "Maximum memory exceeded, this child will not serve more requests");
        return 1 ;
    }

    return 0;
# end customization

}

This is useful if only a few requests need a lot of memory and the workers are not recycled soon enough; if all the requests use large amounts of memory this is not the best solution, it will make starman to spawn a new worker for each request.

install dependencies

to install dependencies for a module you got from github, in Makefile.PL add to this section

    PREREQ_PM => {
        'Moose' => 2,
        'Mason' => 2.20,
        'Plack' => 1,
    }

then

cpanm --installdeps . 

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