source: trunk/soft/ObsData/ObsData/Archive/Rar.pm @ 157

# $Id$

package ObsData::Archive::Rar;

use strict;
use warnings;
use File::Copy;
use File::Temp qw/ tempfile tempdir /;
use Cwd;

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

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

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

sub ls {
    my ($self) = @_;
    open(my $hrar, '-|', "unrar lb '$self->{archive}'") or do {
        $self->seterror("Can't read zip file: $!");
        return undef;
    };
    my @list;
    while(<$hrar>) {
        chomp;
        push(@list, $_);
    }
    close($hrar);
    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
}

1;