Asynkron Perl med Proc::Simple

Knut-Olav — Thu, 05 Mar 2009 20:28:53 +0000

Jeg har nettopp skrevet en web-applikasjon i Perl basert på web-rammeverket Catalyst.

Noe av det denne applikasjonen gjør er å flytte filer, og ofte er dette store filer, på nærmere 1 GB hver. Dette tar tid, spesielt når det skjer mellom to maskiner over en SSH-forbindelse. Siden dette er en web-applikasjon medfører dette at koblinga til brukerens nettleser timer ut og brukeren blir presentert med en lite hyggelig feilmelding. Løsningen min måtte være å kjøre filkopieringen asynkront, men hvordan?

Jeg kjører Catalyst som en FastCGI-server med 20 prosesser, bak en Apache web-server. Disse Catalyst-prosessene står og går, selv når brukeren ikke laster noen nettside, og er dermed ypperlig for å kjøre bakgrunnsprosesser i, og samtidig kunne ta imot eventuelle feilmeldinger som kan oppstå.

Jeg kom over Proc::Simple, en Perl-modul som tilbyr å kjøre Perl-funksjoner i bakgrunnen av den normale eksekveringen av koden din. Det jeg gjorde var å lage en ny funksjon, med alt det tidkrevende arbeidet, som jeg tilordnet en variabel. Så sendte jeg med referansen til denne funksjonen inn i Proc::Simple. Ved feil så logges feilmeldingen til en database og brukeren ser feilmeldingen neste gang nettsiden lastes.

Jeg har laget en modell, som du ser nedenfor, som pakker inn Proc::Simple-modulen. For sikkerhets skyld så drepes alle kjørende bakgrunnsprosesser hvis Catalyst skulle avsluttes før disse er ferdige. Vi vil ikke ha løse prosesser kjørende, vil vi?

Jeg tar gjerne imot tilbakemeldinger om forbedringer. Den er ikke så avansert, den er noe dokumentert, og jeg håper den kan være til nytte.

package MyApp::Model::ProcSimple;

use strict;
use warnings;
use parent qw/
    Catalyst::Model
    Class::Accessor::Fast
/;

use Proc::Simple;

__PACKAGE__->mk_accessors(qw/procs/);

=head1 NAME

MyApp::Model::ProcSimple - Catalyst Model

=head1 DESCRIPTION

Catalyst Model.

=head1 METHODS

=head2 start

 Args: $selv, $subref

Takes a subroutine reference as a parameter and starts to execute this
in the background.

It stores a reference to the process in an instance variable,
so the process wont get killed after this method returns.

Ended processes will be cleaned up in LACCEPT_CONTEXT>.

=cut

sub start {
    my ($self, $subref) = @_;

    my $proc = Proc::Simple->new();

    $proc->start($subref);

    # Kill the process if the object is destroyed (app is stopped)
    $proc->kill_on_destroy(1);

    my %procinfo = (
        'proc'      => $proc,
        'started'   => DateTime->now,
    );

    push @{$self->procs}, \%procinfo;

    return 1;
}

=head2 ACCEPT_CONTEXT

 Args: $self, $c

Iterates over all background processes that has been running
since last time this model was called for.

All ended processes will be removed from the list.

=cut

sub ACCEPT_CONTEXT {
    my ($self, $c) = @_;

    $self->procs([]) unless $self->procs;

    # Killing and removing ended processes
    if (scalar @{$self->procs}) {
        my @to_remove = ();

        $c->log->debug(sprintf(
            "Looping over %d procs to look for finished processes",
            scalar @{$self->procs}
        )) if $c->debug;

        for my $idx (0 .. scalar @{$self->procs} - 1) {
            my $procinfo    = $self->procs->[$idx];
            my $proc        = $procinfo->{'proc'};
            my $running     = $proc->poll() if $proc;
            push @to_remove, $idx unless $running;
        }

        for my $idx (@to_remove) {
            my $procinfo = $self->procs->[$idx];
            my $pid = $procinfo->{'proc'}->pid;
            $c->log->info("Proc::Simple process $pid has finished. Removed.");

            delete $self->procs->[$idx]
        }
    }

    return $self;
}

=head1 SEE ALSO

L<Proc::Simple>

=head1 AUTHOR

Knut-Olav Hoven, E<lt>knutolav@gmail.comE<gt>

=head1 LICENSE

This library is free software, you can redistribute it and/or modify
it under the same terms as Perl itself.

=cut

1;

Alt om ingenting og litt i mellom » asynkront

Asynkron Perl med Proc::Simple