# DB_File.pm -- Perl 5 interface to Berkeley DB
#
# written by Paul Marquess (Paul.Marquess@btinternet.com)
-# last modified 22nc Oct 2001
-# version 1.79
+# last modified 1st March 2002
+# version 1.804
#
-# Copyright (c) 1995-2001 Paul Marquess. All rights reserved.
+# Copyright (c) 1995-2002 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.
use warnings;
use strict;
-use vars qw($VERSION @ISA @EXPORT $AUTOLOAD $DB_BTREE $DB_HASH $DB_RECNO
- $db_version $use_XSLoader
- ) ;
+our ($VERSION, @ISA, @EXPORT, $AUTOLOAD, $DB_BTREE, $DB_HASH, $DB_RECNO);
+our ($db_version, $use_XSLoader, $splice_end_array);
use Carp;
-$VERSION = "1.79" ;
+$VERSION = "1.804" ;
+
+{
+ 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 ;
sub AUTOLOAD {
my($constname);
($constname = $AUTOLOAD) =~ s/.*:://;
- my $val = constant($constname, @_ ? $_[0] : 0);
- if ($! != 0) {
- if ($! =~ /Invalid/ || $!{EINVAL}) {
- $AutoLoader::AUTOLOAD = $AUTOLOAD;
- goto &AutoLoader::AUTOLOAD;
- }
- else {
- my($pack,$file,$line) = caller;
- croak "Your vendor has not defined DB macro $constname, used at $file line $line.
-";
- }
- }
+ my ($error, $val) = constant($constname);
+ Carp::croak $error if $error;
no strict 'refs';
*{$AUTOLOAD} = sub { $val };
goto &{$AUTOLOAD};
-}
+}
eval {
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 warnings ;
use strict ;
use DB_File ;
- use vars qw( %h $k $v ) ;
+ our (%h, $k, $v) ;
unlink "fruit" ;
tie %h, "DB_File", "fruit", O_RDWR|O_CREAT, 0666, $DB_HASH
use strict ;
use DB_File ;
- use vars qw($filename %h ) ;
+ my ($filename, %h) ;
$filename = "tree" ;
unlink $filename ;
use strict ;
use DB_File ;
- use vars qw($filename $x %h $status $key $value) ;
+ my ($filename, $x, %h, $status, $key, $value) ;
$filename = "tree" ;
unlink $filename ;
use strict ;
use DB_File ;
- use vars qw($filename $x %h ) ;
+ my ($filename, $x, %h) ;
$filename = "tree" ;
use strict ;
use DB_File ;
- use vars qw($filename $x %h $found) ;
+ my ($filename, $x, %h, $found) ;
- my $filename = "tree" ;
+ $filename = "tree" ;
# Enable duplicate records
$DB_BTREE->{'flags'} = R_DUP ;
use strict ;
use DB_File ;
- use vars qw($filename $x %h $found) ;
+ my ($filename, $x, %h, $found) ;
- my $filename = "tree" ;
+ $filename = "tree" ;
# Enable duplicate records
$DB_BTREE->{'flags'} = R_DUP ;
use DB_File ;
use Fcntl ;
- use vars qw($filename $x %h $st $key $value) ;
+ my ($filename, $x, %h, $st, $key, $value) ;
sub match
{
use warnings ;
use strict ;
- use vars qw(@h $H $file $i) ;
+ my (@h, $H, $file, $i) ;
use DB_File ;
use Fcntl ;
use DB_File ;
use Fcntl ;
- use vars qw( $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";
use warnings ;
use strict ;
use DB_File ;
- use vars qw(%x) ;
+ my %x ;
tie %x, DB_File, "filename" ;
Running it produces the error in question:
=head1 COPYRIGHT
-Copyright (c) 1995-2001 Paul Marquess. All rights reserved. This program
+Copyright (c) 1995-2002 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.