dslinux/user/perl/ext/SDBM_File Makefile.PL SDBM_File.pm SDBM_File.xs typemap
cayenne
dslinux_cayenne at user.in-berlin.de
Mon Dec 4 17:59:40 CET 2006
Update of /cvsroot/dslinux/dslinux/user/perl/ext/SDBM_File
In directory antilope:/tmp/cvs-serv17422/ext/SDBM_File
Added Files:
Makefile.PL SDBM_File.pm SDBM_File.xs typemap
Log Message:
Adding fresh perl source to HEAD to branch from
--- NEW FILE: SDBM_File.pm ---
package SDBM_File;
use strict;
use warnings;
require Tie::Hash;
use XSLoader ();
our @ISA = qw(Tie::Hash);
our $VERSION = "1.05";
XSLoader::load 'SDBM_File', $VERSION;
1;
__END__
=head1 NAME
SDBM_File - Tied access to sdbm files
=head1 SYNOPSIS
use Fcntl; # For O_RDWR, O_CREAT, etc.
use SDBM_File;
tie(%h, 'SDBM_File', 'filename', O_RDWR|O_CREAT, 0666)
or die "Couldn't tie SDBM file 'filename': $!; aborting";
# Now read and change the hash
$h{newkey} = newvalue;
print $h{oldkey};
...
untie %h;
=head1 DESCRIPTION
C<SDBM_File> establishes a connection between a Perl hash variable and
a file in SDBM_File format;. You can manipulate the data in the file
just as if it were in a Perl hash, but when your program exits, the
data will remain in the file, to be used the next time your program
runs.
Use C<SDBM_File> with the Perl built-in C<tie> function to establish
the connection between the variable and the file. The arguments to
C<tie> should be:
=over 4
=item 1.
The hash variable you want to tie.
=item 2.
The string C<"SDBM_File">. (Ths tells Perl to use the C<SDBM_File>
package to perform the functions of the hash.)
=item 3.
The name of the file you want to tie to the hash.
=item 4.
Flags. Use one of:
=over 2
=item C<O_RDONLY>
Read-only access to the data in the file.
=item C<O_WRONLY>
Write-only access to the data in the file.
=item C<O_RDWR>
Both read and write access.
=back
If you want to create the file if it does not exist, add C<O_CREAT> to
any of these, as in the example. If you omit C<O_CREAT> and the file
does not already exist, the C<tie> call will fail.
=item 5.
The default permissions to use if a new file is created. The actual
permissions will be modified by the user's umask, so you should
probably use 0666 here. (See L<perlfunc/umask>.)
=back
=head1 DIAGNOSTICS
On failure, the C<tie> call returns an undefined value and probably
sets C<$!> to contain the reason the file could not be tied.
=head2 C<sdbm store returned -1, errno 22, key "..." at ...>
This warning is emitted when you try to store a key or a value that
is too long. It means that the change was not recorded in the
database. See BUGS AND WARNINGS below.
=head1 BUGS AND WARNINGS
There are a number of limits on the size of the data that you can
store in the SDBM file. The most important is that the length of a
key, plus the length of its associated value, may not exceed 1008
bytes.
See L<perlfunc/tie>, L<perldbmfilter>, L<Fcntl>
=cut
--- NEW FILE: SDBM_File.xs ---
#define PERL_NO_GET_CONTEXT
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
#include "sdbm/sdbm.h"
typedef struct {
DBM * dbp ;
SV * filter_fetch_key ;
SV * filter_store_key ;
SV * filter_fetch_value ;
SV * filter_store_value ;
int filtering ;
} SDBM_File_type;
typedef SDBM_File_type * SDBM_File ;
typedef datum datum_key ;
typedef datum datum_value ;
#define sdbm_TIEHASH(dbtype,filename,flags,mode) sdbm_open(filename,flags,mode)
#define sdbm_FETCH(db,key) sdbm_fetch(db->dbp,key)
#define sdbm_STORE(db,key,value,flags) sdbm_store(db->dbp,key,value,flags)
#define sdbm_DELETE(db,key) sdbm_delete(db->dbp,key)
#define sdbm_EXISTS(db,key) sdbm_exists(db->dbp,key)
#define sdbm_FIRSTKEY(db) sdbm_firstkey(db->dbp)
#define sdbm_NEXTKEY(db,key) sdbm_nextkey(db->dbp)
MODULE = SDBM_File PACKAGE = SDBM_File PREFIX = sdbm_
SDBM_File
sdbm_TIEHASH(dbtype, filename, flags, mode)
char * dbtype
char * filename
int flags
int mode
CODE:
{
DBM * dbp ;
RETVAL = NULL ;
if ((dbp = sdbm_open(filename,flags,mode))) {
RETVAL = (SDBM_File)safemalloc(sizeof(SDBM_File_type)) ;
Zero(RETVAL, 1, SDBM_File_type) ;
RETVAL->dbp = dbp ;
}
}
OUTPUT:
RETVAL
void
sdbm_DESTROY(db)
SDBM_File db
CODE:
sdbm_close(db->dbp);
if (db->filter_fetch_key)
SvREFCNT_dec(db->filter_fetch_key) ;
if (db->filter_store_key)
SvREFCNT_dec(db->filter_store_key) ;
if (db->filter_fetch_value)
SvREFCNT_dec(db->filter_fetch_value) ;
if (db->filter_store_value)
SvREFCNT_dec(db->filter_store_value) ;
safefree(db) ;
datum_value
sdbm_FETCH(db, key)
SDBM_File db
datum_key key
int
sdbm_STORE(db, key, value, flags = DBM_REPLACE)
SDBM_File db
datum_key key
datum_value value
int flags
CLEANUP:
if (RETVAL) {
if (RETVAL < 0 && errno == EPERM)
croak("No write permission to sdbm file");
croak("sdbm store returned %d, errno %d, key \"%s\"",
RETVAL,errno,key.dptr);
sdbm_clearerr(db->dbp);
}
int
sdbm_DELETE(db, key)
SDBM_File db
datum_key key
int
sdbm_EXISTS(db,key)
SDBM_File db
datum_key key
datum_key
sdbm_FIRSTKEY(db)
SDBM_File db
datum_key
sdbm_NEXTKEY(db, key)
SDBM_File db
datum_key key;
int
sdbm_error(db)
SDBM_File db
CODE:
RETVAL = sdbm_error(db->dbp) ;
OUTPUT:
RETVAL
int
sdbm_clearerr(db)
SDBM_File db
CODE:
RETVAL = sdbm_clearerr(db->dbp) ;
OUTPUT:
RETVAL
SV *
filter_fetch_key(db, code)
SDBM_File db
SV * code
SV * RETVAL = &PL_sv_undef ;
CODE:
DBM_setFilter(db->filter_fetch_key, code) ;
SV *
filter_store_key(db, code)
SDBM_File db
SV * code
SV * RETVAL = &PL_sv_undef ;
CODE:
DBM_setFilter(db->filter_store_key, code) ;
SV *
filter_fetch_value(db, code)
SDBM_File db
SV * code
SV * RETVAL = &PL_sv_undef ;
CODE:
DBM_setFilter(db->filter_fetch_value, code) ;
SV *
filter_store_value(db, code)
SDBM_File db
SV * code
SV * RETVAL = &PL_sv_undef ;
CODE:
DBM_setFilter(db->filter_store_value, code) ;
--- NEW FILE: typemap ---
#
#################################### DBM SECTION
#
datum_key T_DATUM_K
datum_value T_DATUM_V
gdatum T_GDATUM
NDBM_File T_PTROBJ
GDBM_File T_PTROBJ
SDBM_File T_PTROBJ
ODBM_File T_PTROBJ
DB_File T_PTROBJ
DBZ_File T_PTROBJ
FATALFUNC T_OPAQUEPTR
INPUT
T_DATUM_K
DBM_ckFilter($arg, filter_store_key, \"filter_store_key\");
$var.dptr = SvPVbyte($arg, PL_na);
$var.dsize = (int)PL_na;
T_DATUM_V
DBM_ckFilter($arg, filter_store_value, \"filter_store_value\");
if (SvOK($arg)) {
$var.dptr = SvPVbyte($arg, PL_na);
$var.dsize = (int)PL_na;
}
else {
$var.dptr = \"\";
$var.dsize = 0;
}
T_GDATUM
UNIMPLEMENTED
OUTPUT
T_DATUM_K
sv_setpvn($arg, $var.dptr, $var.dsize);
DBM_ckFilter($arg, filter_fetch_key,\"filter_fetch_key\");
T_DATUM_V
sv_setpvn($arg, $var.dptr, $var.dsize);
DBM_ckFilter($arg, filter_fetch_value,\"filter_fetch_value\");
T_GDATUM
sv_usepvn($arg, $var.dptr, $var.dsize);
T_PTROBJ
sv_setref_pv($arg, dbtype, (void*)$var);
--- NEW FILE: Makefile.PL ---
use ExtUtils::MakeMaker;
use Config;
# The existence of the ./sdbm/Makefile.PL file causes MakeMaker
# to automatically include Makefile code for the targets
# config, all, clean, realclean and sdbm/Makefile
# which perform the corresponding actions in the subdirectory.
$define = ($^O eq 'MSWin32') ? '-DMSDOS' : '';
if ($^O eq 'MSWin32') { $myextlib = 'sdbm\\libsdbm$(LIB_EXT)'; }
else { $myextlib = 'sdbm/libsdbm$(LIB_EXT)'; }
WriteMakefile(
NAME => 'SDBM_File',
MYEXTLIB => $myextlib,
MAN3PODS => {}, # Pods will be built by installman.
XSPROTOARG => '-noprototypes', # XXX remove later?
VERSION_FROM => 'SDBM_File.pm',
DEFINE => $define,
PERL_MALLOC_OK => 1,
);
sub MY::postamble {
if ($^O =~ /MSWin32/ && Win32::IsWin95()) {
if ($Config{'make'} =~ /dmake/i) {
# dmake-specific
return <<'EOT';
$(MYEXTLIB): sdbm/Makefile
@[
cd sdbm
$(MAKE) all
cd ..
]
EOT
} elsif ($Config{'make'} =~ /nmake/i) {
#
return <<'EOT';
$(MYEXTLIB): sdbm/Makefile
cd sdbm
$(MAKE) all
cd ..
EOT
}
} elsif ($^O ne 'VMS') {
'
$(MYEXTLIB): sdbm/Makefile
cd sdbm && $(MAKE) all
';
}
else {
'
$(MYEXTLIB) : [.sdbm]descrip.mms
set def [.sdbm]
$(MMS) all
set def [-]
';
}
}
More information about the dslinux-commit
mailing list