# DB_File.pm -- Perl 5 interface to Berkeley DB
#
# written by Paul Marquess (Paul.Marquess@btinternet.com)
-# last modified 17th December 2000
-# version 1.75
+# last modified 26th April 2001
+# version 1.77
#
-# Copyright (c) 1995-2000 Paul Marquess. All rights reserved.
+# Copyright (c) 1995-2001 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 Carp;
-$VERSION = "1.75" ;
+$VERSION = "1.77" ;
#typedef enum { DB_BTREE, DB_HASH, DB_RECNO } DBTYPE;
$DB_BTREE = new DB_File::BTREEINFO ;
}
}
+
+sub SPLICE
+{
+ my $self = shift;
+ my $offset = shift;
+ if (not defined $offset) {
+ carp 'Use of uninitialized value in splice';
+ $offset = 0;
+ }
+
+ my $length = @_ ? shift : 0;
+ # Carping about definedness comes _after_ the OFFSET sanity check.
+ # This is so we get the same error messages as Perl's splice().
+ #
+
+ my @list = @_;
+
+ my $size = $self->FETCHSIZE();
+
+ # 'If OFFSET is negative then it start that far from the end of
+ # the array.'
+ #
+ if ($offset < 0) {
+ my $new_offset = $size + $offset;
+ if ($new_offset < 0) {
+ die "Modification of non-creatable array value attempted, "
+ . "subscript $offset";
+ }
+ $offset = $new_offset;
+ }
+
+ if ($offset > $size) {
+ $offset = $size;
+ }
+
+ if (not defined $length) {
+ carp 'Use of uninitialized value in splice';
+ $length = 0;
+ }
+
+ # 'If LENGTH is omitted, removes everything from OFFSET onward.'
+ if (not defined $length) {
+ $length = $size - $offset;
+ }
+
+ # 'If LENGTH is negative, leave that many elements off the end of
+ # the array.'
+ #
+ if ($length < 0) {
+ $length = $size - $offset + $length;
+
+ if ($length < 0) {
+ # The user must have specified a length bigger than the
+ # length of the array passed in. But perl's splice()
+ # doesn't catch this, it just behaves as for length=0.
+ #
+ $length = 0;
+ }
+ }
+
+ if ($length > $size - $offset) {
+ $length = $size - $offset;
+ }
+
+ # $num_elems holds the current number of elements in the database.
+ my $num_elems = $size;
+
+ # 'Removes the elements designated by OFFSET and LENGTH from an
+ # array,'...
+ #
+ my @removed = ();
+ foreach (0 .. $length - 1) {
+ my $old;
+ my $status = $self->get($offset, $old);
+ if ($status != 0) {
+ my $msg = "error from Berkeley DB on get($offset, \$old)";
+ if ($status == 1) {
+ $msg .= ' (no such element?)';
+ }
+ else {
+ $msg .= ": error status $status";
+ if (defined $! and $! ne '') {
+ $msg .= ", message $!";
+ }
+ }
+ die $msg;
+ }
+ push @removed, $old;
+
+ $status = $self->del($offset);
+ if ($status != 0) {
+ my $msg = "error from Berkeley DB on del($offset)";
+ if ($status == 1) {
+ $msg .= ' (no such element?)';
+ }
+ else {
+ $msg .= ": error status $status";
+ if (defined $! and $! ne '') {
+ $msg .= ", message $!";
+ }
+ }
+ die $msg;
+ }
+
+ -- $num_elems;
+ }
+
+ # ...'and replaces them with the elements of LIST, if any.'
+ my $pos = $offset;
+ while (defined (my $elem = shift @list)) {
+ my $old_pos = $pos;
+ my $status;
+ if ($pos >= $num_elems) {
+ $status = $self->put($pos, $elem);
+ }
+ else {
+ $status = $self->put($pos, $elem, $self->R_IBEFORE);
+ }
+
+ if ($status != 0) {
+ my $msg = "error from Berkeley DB on put($pos, $elem, ...)";
+ if ($status == 1) {
+ $msg .= ' (no such element?)';
+ }
+ else {
+ $msg .= ", error status $status";
+ if (defined $! and $! ne '') {
+ $msg .= ", message $!";
+ }
+ }
+ die $msg;
+ }
+
+ die "pos unexpectedly changed from $old_pos to $pos with R_IBEFORE"
+ if $old_pos != $pos;
+
+ ++ $pos;
+ ++ $num_elems;
+ }
+
+ if (wantarray) {
+ # 'In list context, returns the elements removed from the
+ # array.'
+ #
+ return @removed;
+ }
+ elsif (defined wantarray and not wantarray) {
+ # 'In scalar context, returns the last element removed, or
+ # undef if no elements are removed.'
+ #
+ if (@removed) {
+ my $last = pop @removed;
+ return "$last";
+ }
+ else {
+ return undef;
+ }
+ }
+ elsif (not defined wantarray) {
+ # Void context
+ }
+ else { die }
+}
+sub ::DB_File::splice { &SPLICE }
+
sub find_dup
{
croak "Usage: \$db->find_dup(key,value)\n"
$X->push(list);
$a = $X->shift;
$X->unshift(list);
+ @r = $X->splice(offset, length, elements);
# DBM Filters
$old_filter = $db->filter_store_key ( sub { ... } ) ;
=head2 Using DB_File with Berkeley DB version 2 or 3
Although B<DB_File> is intended to be used with Berkeley DB version 1,
-it can also be used with version 2.or 3 In this case the interface is
+it can also be used with version 2 or 3. In this case the interface is
limited to the functionality provided by Berkeley DB 1.x. Anywhere the
version 2 or 3 interface differs, B<DB_File> arranges for it to work
like version 1. This feature allows B<DB_File> scripts that were built
B<Note:> The database file format has changed in both Berkeley DB
version 2 and 3. If you cannot recreate your databases, you must dump
-any existing databases with the C<db_dump185> utility that comes with
-Berkeley DB.
+any existing databases with either the C<db_dump> or the C<db_dump185>
+utility that comes with Berkeley DB.
Once you have rebuilt DB_File to use Berkeley DB version 2 or 3, your
databases can be recreated using C<db_load>. Refer to the Berkeley DB
documentation for further details.
still have bval default to C<"\n"> for variable length records, and
space for fixed length records.
+Also note that the bval option only allows you to specify a single byte
+as a delimeter.
+
=head2 A Simple Example
Here is a simple example that uses RECNO (if you are using a version
Returns the number of elements in the array.
+=item B<$X-E<gt>splice(offset, length, elements);>
+
+Returns a splice of the the array.
+
=back
=head2 Another Example
=head1 COPYRIGHT
-Copyright (c) 1995-1999 Paul Marquess. All rights reserved. This program
+Copyright (c) 1995-2001 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.
DB_File.xs -- Perl 5 interface to Berkeley DB
written by Paul Marquess <Paul.Marquess@btinternet.com>
- last modified 17 December 2000
- version 1.75
+ last modified 26th April 2001
+ version 1.77
All comments/suggestions/problems are welcome
- Copyright (c) 1995-2000 Paul Marquess. All rights reserved.
+ Copyright (c) 1995-2001 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.
Added suppport to allow DB_File to be built with
Berkeley DB 3.2 -- btree_compare, btree_prefix and hash_cb
needed to be changed.
+ 1.76 - No change to DB_File.xs
+ 1.77 - Tidied up a few types used in calling newSVpvn.
*/
dTHX;
#endif
dSP ;
- void * data1, * data2 ;
+ char * data1, * data2 ;
int retval ;
int count ;
- data1 = key1->data ;
- data2 = key2->data ;
+ data1 = (char *) key1->data ;
+ data2 = (char *) key2->data ;
#ifndef newSVpvn
/* As newSVpv will assume that the data pointer is a null terminated C
dTHX;
#endif
dSP ;
- void * data1, * data2 ;
+ char * data1, * data2 ;
int retval ;
int count ;
- data1 = key1->data ;
- data2 = key2->data ;
+ data1 = (char *) key1->data ;
+ data2 = (char *) key2->data ;
#ifndef newSVpvn
/* As newSVpv will assume that the data pointer is a null terminated C
projects / p5sagit/p5-mst-13.2.git / commitdiff