# DB_File.pm -- Perl 5 interface to Berkeley DB
#
# written by Paul Marquess (Paul.Marquess@btinternet.com)
-# last modified 6th Jan 2002
-# version 1.802
+# last modified 22nd October 2002
+# version 1.806
#
# Copyright (c) 1995-2002 Paul Marquess. All rights reserved.
# This program is free software; you can redistribute it and/or
{
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);
use Carp;
-$VERSION = "1.802" ;
+$VERSION = "1.806" ;
+
+{
+ 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] } ;
+ $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 work like recno in version 1.
if ($db_version > 1 and defined $arg[4] and $arg[4] =~ /RECNO/ and
$arg[1] and ! -e $arg[1]) {
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;
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 ;
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";