Archive::Any::Create - Abstract API to create archives (tar.gz and zip)


Archive-Any-Create documentation Contained in the Archive-Any-Create distribution.

Index


Code Index:

NAME

Top

Archive::Any::Create - Abstract API to create archives (tar.gz and zip)

SYNOPSIS

Top

  use Archive::Any::Create;

  my $archive = Archive::Any::Create->new;

  $archive->container('foo');               # top-level directory
  $archive->add_file('bar.txt', $data);     # foo/bar.txt
  $archive->add_file('bar/baz.txt', $data); # foo/bar/baz.txt

  $archive->write_file('foo.tar.gz');
  $archive->write_file('foo.zip');

  $archive->write_filehandle(\*STDOUT, 'tar.gz');

DESCRIPTION

Top

Archive::Any::Create is a wrapper module to create tar/tar.gz/zip files with a single easy-to-use API.

METHODS

Top

new

Create new Archive::Any::Create object. No parameters.

container($dir)

Specify a top-level directory (or folder) to contain multiple files. Not necessary but recommended to create a good-manner archive file.

add_file($file, $data)

Add a file that contains $data as its content. $file can be a file in the nested subdirectory.

write_file($filename)

Write an archive file named $filename. This method is DWIMmy, in the sense that it automatically dispatches archiving module based on its filename. So, $archive->write_file("foo.tar.gz") will create a tarball and $archive->write_file("foo.zip") will create a zip file with the same contents.

write_filehandle($fh, $format)

Write an archive data stream into filehandle. $format is either, tar, tar.gz or zip.

AUTHOR

Top

Tatsuhiko Miyagawa <miyagawa@bulknews.net>

This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself.

SEE ALSO

Top

Archive::Any, Archive::Tar, Archive::Zip


Archive-Any-Create documentation Contained in the Archive-Any-Create distribution.

package Archive::Any::Create;

use strict;
our $VERSION = '0.02';

use Exception::Class 'Archive::Any::Create::Error';
use UNIVERSAL::require;

our %Type2Class = (
    'tar' => [ 'Archive::Any::Create::Tar' ],
    'tar.gz' => [ 'Archive::Any::Create::Tar', { comp => 1 } ],
    'zip' => [ 'Archive::Any::Create::Zip' ],
);

my $re = '(' . join('|', map quotemeta, keys %Type2Class) . ')$';

sub new {
    my $class = shift;
    bless [ ], $class;
}

sub container {
    my $self = shift;
    push @$self, [ 'container', @_ ];
}

sub add_file {
    my $self = shift;
    push @$self, [ 'add_file', @_ ];
}

sub write_file {
    my $self = shift;
    $self->proxy_methods($_[0])->write_file(@_);
}

sub write_filehandle {
    my $self = shift;
    $self->proxy_methods($_[1])->write_filehandle(@_);
}

sub proxy_methods {
    my $self = shift;
    my($file) = @_;

    my @methods = @$self;

    $file =~ /$re/ or throw Archive::Any::Create::Error(error => "Can't detect archive type via filename $file");
    my($subclass, $opt) = @{ $Type2Class{$1} };
    $subclass->require or die $@;
    $self = bless { }, $subclass;
    $self->init($opt);

    for my $m (@methods) {
        my($method, @args) = @$m;
        $self->$method(@args);
    }

    $self;
}

1;
__END__