Acme-Archive-Mbox

 view release on metacpan or  search on metacpan

bin/mboxextract  view on Meta::CPAN

    push @parts, $filename;
    die "Directory traversal attempted: $name\n" unless (File::Spec->no_upwards(@parts) == @parts);
  
    mkpath(File::Spec->catdir($rootdir, $dirs)); 
    my $writename = File::Spec->catfile($rootdir, $dirs, $filename);
    
    write_file($writename, {binmode => ':raw'}, $file->contents );

    chmod $file->mode, $writename or warn "$0: chmod $writename: $!\n";
    if ($> == 0) {
        chown $file->uid, $file->gid, $writename or warn "$0: chown $writename: $!\n";
    }
}

=head1 NAME

mboxextract - extract mbox archive

=head1 USAGE

mboxify archive.mbox root_directory

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

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 ()

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

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

        my $message = Mail::Message->build( From          => '"Acme::Archive::Mbox" <AAM@example.com>',
                                            To            => '"Anyone, really" <anyone@example.com>',
                                            Subject       => $file->name,
                                            'X-AAM-uid'   => $file->uid,
                                            'X-AAM-gid'   => $file->gid,
                                            'X-AAM-mode'  => $file->mode,
                                            'X-AAM-mtime' => $file->mtime,

                                            data => 'attached',
                                            attach => $attach, );
        $folder->addMessage($message);
    }
    $folder->write();
    $mgr->close($folder);
}

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

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/) {
            $attr{$_} = $message->get("X-AAM-$_");
        }
        my $contents = ($message->parts())[1]->decoded();

        $self->add_data($name, $contents, %attr);
    }
    $mgr->close($folder);
}

=head1 AUTHOR

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

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;

t/file.t  view on Meta::CPAN

use Test::More tests => 8;
use strict;

use Acme::Archive::Mbox::File;

my $time = time();
my $name = '/a/b//c';
my $contents = 'a'x20;
my %attr = ( mode => 0644,
             uid  => 1000,
             gid  => 1001,
             mtime => $time,
           );

# No contents, this should fail.
my $file = Acme::Archive::Mbox::File->new( $name );
is($file, undef, "fail to create object without required args");

$file = Acme::Archive::Mbox::File->new( $name, $contents, %attr );

isa_ok($file, 'Acme::Archive::Mbox::File', "Object created");
is($file->name, $name, "name $name");
is($file->contents, $contents, "contents");
is($file->mode, 0644, "mode");
is($file->uid, 1000, "uid");
is($file->gid, 1001, "gid");
is($file->mtime, $time, "mtime");