#!/usr/bin/perl -w
# -*- Mode: perl -*-
#======================================================================
#
# This package is free software and is provided "as is" without
# express or implied warranty. It may be used, redistributed and/or
# modified under the same terms as perl itself. ( Either the Artistic
# License or the GPL. )
#
# $Id: Collection.pm,v 1.4 2001/09/04 19:46:41 srl Exp $
#
# (C) COPYRIGHT 2001, Shane Landrum <srl@cpan.org>
#
# See the AUTHORS file included in the distribution for a full list.
#======================================================================
$VERSION = "0.02";
package Verity::Collection;
use Carp;
my $MKVDK = 'mkvdk';
=head1 NAME
Verity::Collection - interface to a local Verity collection.
=head1 SYNOPSIS
use Verity::Collection;
my $v = Verity::Collection->new(collection => '/foo/bar/baz',
binaries => '/verity/bin');
=head1 DESCRIPTION
This module assumes that you have a local Verity collection;
it's intended to interface to Verity through the local Unix
system using mkvdk and rcvdk. At some point in the future
it may use XS under the hood to speak to the Verity developers'
toolkit, but not for now.
=head1 METHODS
=head2 new(collection => $dir, binaries => $dir, verbose => [0|1], warn_on_error => [0|1])
This method makes a new Verity::Collection object in the collection
dir using the binaries dir to find Verity tools.
If "verbose" is turned on you'll see the command lines used to talk
to Verity. If "warn_on_error" is on you'll get warnings when you do
something that won't work.
=begin testing
BEGIN { use_ok( 'Verity::Collection' ); }
# all other tests are in their own files. --srl
=end testing
=cut
sub new {
my ($class, %args) = @_;
my $self = {};
bless $self, $class;
unless (defined($args{binaries})) {
$args{binaries} = '';
$self->_whine("Verity binaries directory not defined");
}
unless (defined($args{collection})) {
$args{collection} = '';
$self->_whine ("Verity collection directory not defined");
}
$self->_whine("No verity binary dir given") unless $args{binaries};
$self->_whine("No verity collection dir given") unless $args{collection};
return undef unless ($args{collection} and $args{binaries});
$self->{mkvdk} = $args{binaries} . "/$MKVDK";
$self->{collection} = $args{collection};
$self->{verbose} = $args{verbose} || 0;
$self->{warn_on_error} = $args{warn_on_error} || 0;
unless (-e ($self->{mkvdk})) {
$self->_whine("Couldn't find $MKVDK at " . $self->{mkvdk});
return undef;
}
unless (-d ($self->{collection}) ) {
mkdir $self->{collection} ||
croak "couldn't make collection dir " . $self->{collection};
}
return $self;
}
=head2 create
This method makes a new collection on the filesystem.
=cut
sub create {
my ($self, $args) = @_;
my $commandline = $self->{mkvdk} .
" -collection " . $self->{collection} .
" -create ";
return $self->_system($commandline);
}
=head2 insert (%args)
This method adds new data to the collection. Options are:
=over 4
=item * mode - defaults to '', specify 'bulk' if this is a bulk file
=item * file - full path of the file to insert into the collection
=back
=cut
sub insert {
my ($self, %args) = @_;
my $bulkmode = '';
if (defined($args{mode})) {
$bulkmode = "-bulk" if ($args{mode} eq 'bulk');
}
unless (defined($args{file})) {
$args{file} = '';
carp "Filename to insert not defined";
}
carp "No filename to insert given" unless $args{file};
carp "File " . $args{file} . " doesn't exist" unless (-e $args{file});
my $commandline = $self->{mkvdk} .
" -collection " . $self->{collection} .
" $bulkmode" .
" -insert " . $args{file};
return $self->_system($commandline);
}
=head2 purge
This method purges all data from the collection. It does *not*
delete the collection. See delete() for that.
=cut
sub purge {
my ($self, %args) = @_;
my $commandline = $self->{mkvdk} .
" -collection " . $self->{collection} .
" -delete ";
return $self->_system($commandline);
}
=head2 delete
This method deletes the collection itself on disk.
=cut
sub delete {
my ($self, %args) = @_;
my $commandline = "rm -rf " . $self->{collection};
return $self->_system($commandline);
}
=head2 reindex
This method updates the indexes in the collection.
=cut
sub reindex {
my ($self) = @_;
return undef;
}
=head1 TODO
Write some code. Write some tests.
=cut
sub _whine {
my ($self, $msg) = @_;
warn "$msg\n" if $self->{warn_on_error};
}
sub _system {
my ($self, $command) = @_;
my $result = system($command);
warn "System command: '$command'\n" if $self->{verbose};
return 1 if ($result == 0);
return undef if ($result != 0);
}
1;