source: trunk/soft/ObsData/ObsData/Archive/Tar.pm @ 152

# $Id$

package ObsData::Archive::Tar;

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) = @_;

    if (!$options->{uncomp}) {
        for ($options->{archive}) {
            /\.(Z|gz)$/ and $options->{uncomp} = 'gzip -dc';
            /\.bz2$/ and $options->{uncomp} = 'bzip2 -dc';
        }
    }
    $options->{uncomp} ||= 'cat';
    bless($options, $class);
}

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

sub ls {
    my ($self) = @_;
    open(my $htar, '-|', "$self->{uncomp} '$self->{archive}' | tar tf -") or do {
        seterror("Can't read tar file: $!");
        return undef;
    };
    my @list;
    while(<$htar>) {
        chomp;
        push(@list, $_);
    }
    close($htar);
    return @list;
}

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

    my $tempdir = tempdir();
    my $here = getcwd();
    my $abs_path = Cwd::abs_path($self->{archive});
    my $abs_dest = Cwd::abs_path($dest);
    
    if(!chdir($tempdir)) {
        $self->seterror("Can't chdir: $!");
        return undef;
    }

    system("$self->{uncomp} '$abs_path' | tar xf - '$file'") and do {
        $self->seterror("Can't extract file from tar: $!");
        chdir($here);
        return undef;
    };
    
    if ($dest) {
        open(my $fh, '>', $abs_dest) or return undef;
        if(!copy("$tempdir/$file", $fh)) {
            $self->seterror("Can't copy file to destination: $!");
            unlink($abs_dest);
            chdir($here);
            return undef;
        }
        close($fh);
        unlink("$tempdir/$file");
        chdir($here);
        return $dest;
    } else {
        chdir($here);
        return "$tempdir/$file";
    }
}

1;