# DB_File.pm -- Perl 5 interface to Berkeley DB
#
-# written by Paul Marquess (Paul.Marquess@btinternet.com)
-# last modified 23rd Nov 2001
-# version 1.800
+# written by Paul Marquess (pmqs@cpan.org)
+# last modified 11th November 2005
+# version 1.814
#
-# Copyright (c) 1995-2001 Paul Marquess. All rights reserved.
+# Copyright (c) 1995-2005 Paul Marquess. All rights reserved.
# This program is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.
{
my $pkg = shift ;
- bless { VALID => { map {$_, 1}
- qw( bsize ffactor nelem cachesize hash lorder)
+ bless { VALID => {
+ bsize => 1,
+ ffactor => 1,
+ nelem => 1,
+ cachesize => 1,
+ hash => 2,
+ lorder => 1,
},
GOT => {}
}, $pkg ;
my $key = shift ;
my $value = shift ;
- if ( exists $self->{VALID}{$key} )
+ my $type = $self->{VALID}{$key};
+
+ if ( $type )
{
+ croak "Key '$key' not associated with a code reference"
+ if $type == 2 && !ref $value && ref $value ne 'CODE';
$self->{GOT}{$key} = $value ;
return ;
}
{
my $pkg = shift ;
- bless { VALID => { map {$_, 1}
- qw( flags cachesize maxkeypage minkeypage psize
- compare prefix lorder )
+ bless { VALID => {
+ flags => 1,
+ cachesize => 1,
+ maxkeypage => 1,
+ minkeypage => 1,
+ psize => 1,
+ compare => 2,
+ prefix => 2,
+ lorder => 1,
},
GOT => {},
}, $pkg ;
use warnings;
use strict;
our ($VERSION, @ISA, @EXPORT, $AUTOLOAD, $DB_BTREE, $DB_HASH, $DB_RECNO);
-our ($db_version, $use_XSLoader);
+our ($db_version, $use_XSLoader, $splice_end_array, $Error);
use Carp;
-$VERSION = "1.800" ;
+$VERSION = "1.814" ;
+
+{
+ local $SIG{__WARN__} = sub {$splice_end_array = "@_";};
+ my @a =(1); splice(@a, 3);
+ $splice_end_array =
+ ($splice_end_array =~ /^splice\(\) offset past end of array at /);
+}
#typedef enum { DB_BTREE, DB_HASH, DB_RECNO } DBTYPE;
$DB_BTREE = new DB_File::BTREEINFO ;
$arg[4] = tied %{ $arg[4] }
if @arg >= 5 && ref $arg[4] && $arg[4] =~ /=HASH/ && tied %{ $arg[4] } ;
- # make recno in Berkeley DB version 2 work like recno in version 1.
+ $arg[2] = O_CREAT()|O_RDWR() if @arg >=3 && ! defined $arg[2];
+ $arg[3] = 0666 if @arg >=4 && ! defined $arg[3];
+
+ # make recno in Berkeley DB version 2 (or better) work like
+ # recno in version 1.
+ if ($db_version >= 4 and ! $tieHASH) {
+ $arg[2] |= O_CREAT();
+ }
+
if ($db_version > 1 and defined $arg[4] and $arg[4] =~ /RECNO/ and
$arg[1] and ! -e $arg[1]) {
open(FH, ">$arg[1]") or return undef ;
my $self = shift;
my $offset = shift;
if (not defined $offset) {
- carp 'Use of uninitialized value in splice';
+ warnings::warnif('uninitialized', 'Use of uninitialized value in splice');
$offset = 0;
}
$offset = $new_offset;
}
- if ($offset > $size) {
- $offset = $size;
- }
-
if (not defined $length) {
- carp 'Use of uninitialized value in splice';
+ warnings::warnif('uninitialized', 'Use of uninitialized value in splice');
$length = 0;
}
+ if ($offset > $size) {
+ $offset = $size;
+ warnings::warnif('misc', 'splice() offset past end of array')
+ if $splice_end_array;
+ }
+
# 'If LENGTH is omitted, removes everything from OFFSET onward.'
if (not defined $length) {
$length = $size - $offset;
In the case-insensitive example above, the keys: 'KEY' and 'key'
would be considered duplicates, and assigning to the second one
would overwrite the first. If duplicates are allowed for (with the
-R_DUPS flag discussed below), only a single copy of duplicate keys
+R_DUP flag discussed below), only a single copy of duplicate keys
is stored in the database --- so (again with example above) assigning
three values to the keys: 'KEY', 'Key', and 'key' would leave just
the first key: 'KEY' in the database with three values. For some
use strict ;
use DB_File ;
- our ($filename, %h) ;
+ my ($filename, %h) ;
$filename = "tree" ;
unlink $filename ;
use strict ;
use DB_File ;
- our ($filename, $x, %h, $status, $key, $value) ;
+ my ($filename, $x, %h, $status, $key, $value) ;
$filename = "tree" ;
unlink $filename ;
use strict ;
use DB_File ;
- our ($filename, $x, %h) ;
+ my ($filename, $x, %h) ;
$filename = "tree" ;
use strict ;
use DB_File ;
- our ($filename, $x, %h, $found) ;
+ my ($filename, $x, %h, $found) ;
$filename = "tree" ;
use strict ;
use DB_File ;
- our ($filename, $x, %h, $found) ;
+ my ($filename, $x, %h, $found) ;
$filename = "tree" ;
use DB_File ;
use Fcntl ;
- our ($filename, $x, %h, $st, $key, $value) ;
+ my ($filename, $x, %h, $st, $key, $value) ;
sub match
{
space for fixed length records.
Also note that the bval option only allows you to specify a single byte
-as a delimeter.
+as a delimiter.
=head2 A Simple Example
=item B<$X-E<gt>splice(offset, length, elements);>
-Returns a splice of the the array.
+Returns a splice of the array.
=back
use warnings ;
use strict ;
- our (@h, $H, $file, $i) ;
+ my (@h, $H, $file, $i) ;
use DB_File ;
use Fcntl ;
use DB_File ;
my %hash ;
- my $filename = "/tmp/filt" ;
+ my $filename = "filt" ;
unlink $filename ;
my $db = tie %hash, 'DB_File', $filename, O_CREAT|O_RDWR, 0666, $DB_HASH
a DBM database it always writes the key and value as strings. So when
you use this:
- $hash{12345} = "soemthing" ;
+ $hash{12345} = "something" ;
the key 12345 will get stored in the DBM database as the 5 byte string
"12345". If you actually want the key to be stored in the DBM database
use strict ;
use DB_File ;
my %hash ;
- my $filename = "/tmp/filt" ;
+ my $filename = "filt" ;
unlink $filename ;
The locking technique went like this.
- $db = tie(%db, 'DB_File', '/tmp/foo.db', O_CREAT|O_RDWR, 0666)
- || die "dbcreat /tmp/foo.db $!";
+ $db = tie(%db, 'DB_File', 'foo.db', O_CREAT|O_RDWR, 0644)
+ || die "dbcreat foo.db $!";
$fd = $db->fd;
open(DB_FH, "+<&=$fd") || die "dup $!";
flock (DB_FH, LOCK_EX) || die "flock: $!";
use DB_File ;
use Fcntl ;
- our ($dotdir, $HISTORY, %hist_db, $href, $binary_time, $date) ;
+ my ($dotdir, $HISTORY, %hist_db, $href, $binary_time, $date) ;
$dotdir = $ENV{HOME} || $ENV{LOGNAME};
$HISTORY = "$dotdir/.netscape/history.db";
the directory F<ext/DB_File>. Given the amount of time between releases
of Perl the version that ships with Perl is quite likely to be out of
date, so the most recent version can always be found on CPAN (see
-L<perlmod/CPAN> for details), in the directory
+L<perlmodlib/CPAN> for details), in the directory
F<modules/by-module/DB_File>.
This version of B<DB_File> will work with either version 1.x, 2.x or
=head1 COPYRIGHT
-Copyright (c) 1995-2001 Paul Marquess. All rights reserved. This program
+Copyright (c) 1995-2005 Paul Marquess. All rights reserved. This program
is free software; you can redistribute it and/or modify it under the
same terms as Perl itself.
=head1 SEE ALSO
-L<perl(1)>, L<dbopen(3)>, L<hash(3)>, L<recno(3)>, L<btree(3)>,
-L<dbmfilter>
+L<perl>, L<dbopen(3)>, L<hash(3)>, L<recno(3)>, L<btree(3)>,
+L<perldbmfilter>
=head1 AUTHOR
The DB_File interface was written by Paul Marquess
-E<lt>Paul.Marquess@btinternet.comE<gt>.
+E<lt>pmqs@cpan.orgE<gt>.
Questions about the DB system itself may be addressed to
-E<lt>db@sleepycat.com<gt>.
+E<lt>db@sleepycat.comE<gt>.
=cut
projects / p5sagit/p5-mst-13.2.git / blobdiff