use strict;
use warnings;
use Notes::OLE;
use AppConfig::Std ();
use File::Spec ();
use Memoize 'memoize';
use vars qw( $CONFIG $VERSION );
$VERSION = 0.01;
main( @ARGV );
exit 0;
sub main {
initialize( @_ );
my $db = $S->GetDatabase( $CONFIG->server, $CONFIG->filepath );
defined( $db ) and
$db->IsOpen or
die "Couldn't open '" . $CONFIG->server . "', '" . $CONFIG->file
+path . "'\n";
my $dc = $db->Search( $CONFIG->query,
$S->CreateDateTime( $CONFIG->since ),
0 );
dc_all( $dc, \ &extract_attachments );
glob File::Spec->catfile( $CONFIG->directory,
"*" );
1;
}
sub extract_attachments {
my $doc = shift;
my $dt = $doc->Created;
my $date = $dt->Date( 'yyyyMMdd' );
my $time = $dt->Time( 'HHmmss' );
my $timestamp = "$date$time";
for my $attachment_name ( @{$doc->{'$FILE'}} ) {
( my $group_name = $attachment_name )
=~ s/\.[^.]+$//;
my $dir = File::Spec->catdir( $CONFIG->directory,
$group_name );
recursive_mkdir( $dir );
my $filename = File::Spec->catfile( $dir,
"$timestamp-$attachment_name" );
if ( -e $filename ) {
warn "$timestamp version of $attachment_name already exists.\n";
}
else {
my $att = $doc->GetAttachment( $attachment_name );
$att->ExtractFile( $filename );
}
}
1;
}
sub initialize {
$| = 1;
$CONFIG = AppConfig::Std->new;
$CONFIG->define( server =>
{ DEFAULT => '',
ALIAS => "s" } );
$CONFIG->define( filepath =>
{ ALIAS => 'f' } );
$CONFIG->define( query =>
{ ALIAS => 'q|search|formula',
DEFAULT => '@ALL' } );
$CONFIG->define( since =>
{ DEFAULT => '' } );
$CONFIG->define( directory =>
{ DEFAULT => ".",
ALIAS => "d|dir" } );
$CONFIG->args( \ @_ );
$CONFIG->filepath
or die "-filepath is required.\n";
if ( not length $CONFIG->directory ) {
$CONFIG->directory( "." );
}
recursive_mkdir( $CONFIG->directory );
# Only produce results with attachments.
$CONFIG->query( '@Attachments( 1 )'
. ( length( $CONFIG->query )
? ( ' & (' . $CONFIG->query . ')' )
: '' ) );
1;
}
sub recursive_mkdir {
my $dir = shift;
my @dir_parts = File::Spec->splitdir( $dir );
for ( 1 .. @dir_parts )
{
my $cur_dir = File::Spec->catdir( @dir_parts[ map $_ - 1,
1 .. $_ ] );
if ( not -d $cur_dir ) {
mkdir $cur_dir
or die "Couldn't create $cur_dir: $!\n";
}
}
1;
}
BEGIN { memoize 'recursive_mkdir' };
__END__
=pod
=head1 NAME
ExtractAttachments - Extract attachments from selected documents in a
+Domino database
=head1 SYNOPSIS
ExtractAttachments -filepath MyDb -since Yesterday -dir C:\Templates -
+query "@Name([CN];Author) = @Name([CN];@Username)"
=head1 DESCRIPTION
This detaches attachments from documents.
=head1 OPTIONS
=over 4
=item -s SERVER
=item -f FILEPATH
=item -q FORMULA
=item -since DATETIME
=item -d DIRECTORY
=back
=cut
|