source: trunk/soft/ObsData/ObsData/Archive/Lha.pm @ 240

# $Id$

package ObsData::Archive::Lha;

use strict;
use warnings;
use File::Copy;
use File::Temp qw/ tempfile /;
use ObsData::Archive;

our @ISA = qw(ObsData::Archive::template);

sub new {
    my ($class, $options) = @_;
    bless($options, $class);
}

sub DESTROY_ {
    my ($self) = @_;
}

sub ls {
    my ($self) = @_;
    open(my $hlha, '-|', "lha '$self->{archive}'") or do {
        $self->seterror("Can't read lha/lzh file: $!");
        return undef;
    };
    my @list;
    <$hlha>;
    <$hlha> =~ /^-{9}/ or return;
    while(<$hlha>) {
        chomp;
        /^.{51}(.*)$/;
        push(@list, $1);
    }
    close($hlha);
    return @list;
}

sub extract {
    my ($self, $file, $dest) = @_;

    my ($fh, $fname);
    
    if ($dest) {
        $fname = $dest;
        open($fh, '>', $dest) or do {
            $self->seterror("Can't uncompress archive: $!");
            return undef;
        };
    } else {
        ($fh, $fname) = tempfile(
            DIR => $self->_tempdir,
            UNLINK => 1,
        ) or do {
            $self->seterror("Can't create temp file: $!");
            return undef;
        };
    }

    open(my $sourcefh, "unrar p -ierr '$self->{archive}' '$file' 2>/dev/null |") or return undef;
    
    if(!copy($sourcefh, $fh)) {
        $self->seterror("Can't copy file to destination: $!");
        unlink($fname);
        return undef;
    }
    
    close($fh);
    # FIXME unrar sucks, does return a proper exit status on error (allways 0)
    if(!close($sourcefh)) {
        $self->seterror("unrar -p exit with error" . ($! ? (" " . $!) : ""));
        unlink($fname);
        return undef;
    }
    $fname
}

ObsData::Archive::register(sub { $_[0] =~ /\.(lzh|lha)$/i }, 'Lha', 0);