Re: Archiving with POE

Hi,
 
I built a POE package to tar and compress up a directory. The package
seems to work ok under LINUX, however when I run it under Activestate
Win32 Perl, the program locks up and seems to be in a infinite loop. I
decided to turn on POE debugging and then the program crashed. I have
attached the error.log.

I'm using WinXP Pro SP2, Activestate Perl v5.8.8 (822), POE 0.9999.

Thanks
Jeremy

====================================================================================
 
package Archiver;

use strict;
use warnings;
 
sub POE::Kernel::ASSERT_DEFAULT () { 1 };
sub POE::Kernel::TRACE_DEFAULT  () { 1 };

use Carp;
use POE qw(Session Wheel::ReadWrite Driver::SysRW Filter::Stream
Filter::Zlib);
use File::Spec;
use Archive::Tar;
use Archive::Tar::Constant;
 
sub spawn {
    my $class        = shift;
    my $dir          = shift;
    my $archive_path = shift;
 
    POE::Session->create(
    args => [ $dir, $archive_path ],
    options       => { trace => 1, debug => 1 },
        inline_states => {
            _start            => \&start,
            _stop             => \&stop,
            add_file          => \&add_file,
            compress          => \&compress,
            tar_read_input    => \&tar_read_input,
            compress_complete => \&compress_complete,
            compress_error    => \&compress_error,
        },
    );
    undef;
}
 
sub start {
    my ( $kernel, $session, $heap, $dir, $archive_path )
        = @_[KERNEL, SESSION, HEAP, ARG0, ARG1];
    my $tar = "$archive_path.tar";
    my $tarfh;
    open $tarfh,'>',"$tar" || croak( "Couldn't create archive $tar: $!"
);
    binmode $tarfh;
    my @files;
    get_files($dir, \@files);
    $heap->{files}   = \@files;
    $heap->{tarfh}   = $tarfh;
    $heap->{tarfile} = $tar;
    $kernel->yield('add_file');
}
 
sub stop {
    my ( $kernel, $session, $heap ) = @_[KERNEL, SESSION, HEAP];

}
 
sub add_file {
    my ( $kernel, $session, $heap ) = @_[KERNEL, SESSION, HEAP];
    my $file = shift @{$heap->{files}};
    if ( !defined $file ) {
        $kernel->yield('compress');
        return;
    }
    my $tarfile = $heap->{tarfh};
    my $arch = Archive::Tar->new;
    $arch->add_files($file)
        || croak( "Error adding file to archive $file: $!" );
    my $tf = $arch->write;
    syswrite $tarfile, $tf, length($tf) - (BLOCK * 2);
    $kernel->yield('add_file');
}
 
sub compress {
    my ( $kernel, $session, $heap ) = @_[KERNEL, SESSION, HEAP];
    my $tarfh = $heap->{tarfh};
    close $tarfh;
    open $tarfh,"<", $heap->{tarfile}
        || croak("Couldn't open $heap->{tarfile}: $!");
    binmode $tarfh;
 
    my $writefh;
    my $compress_tar ="$heap->{tarfile}.gz";
    open $writefh,">", "$compress_tar"
        || croak("Couldn't create archive $compress_tar: $!");
    binmode $writefh;
 
    $heap->{wheel} = POE::Wheel::ReadWrite->new(
        InputHandle  => $tarfh,
        OutputHandle => $writefh,
        Driver       => POE::Driver::SysRW->new( BlockSize => 65536 * 4
),
        InputFilter  => POE::Filter::Stream->new(),
        OutputFilter => POE::Filter::Zlib->new(),
        InputEvent   => "tar_read_input",
        FlushedEvent => "compress_complete",
        ErrorEvent   => "compress_error",
    );
}
 
sub tar_read_input {
    my ($heap, $input) = @_[HEAP, ARG0];
    $heap->{wheel}->put($input);
}
 
sub compress_complete {
    my ($heap, $wheel_id) = @_[HEAP, ARG0];
    delete $heap->{wheel};
    unlink $heap->{tarfile};
}
 
sub compress_error {
    my ($heap, $operation, $errnum, $errstr, $wheel_id) = @_[HEAP,
ARG0..ARG3];
    croak( "Compress $operation error $errnum: $errstr" );
    delete $heap->{wheels}->{$wheel_id};
}
 
sub get_files {
    my $dir   = shift;
    my $files = shift;
    opendir(DIR, $dir) || croak("Cannot open the dir: $dir: $!");
    my @contents =
        map File::Spec->catdir($dir, $_),
        sort grep ! /^\.\.?$/,
        readdir DIR;
    closedir DIR;
    push @$files, $dir;
    foreach my $fullpath (@contents) {
        if (-d $fullpath) {
            get_files($fullpath, $files);
        }
        else {
            push @$files, $fullpath;
        }
    }
}
 
Archiver->spawn('C:/temp/topo', 'C:/temp/topo');
 
$poe_kernel->run();

====================================================================================

______________________________________________________________________________________________________

This message contains information, which is confidential and may be subject to 
legal privilege. 
If you are not the intended recipient, you must not peruse, use, disseminate, 
distribute or copy this message.
If you have received this message in error, please notify us immediately (Phone 
0800 665 463 or info@xxxxxxxxxxxx) and destroy the original message.
LINZ accepts no responsibility for changes to this email, or for any 
attachments, after its transmission from LINZ.

Thank you.
______________________________________________________________________________________________________

error.log
Description: Binary data