sdbm.pm #6

package VCP::DB_File::sdbm;

=head1 NAME

VCP::DB_File::sdbm - Subclass providing SDBM_File storage

=head1 SYNOPSIS

    use VCP::DB_File;
    VCP::DB_File->new;

=head1 DESCRIPTION

To write your own DB_File filetype, copy this file and alter it.  Then
ask us to add an option to the .vcp file parsing to enable it.

=for test_script t/01db_file_sdbm.t

=cut

$VERSION = 1 ;

use strict ;

use Carp;
use VCP::Debug qw( :debug );
use Fcntl;
use File::Spec;
use SDBM_File;
use VCP::Debug qw( :debug );

use base qw( VCP::DB_File );

use fields (
   'Hash',  ## The hash we tie
);

sub db_file {
   my VCP::DB_File::sdbm $self = shift;
   return File::Spec->catfile(
      $self->store_loc,
      "db"
   );
}


sub close_db {
   my VCP::DB_File::sdbm $self = shift;

   return unless $self->{Hash};

   $self->SUPER::close_db;

   $self->{Hash} = undef;
}


sub delete_db {
   my VCP::DB_File::sdbm $self = shift;

   return
      unless -e $self->store_loc && glob(
         $self->store_loc . "/*"
      );

   $self->SUPER::delete_db;
   $self->rmdir_store_loc;
}


sub open_db {
   my VCP::DB_File::sdbm $self = shift;

   $self->SUPER::open_db;
   $self->mkdir_store_loc;

   $self->{Hash} = {};

   my $fn = $self->db_file;

   tie %{$self->{Hash}}, "SDBM_File", $fn, O_RDWR|O_CREAT, 0660
      or die "vcp: $! while opening DB_File SDBM file '$fn'";
}


sub open_existing_db {
   my VCP::DB_File::sdbm $self = shift;

   $self->SUPER::open_db;
   $self->mkdir_store_loc;

   $self->{Hash} = {};

   my $fn = $self->db_file;

   tie %{$self->{Hash}}, "SDBM_File", $fn, O_RDWR, 0
      or die "vcp: $! while opening DB_File SDBM file '$fn'";
}


sub set {
   my VCP::DB_File::sdbm $self = shift;
   my $key_parts = shift;
   confess "missing or mal-formed key"
      unless ref $key_parts eq "ARRAY";

   my $key = $self->pack_values( @$key_parts );

   $self->{Hash}->{$key} = $self->pack_values( @_ );
}


sub get {
   my VCP::DB_File::sdbm $self = shift;
   my $key_parts = shift;
   confess "missing or mal-formed key"
      unless ref $key_parts eq "ARRAY";
   confess "extra args found"
      if @_;

   my $key = $self->pack_values( @$key_parts );

   my $v = $self->{Hash}->{$key};

   return unless defined $v;

   $self->unpack_values( $v );
}


sub exists {
   my VCP::DB_File::sdbm $self = shift;
   my $key_parts = shift;
   confess "missing or mal-formed key"
      unless ref $key_parts eq "ARRAY";

   my $key = $self->pack_values( @$key_parts );

   return $self->{Hash}->{$key} ? 1 : 0;
}


=head1 LIMITATIONS

There is no way (yet) of telling the mapper to continue processing the
rules list.  We could implement labels like C< <<I<label>>> > to be
allowed before pattern expressions (but not between pattern and result),
and we could then impelement C< <<goto I<label>>> >.  And a C< <<next>>
> could be used to fall through to the next label.  All of which is
wonderful, but I want to gain some real world experience with the
current system and find a use case for gotos and fallthroughs before I
implement them.  This comment is here to solicit feedback :).

=head1 AUTHOR

Barrie Slaymaker <barries@slaysys.com>

=head1 COPYRIGHT

Copyright (c) 2000, 2001, 2002 Perforce Software, Inc.
All rights reserved.

See L<VCP::License|VCP::License> (C<vcp help license>) for the terms of use.

=cut

1