sourcecode
diotalevi
<code>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 your
session object and providing some utility functions for enumerating available
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 documents by
calling the .GetFirstDocument / GetNextDocument methods in a loop. The
second argument is a function callback. It is called with each document as
the sole parameter.
In list context the return results of the callback function is accumulated
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 accounted 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</code>
This module makes writing perl for Lotus Domino easy by precreating your session object and providing some utility functions for enumerating available servers and traversing document collections.
Miscellaneous