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 "key must be an ARRAY reference" 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 "key must be an ARRAY reference" 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 "key must be an ARRAY reference" 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< <>> > to be allowed before pattern expressions (but not between pattern and result), and we could then impelement C< <>> >. And a C< <> > 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 =head1 COPYRIGHT Copyright (c) 2000, 2001, 2002 Perforce Software, Inc. All rights reserved. See L (C) for the terms of use. =cut 1