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->filepath . "'\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