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
[download]

---

---

Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!

Titles consisting of a single word are discouraged, and in most cases are disallowed outright.

Read Where should I post X? if you're not absolutely sure you're posting in the right place.

Please read these before you post! —

• How do I compose an effective node title?
• How do I post a question effectively?
• Markup in the Monastery

Posts may use any of the Perl Monks Approved HTML tags:

a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr

You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)

	For:		Use:
	&		&
	<		&lt;
	>		&gt;
	[		&#91;
	]		&#93;

Link using PerlMonks shortcuts! What shortcuts can I use for linking?

See Writeup Formatting Tips and other pages linked from there for more info.