source: trunk/soft/ObsData/ObsData/Archive/Compressed.pm @ 162

# $Id$

package ObsData::Archive::Compressed;

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

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';
        }
    }
    
    bless($options, $class);
}

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

sub ls {
    my ($self) = @_;
    $self->{archive} =~ m,^(?:.*/)?(?:(.*)(?:\.(?:gz|bz2|Z))|(.*))$,;
    return $1 || $2;
}

sub extract {
    my ($self, $file, $dest) = @_;
    # the devel should specify the file he want
    # as the basic contains only 1 file... this does not matter

    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, "$self->{uncomp} '$self->{archive}' 2>/dev/null |") or return undef;
    
    if(!copy($sourcefh, $fh)) {
        $self->seterror("Can't copy file to destination: $!");
        unlink($fname);
        return undef;
    }
    
    close($fh);
    if(!close($sourcefh)) {
        $self->seterror("$self->{uncomp} exit with error" . ($! ? (" " . $!) : ""));
        unlink($fname);
        return undef;
    }
    $fname
}

ObsData::Archive::register(sub { $_[0] =~ /\.(gz|Z|bz2)$/i }, 'Compressed', 5);