Acme-Archive-Mbox

 view release on metacpan or  search on metacpan

bin/mboxify  view on Meta::CPAN

use warnings;

use Acme::Archive::Mbox;
use File::Find;
use File::Spec;

print "$0 archive.mbox dir/\n" and exit unless @ARGV >= 2;
my $archivename = shift @ARGV;
my @dirs = @ARGV;
my @files;
my $wanted = sub { push @files, $File::Find::name if -f; };

find($wanted, @dirs);

my $archive = Acme::Archive::Mbox->new();
for my $file (@files) {
    my $name = File::Spec->canonpath($file);
    if (File::Spec->file_name_is_absolute($name)) {
        my $root = File::Spec->rootdir();
        warn "Stripping leading $root";
        $name =~ s/^$root//;

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

    $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;

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

    return $file;
}

=head2 get_files ()

Returns a list of AAM::File objects.

=cut

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

=head2 write (filename)

Write archive to a file

=cut

sub write {
    my $self = shift;
    my $mboxname = shift;
    
    my $mgr = Mail::Box::Manager->new;
    my $folder = $mgr->open($mboxname, type => 'mbox', create => 1, access => 'rw') or die "Could not create $mboxname";

    for my $file (@{$self->{files}}) {
        my $attach = Mail::Message::Body->new(  mime_type => 'application/octet-stream',
                                                data => $file->contents,
                                             );

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

    $folder->write();
    $mgr->close($folder);
}

=head2 read (filename)

Read archive from a file.

=cut

sub read {
    my $self = shift;
    my $mboxname = shift;

    my $mgr = Mail::Box::Manager->new;
    my $folder = $mgr->open($mboxname, type => 'mbox') or die "Could not open $mboxname";
    my @messages = $folder->messages;
    for my $message (@messages) {
        my %attr;
        my $name = $message->get('Subject');
        for (qw/uid gid mode mtime/) {

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

    my $file = Acme::Archive::Mbox->new(name => 'file/name', contents => $contents, ...);

=head1 FUNCTIONS

=head2 new

Create an Acme::Archive::Mbox::File object.

=cut

sub new {
    my $class = shift;
    my $name = shift;
    my $contents = shift;
    my %attr = @_;

    my $self = { name => $name, contents => $contents, %attr };
    return unless ($self->{name} and $self->{contents});
    return bless $self, $class;
}

=head2 name

Returns the name of the file.

=cut

sub name {
    my $self = shift;
    return $self->{name};
}

=head2 contents

Returns the contents of the file.

=cut

sub contents {
    my $self = shift;
    return $self->{contents};
}

=head2 mode

Returns the mode of the file.

=cut

sub mode {
    my $self = shift;
    return $self->{mode};
}

=head2 uid

Returns the owner's uid.

=cut

sub uid {
    my $self = shift;
    return $self->{uid};
}

=head2 gid

Returns the gid of the group which owns the file.

=cut

sub gid {
    my $self = shift;
    return $self->{gid};
}

=head2 mtime

Returns the mtime of the file as a unix timestamp.

=cut

sub mtime {
    my $self = shift;
    return $self->{mtime};
}

=head1 AUTHOR

Ian Kilgore, C<< <iank at cpan.org> >>

=head1 BUGS