source: trunk/soft/ObsData/ObsData/Archive.pm @ 161

# $Id$

package ObsData::Archive;

use strict;
use warnings;
use ObsData::Archive::FlatFile;
use ObsData::Archive::Compressed;
use ObsData::Archive::Tar;
use ObsData::Archive::Zip;
use ObsData::Archive::Rar;

our $CVSID = q$Id$;
our $CVSREV = (q$Revision$ =~ /^Revision: (.*) $/)[0];

my $error = {};

sub new {
    my ($class, $archive, %options) = @_;
    my $beclass;

    if (!$archive) {
        seterror("No archive to read");
        return undef;
    }
    if (!-r $archive) {
        seterror("No such file or directory");
        return undef;
    }
    my $o;
    
    foreach (keys %options) {
        $o->{$_} = $options{$_};
    }
    $o->{archive} = $archive;
    
    for ($archive) {
        /\.tar(\.[^\.]*)?$/ and do {
            $beclass = 'Tar';
            last;
        };
        /\.(gz|bz2|Z)$/ and do {
            $beclass = 'Compressed';
            last;
        };
        /\.zip$/ and do {
            $beclass = 'Zip';
            last;
        };
        /\.rar$/ and do {
            $beclass = 'Rar';
            last;
        };
        $beclass = 'FlatFile';
    }
    
    if ($beclass) {
        my $obj;
        # eval("require $class\:\:$beclass;");
        eval("\$obj = $class\:\:$beclass->new(\$o);");
        return $obj;
    } else {
        bless($o, $class);
    }
}

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

sub ls {
    my ($self) = @_;
    seterror("ls not implement in class " . ref($self));
    return;
}

sub extract {
    my ($self, $file, $dest) = @_;
    seterror("extract not implement in class " . ref($self));
    return;
}

### Global functions

sub error {
    return $error->{error};
}

sub seterror {
    my ($package, $filename, $line) = caller;
    $error = {
        'package' => $package,
        'filename' => $filename,
        'line' => $line,
        'error' => $_[1] || $_[0],
    };
}

### Private method

sub _tempdir {
    my ($self) = @_;
    $self->{tmpdir} || $ENV{TMPDIR}
}

1;

__END__

=head1 NAME

ObsData::Archive - Transparently extract files from arbitrary archives

=head1 SYNOPSIS

    use ObsData::Archive;
    my $file = "foo.tar.gz";
    my $oa = ObsData::Archive->new($file) or die ObsData::Archive->error;
    my @content = $oa->ls;
    foreach (@content) {
        $oa->extract($_, "./$_") or die ObsData::Archive->error;
    }

=head1 METHODS

=head2 new($file, %options)

Create a new archive object by reading $file.

Return undef on error and set error status.
See L<error>.

=head2 ls

list the content of the archive

=head2 extract

Extract a file from the archive and return the filename of extract file

=head1 CLASS METHODS

=head2 error

Return the last error encoutered

=head1 AUTHORS

Olivier Thauvin <olivier.thauvin@aerov.jussieu.fr>

=cut