package Notes::OLE;
use strict;
use warnings;
use base 'Exporter';
use Win32::OLE;
use vars qw($S $DT @EXPORT @EXPORT_OK $VERSION %SEEN);

BEGIN {
    $VERSION = 0.01;
    $S = Win32::OLE->new('Notes.NotesSession')
    or die "Couldn't instantiate Notes.NotesSession";
    $DT = $S->CreateDateTime( '12/30/1899' );
    @EXPORT = qw($S $DT dc_all Dumper);
    @EXPORT_OK = qw(all_servers server_event_log server_databases
            move_dc server_log);
    *server_log = *server_event_log;
}

sub move_dc {
    my $dc = shift;
    my $tgt = shift;
    my $seen = shift;
    
    return unless $dc and $dc->Count;
    return
        dc_all( $dc, sub {
            my $doc = shift;
        return move_doc( $doc, $tgt, $seen );
        } );
}

sub move_doc { 
    my $doc = shift;
    my $tgt = shift;
    my $seen = shift || {};
    my $unid = $doc->UniversalID;
    return unless defined $unid;
    return if exists $seen->{$unid};
    $seen->{$unid} = undef;
    
    my $new = $doc->CopyToDatabase( $tgt );
    my $r = $doc->{Responses};
    if ( $r and $r->Count ) {
        for ( move_dc( $doc->{'Responses'}, $tgt, $seen ) ) {
            $_->MakeResponse( $new );
        $_->Save( 1, 0 );
        }
    }
    $doc->remove( 1 );
    return $new;
}

sub dc_all {
    my $dc = shift;
    my $cb = shift;

    my $doc = $dc->GetFirstDocument;
    my $next_doc;
    my @return;
    
    if ( wantarray ) {
    while ( $doc ) {
        $next_doc = $dc->GetNextDocument( $doc );
        push @return, $cb->( $doc );
        $doc = $next_doc;
    }
    return @return;
    } else {
    while ( $doc ) {
        $next_doc = $dc->GetNextDocument( $doc );
        $cb->( $doc );
        $doc = $next_doc;
    }
    return;
    }
    
    # NOT REACHED
}

sub all_servers {
  my $nab;
  
  for ( grep $_->Server, @{$S->AddressBooks} ) {
    $nab = $S->GetDatabase( $_->Server, $_->Filepath )
      and last;
  }
  
  if ( not( $nab and $nab->IsOpen ) ) {
    die "No server NAB could be opened - check your notes.ini";
  }
  
  my $servers = $nab->GetView('($Servers)');
  if ( not $servers ) {
    die "notes://@{[$nab->Server]}/@{[$nab->Filepath]} is missing a (\
+$Servers) view";
  }
  
  return dc_all( $servers,
         sub {
             return @{shift()->ServerName};
         } );
}

sub server_databases {
    my $server = shift;
    my $dbdir = $S->GetDbDirectory( $server );

    my @dbs;
    for ( my $db = $dbdir->GetFirstDatabase( 1246 );
      $db;
      $db = $dbdir->GetNextDatabase ) {
    push @dbs, { server => $server,
             title  => $db->Title,
             filepath => $db->Filepath,
             template => $db->TemplateName,
             inherits => $db->DesignTemplateName };
    }
    return @dbs;
}

sub server_event_log {
    my $server = shift;
    my $log = $S->GetDatabase( $server, 'log' )
    or do {
        warn "Couldn't open notes://$server/log";
        return;
    };
    
    my $events = $log->Search( q[FORM = "Events"], $DT, 0 );
    if ( not $events ) {
    warn "Couldn't search notes://$server/log";
    return;
    }

    my @events =
    dc_all( $events, sub {
        my $doc = shift;
            return ( @{ $doc->EventList },
             @{ $doc->EventLog },
                     @{ $doc->Events } );
    } );

    return @events;
}

1;

__END__

=head1 NAME

Notes::OLE - Lotus Domino via Win32::OLE

=head1 SYNOPSIS

 use Notes::OLE qw(all_servers server_event_log);
 $\ = "\n";
 print
     for
     map {
         my $l = $_;
         map "$l->{'name'}: $_",
             @{$l->{'log'}};
     }
     grep @{$_->{'log'}},
     map +{ 'name' => $S->CreateName( $_ )->Abbreviated,
            'log'  => [ server_event_log( $_ ) ],
     },
     all_servers();

=head1 DESCRIPTION

This module makes writing perl for Lotus Domino easy by precreating yo
+ur
session object and providing some utility functions for enumerating av
+ailable
servers and traversing document collections.

=head1 OBJECTS

=over 4

=item $S

This is the global session object. It is exported by default.

=item $DT

This is a NotesDateTime object set to 12/31/1899. This is intended for
+ use
in NotesDatabase.Search( ... ) calls as a "default" limit.

=back

=head1 FUNCTIONS

=over 4

=item dc_all( $DocumentCollection, sub { ... } )

This function traverses NotesView and NotesDocumentCollection document
+s by
calling the .GetFirstDocument / GetNextDocument methods in a loop. The
second argument is a function callback. It is called with each documen
+t as
the sole parameter.

In list context the return results of the callback function is accumul
+ated
and returned by dc_all().

=item all_servers()

This function takes no arguments and it queries the server for a list 
+of other
servers.

=item server_log( "Foobar/Domain" )

This function takes a server name as a single argument. It returns the
+ contents
of the server's log.nsf database. The R5 and R6 log design was account
+ed for
and this function returns both seamlessly.

=item server_databases( "Foobar/Domain" )

This returns an array of hashes, one hash per database on the server. 
+Each
hash has some of the databases' data copied into it.

  server
  title
  filepath
  template
  inherits

=item move_dc

=item move_doc

=back

=head1 AUTHOR

Joshua b. Jore E<lt>jjore@cpan.orgE<gt>

=cut
[download]