view release on metacpan or  search on metacpan

lib/Acme/Archive/Mbox.pm  view on Meta::CPAN

package Acme::Archive::Mbox;

use warnings;
use strict;

use Acme::Archive::Mbox::File;
use File::Slurp;
use Mail::Box::Manager;

=head1 NAME

Acme::Archive::Mbox - Mbox as an archive format.

=head1 VERSION

Version 0.01

=cut

our $VERSION = '0.01';


=head1 SYNOPSIS

Uses Mbox as an archive format, like tar or zip but silly.  Creates an mbox
with one message per file or directory.  File contents are stored as an
attachment, metadata goes in mail headers.

    use Acme::Archive::Mbox;

    my $archive = Acme::Archive::Mbox->new();
    $archive->add_file('filename');
    $archive->add_data('file/name', $contents);
    $archive->write('foo.mbox');

    ...

    $archive->read('foo.mbox');
    $archive->extract();

=head1 FUNCTIONS

=head2 new ()

Create an Acme::Archive::Mbox object.

=cut

sub new {
    my $class = shift;
    my $self = { files => [] };
    return bless $self,$class;
}

=head2 add_data ($name, $contents, %attr)

Add a file given a filename and contents.  (File need not exist on disk)

=cut

sub add_data {
    my $self = shift;
    my $name = shift;
    my $contents = shift;
    my %attr = @_;

    my $file = Acme::Archive::Mbox::File->new($name, $contents, %attr);
    push @{$self->{files}}, $file if $file;

    return $file;
}

=head2 add_file ($name, [$archive_name])

Add a file given a filename.  File will be read from disk, leading
slashes will be stripped.  Will accept an optional alternative filename
to be used in the archive.

=cut

sub add_file {
    my $self = shift;
    my $name = shift;
    my $altname = shift || $name;
    my %attr;

    my $contents = read_file($name, err_mode => 'carp', binmode => ':raw');
    return unless $contents;

    my (undef, undef, $mode, undef, $uid, $gid, undef, undef, undef, $mtime) = stat $name;
    $attr{mode} = $mode & 0777;
    $attr{uid} = $uid;
    $attr{gid} = $gid;
    $attr{mtime} = $mtime;

    my $file = Acme::Archive::Mbox::File->new($altname, $contents, %attr);
    push @{$self->{files}}, $file if $file;

    return $file;
}

=head2 get_files ()

Returns a list of AAM::File objects.

=cut

sub get_files {
    my $self = shift;
    return @{$self->{files}};
}