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

# $Id$

package ObsData::Archive::Lha;

use strict;
use warnings;
use File::Copy;
use File::Temp qw/ tempdir /;
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;
        /^(\[\w*\]|(-|d|l|c|b)((-|r)(-|w)(-|x)){3} [^-])/ or next;
        /^.{51}(.*)$/;
        push(@list, $1);
    }
    close($hlha);
    return @list;
}

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

    my $dir = tempdir();

    if (system("lha xfw=$dir '$self->{archive}' '$file'")) {
         $self->seterror("Can't uncompress archive: $!");
         return undef;
    }
    
    if ($dest) {
        open(my $fh, '>', $dest) or do {
            $self->seterror("Can't uncompress archive: $!");
            return undef;
        };
        open(my $sourcefh, '<', "$dir/$file") or do {
            $self->seterror("Can't open temp file for reading: $!");
            return undef;
        };

        if(!copy($sourcefh, $fh)) {
            $self->seterror("Can't copy file to destination: $!");
            unlink("$dir/$file");
            return undef;
        }
        close($fh);
        close($sourcefh);
    }
    
    return $dest || "$dir/$file";
}

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