tokyocabinet-perl-1.34/0000755000175000017500000000000011445514326014103 5ustar mikiomikiotokyocabinet-perl-1.34/TokyoCabinet.pod0000644000175000017500000032447011420767027017215 0ustar mikiomikio#------------------------------------------------------------------------------------------------- # Perl binding of Tokyo Cabinet # Copyright (C) 2006-2010 FAL Labs # This file is part of Tokyo Cabinet. # Tokyo Cabinet is free software; you can redistribute it and/or modify it under the terms of # the GNU Lesser General Public License as published by the Free Software Foundation; either # version 2.1 of the License or any later version. Tokyo Cabinet is distributed in the hope # that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public # License for more details. # You should have received a copy of the GNU Lesser General Public License along with Tokyo # Cabinet; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, # Boston, MA 02111-1307 USA. #------------------------------------------------------------------------------------------------- =head1 NAME TokyoCabinet - Perl Binding of Tokyo Cabinet =head1 SYNOPSYS use TokyoCabinet; =head1 INTRODUCTION Tokyo Cabinet is a library of routines for managing a database. The database is a simple data file containing records, each is a pair of a key and a value. Every key and value is serial bytes with variable length. Both binary data and character string can be used as a key and a value. There is neither concept of data tables nor data types. Records are organized in hash table, B+ tree, or fixed-length array. As for database of hash table, each key must be unique within a database, so it is impossible to store two or more records with a key overlaps. The following access methods are provided to the database: storing a record with a key and a value, deleting a record by a key, retrieving a record by a key. Moreover, traversal access to every key are provided, although the order is arbitrary. These access methods are similar to ones of DBM (or its followers: NDBM and GDBM) library defined in the UNIX standard. Tokyo Cabinet is an alternative for DBM because of its higher performance. As for database of B+ tree, records whose keys are duplicated can be stored. Access methods of storing, deleting, and retrieving are provided as with the database of hash table. Records are stored in order by a comparison function assigned by a user. It is possible to access each record with the cursor in ascending or descending order. According to this mechanism, forward matching search for strings and range search for integers are realized. As for database of fixed-length array, records are stored with unique natural numbers. It is impossible to store two or more records with a key overlaps. Moreover, the length of each record is limited by the specified length. Provided operations are the same as ones of hash database. Table database is also provided as a variant of hash database. Each record is identified by the primary key and has a set of named columns. Although there is no concept of data schema, it is possible to search for records with complex conditions efficiently by using indices of arbitrary columns. =head2 Setting Install the latest version of Tokyo Cabinet beforehand and get the package of the Perl binding of Tokyo Cabinet. Enter the directory of the extracted package then perform installation. perl Makefile.PL make make test su make install The package `TokyoCabinet' should be loaded in each source file of application programs. use TokyoCabinet; If you want to enable runtime assertion, set the variable `$TokyoCabinet::DEBUG' to be true. $TokyoCabinet::DEBUG = 1; =head1 EXAMPLE The following code is an example to use a hash database. use TokyoCabinet; use strict; use warnings; # create the object my $hdb = TokyoCabinet::HDB->new(); # open the database if(!$hdb->open("casket.tch", $hdb->OWRITER | $hdb->OCREAT)){ my $ecode = $hdb->ecode(); printf STDERR ("open error: %s\n", $hdb->errmsg($ecode)); } # store records if(!$hdb->put("foo", "hop") || !$hdb->put("bar", "step") || !$hdb->put("baz", "jump")){ my $ecode = $hdb->ecode(); printf STDERR ("put error: %s\n", $hdb->errmsg($ecode)); } # retrieve records my $value = $hdb->get("foo"); if(defined($value)){ printf("%s\n", $value); } else { my $ecode = $hdb->ecode(); printf STDERR ("get error: %s\n", $hdb->errmsg($ecode)); } # traverse records $hdb->iterinit(); while(defined(my $key = $hdb->iternext())){ my $value = $hdb->get($key); if(defined($value)){ printf("%s:%s\n", $key, $value); } } # close the database if(!$hdb->close()){ my $ecode = $hdb->ecode(); printf STDERR ("close error: %s\n", $hdb->errmsg($ecode)); } # tying usage my %hash; if(!tie(%hash, "TokyoCabinet::HDB", "casket.tch", TokyoCabinet::HDB::OWRITER)){ printf STDERR ("tie error\n"); } $hash{"quux"} = "touchdown"; printf("%s\n", $hash{"quux"}); while(my ($key, $value) = each(%hash)){ printf("%s:%s\n", $key, $value); } untie(%hash); The following code is an example to use a B+ tree database. use TokyoCabinet; use strict; use warnings; # create the object my $bdb = TokyoCabinet::BDB->new(); # open the database if(!$bdb->open("casket.tcb", $bdb->OWRITER | $bdb->OCREAT)){ my $ecode = $bdb->ecode(); printf STDERR ("open error: %s\n", $bdb->errmsg($ecode)); } # store records if(!$bdb->put("foo", "hop") || !$bdb->put("bar", "step") || !$bdb->put("baz", "jump")){ my $ecode = $bdb->ecode(); printf STDERR ("put error: %s\n", $bdb->errmsg($ecode)); } # retrieve records my $value = $bdb->get("foo"); if(defined($value)){ printf("%s\n", $value); } else { my $ecode = $bdb->ecode(); printf STDERR ("get error: %s\n", $bdb->errmsg($ecode)); } # traverse records my $cur = TokyoCabinet::BDBCUR->new($bdb); $cur->first(); while(defined(my $key = $cur->key())){ my $value = $cur->val(); if(defined($value)){ printf("%s:%s\n", $key, $value); } $cur->next(); } # close the database if(!$bdb->close()){ my $ecode = $bdb->ecode(); printf STDERR ("close error: %s\n", $bdb->errmsg($ecode)); } # tying usage my %hash; if(!tie(%hash, "TokyoCabinet::BDB", "casket.tcb", TokyoCabinet::BDB::OWRITER)){ printf STDERR ("tie error\n"); } $hash{"quux"} = "touchdown"; printf("%s\n", $hash{"quux"}); while(my ($key, $value) = each(%hash)){ printf("%s:%s\n", $key, $value); } untie(%hash); The following code is an example to use a fixed-length database. use TokyoCabinet; use strict; use warnings; # create the object my $fdb = TokyoCabinet::FDB->new(); # open the database if(!$fdb->open("casket.tcf", $fdb->OWRITER | $fdb->OCREAT)){ my $ecode = $fdb->ecode(); printf STDERR ("open error: %s\n", $fdb->errmsg($ecode)); } # store records if(!$fdb->put(1, "one") || !$fdb->put(12, "twelve") || !$fdb->put(144, "one forty four")){ my $ecode = $fdb->ecode(); printf STDERR ("put error: %s\n", $fdb->errmsg($ecode)); } # retrieve records my $value = $fdb->get(1); if(defined($value)){ printf("%s\n", $value); } else { my $ecode = $fdb->ecode(); printf STDERR ("get error: %s\n", $fdb->errmsg($ecode)); } # traverse records $fdb->iterinit(); while(defined(my $key = $fdb->iternext())){ my $value = $fdb->get($key); if(defined($value)){ printf("%s:%s\n", $key, $value); } } # close the database if(!$fdb->close()){ my $ecode = $fdb->ecode(); printf STDERR ("close error: %s\n", $fdb->errmsg($ecode)); } # tying usage my %hash; if(!tie(%hash, "TokyoCabinet::FDB", "casket.tcf", TokyoCabinet::FDB::OWRITER)){ printf STDERR ("tie error\n"); } $hash{1728} = "seventeen twenty eight"; printf("%s\n", $hash{1728}); while(my ($key, $value) = each(%hash)){ printf("%s:%s\n", $key, $value); } untie(%hash); The following code is an example to use a table database. use TokyoCabinet; use strict; use warnings; # create the object my $tdb = TokyoCabinet::TDB->new(); # open the database if(!$tdb->open("casket.tct", $tdb->OWRITER | $tdb->OCREAT)){ my $ecode = $tdb->ecode(); printf STDERR ("open error: %s\n", $tdb->errmsg($ecode)); } # store a record my $pkey = $tdb->genuid(); my $cols = { "name" => "mikio", "age" => "30", "lang" => "ja,en,c" }; if(!$tdb->put($pkey, $cols)){ my $ecode = $tdb->ecode(); printf STDERR ("put error: %s\n", $tdb->errmsg($ecode)); } # store another record $cols = { "name" => "falcon", "age" => "31", "lang" => "ja", "skill" => "cook,blog" }; if(!$tdb->put("x12345", $cols)){ my $ecode = $tdb->ecode(); printf STDERR ("put error: %s\n", $tdb->errmsg($ecode)); } # search for records my $qry = TokyoCabinet::TDBQRY->new($tdb); $qry->addcond("age", $qry->QCNUMGE, "20"); $qry->addcond("lang", $qry->QCSTROR, "ja,en"); $qry->setorder("name", $qry->QOSTRASC); $qry->setlimit(10); my $res = $qry->search(); foreach my $rkey (@$res){ my $rcols = $tdb->get($rkey); printf("name:%s\n", $rcols->{name}); } # close the database if(!$tdb->close()){ my $ecode = $tdb->ecode(); printf STDERR ("close error: %s\n", $tdb->errmsg($ecode)); } # tying usage my %hash; if(!tie(%hash, "TokyoCabinet::TDB", "casket.tct", TokyoCabinet::TDB::OWRITER)){ printf STDERR ("tie error\n"); } $hash{"joker"} = { "name" => "ozma", "lang" => "en", "skill" => "song,dance" }; printf("%s\n", $hash{joker}->{name}); while(my ($key, $value) = each(%hash)){ printf("%s:%s\n", $key, $value->{name}); } untie(%hash); The following code is an example to use an abstract database. use TokyoCabinet; use strict; use warnings; # create the object my $adb = TokyoCabinet::ADB->new(); # open the database if(!$adb->open("casket.tch")){ printf STDERR ("open error\n"); } # store records if(!$adb->put("foo", "hop") || !$adb->put("bar", "step") || !$adb->put("baz", "jump")){ printf STDERR ("put error\n"); } # retrieve records my $value = $adb->get("foo"); if(defined($value)){ printf("%s\n", $value); } else { printf STDERR ("get error\n"); } # traverse records $adb->iterinit(); while(defined(my $key = $adb->iternext())){ my $value = $adb->get($key); if(defined($value)){ printf("%s:%s\n", $key, $value); } } # close the database if(!$adb->close()){ printf STDERR ("close error\n"); } # tying usage my %hash; if(!tie(%hash, "TokyoCabinet::ADB", "casket.tch")){ printf STDERR ("tie error\n"); } $hash{"quux"} = "touchdown"; printf("%s\n", $hash{"quux"}); while(my ($key, $value) = each(%hash)){ printf("%s:%s\n", $key, $value); } untie(%hash); =head1 DESCRIPTION =head2 Class TokyoCabinet The following functions are utilities to handle records by applications. =over =item TokyoCabinet::VERSIONZ<>() E<10>Get the version information of Tokyo Cabinet. E<10>The return value is the version information. =item TokyoCabinet::atoiZ<>(I) E<10>Convert a string to an integer. E<10>The return value is the integer value. =item TokyoCabinet::atofZ<>(I) E<10>Convert a string to a real number. E<10>The return value is the real number value. =item TokyoCabinet::bercompressZ<>(I) E<10>Serialize an array of nonnegative integers with BER encoding. E<10>`I' specifies the reference to an array of nonnegative integers. E<10>The return value is the reference to the serialized scalar. =item TokyoCabinet::beruncompressZ<>(I) E<10>Deserialize a BER encoded scalar to an array. E<10>`I' specifies the reference to the BER encoded scalar. E<10>The return value is the reference to the array of nonnegative integers. =item TokyoCabinet::diffcompressZ<>(I) E<10>Serialize an array of sorted nonnegative integers with difference BER encoding. E<10>`I' specifies the reference to an array of sorted nonnegative integers. E<10>The return value is the reference to the serialized scalar. =item TokyoCabinet::diffuncompressZ<>(I) E<10>Deserialize a difference BER encoded scalar to an array. E<10>`I' specifies the reference to the BER encoded scalar. E<10>The return value is the reference to the array of sorted nonnegative integers. =item TokyoCabinet::strdistanceZ<>(I, I, I) E<10>Calculate the edit distance of two strings. E<10>`I' specifies the reference to a string. E<10>`I' specifies the reference to the other string. E<10>`I' specifies whether the cost is calculated by Unicode character of UTF-8 strings. E<10>The return value is the edit distance which is known as the Levenshtein distance. =back =head2 Class TokyoCabinet::HDB Hash database is a file containing a hash table and is handled with the hash database API. Before operations to store or retrieve records, it is necessary to open a database file and connect the hash database object to it. The method `open' is used to open a database file and the method `close' is used to close the database file. To avoid data missing or corruption, it is important to close every database file when it is no longer in use. It is forbidden for multible database objects in a process to open the same database at the same time. =over =item $hdb = TokyoCabinet::HDB-EnewZ<>() E<10>Create a hash database object. E<10>The return value is the new hash database object. =item $hdb-EerrmsgZ<>(I) E<10>Get the message string corresponding to an error code. E<10>`I' specifies the error code. If it is not defined or negative, the last happened error code is specified. E<10>The return value is the message string of the error code. =item $hdb-EecodeZ<>() E<10>Get the last happened error code. E<10>The return value is the last happened error code. E<10>The following error codes are defined: `$hdb-EESUCCESS' for success, `$hdb-EETHREAD' for threading error, `$hdb-EEINVALID' for invalid operation, `$hdb-EENOFILE' for file not found, `$hdb-EENOPERM' for no permission, `$hdb-EEMETA' for invalid meta data, `$hdb-EERHEAD' for invalid record header, `$hdb-EEOPEN' for open error, `$hdb-EECLOSE' for close error, `$hdb-EETRUNC' for trunc error, `$hdb-EESYNC' for sync error, `$hdb-EESTAT' for stat error, `$hdb-EESEEK' for seek error, `$hdb-EEREAD' for read error, `$hdb-EEWRITE' for write error, `$hdb-EEMMAP' for mmap error, `$hdb-EELOCK' for lock error, `$hdb-EEUNLINK' for unlink error, `$hdb-EERENAME' for rename error, `$hdb-EEMKDIR' for mkdir error, `$hdb-EERMDIR' for rmdir error, `$hdb-EEKEEP' for existing record, `$hdb-EENOREC' for no record found, and `$hdb-EEMISC' for miscellaneous error. =item $hdb-EtuneZ<>(I, I, I, I) E<10>Set the tuning parameters. E<10>`I' specifies the number of elements of the bucket array. If it is not defined or not more than 0, the default value is specified. The default value is 131071. Suggested size of the bucket array is about from 0.5 to 4 times of the number of all records to be stored. E<10>`I' specifies the size of record alignment by power of 2. If it is not defined or negative, the default value is specified. The default value is 4 standing for 2^4=16. E<10>`I' specifies the maximum number of elements of the free block pool by power of 2. If it is not defined or negative, the default value is specified. The default value is 10 standing for 2^10=1024. E<10>`I' specifies options by bitwise-or: `$hdb-ETLARGE' specifies that the size of the database can be larger than 2GB by using 64-bit bucket array, `$hdb-ETDEFLATE' specifies that each record is compressed with Deflate encoding, `$hdb-ETBZIP' specifies that each record is compressed with BZIP2 encoding, `$hdb-ETTCBS' specifies that each record is compressed with TCBS encoding. If it is not defined, no option is specified. E<10>If successful, the return value is true, else, it is false. Note that the tuning parameters of the database should be set before the database is opened. =item $hdb-EsetcacheZ<>(I) E<10>Set the caching parameters. E<10>`I' specifies the maximum number of records to be cached. If it is not defined or not more than 0, the record cache is disabled. It is disabled by default. E<10>If successful, the return value is true, else, it is false. E<10>Note that the caching parameters of the database should be set before the database is opened. =item $hdb-EsetxmsizZ<>(I) E<10>Set the size of the extra mapped memory. E<10>`I' specifies the size of the extra mapped memory. If it is not defined or not more than 0, the extra mapped memory is disabled. The default size is 67108864. E<10>If successful, the return value is true, else, it is false. E<10>Note that the mapping parameters should be set before the database is opened. =item $hdb-EsetdfunitZ<>(I) E<10>Set the unit step number of auto defragmentation. E<10>`I' specifie the unit step number. If it is not more than 0, the auto defragmentation is disabled. It is disabled by default. E<10>If successful, the return value is true, else, it is false. E<10>Note that the defragmentation parameters should be set before the database is opened. =item $hdb-EopenZ<>(I, I) E<10>Open a database file. E<10>`I' specifies the path of the database file. E<10>`I' specifies the connection mode: `$hdb-EOWRITER' as a writer, `$hdb-EOREADER' as a reader. If the mode is `$hdb-EOWRITER', the following may be added by bitwise-or: `$hdb-EOCREAT', which means it creates a new database if not exist, `$hdb-EOTRUNC', which means it creates a new database regardless if one exists, `$hdb-EOTSYNC', which means every transaction synchronizes updated contents with the device. Both of `$hdb-EOREADER' and `$hdb-EOWRITER' can be added to by bitwise-or: `$hdb-EONOLCK', which means it opens the database file without file locking, or `$hdb-EOLCKNB', which means locking is performed without blocking. If it is not defined, `$hdb-EOREADER' is specified. E<10>If successful, the return value is true, else, it is false. =item $hdb-EcloseZ<>() E<10>Close the database file. E<10>If successful, the return value is true, else, it is false. E<10>Update of a database is assured to be written when the database is closed. If a writer opens a database but does not close it appropriately, the database will be broken. =item $hdb-EputZ<>(I, I) E<10>Store a record. E<10>`I' specifies the key. E<10>`I' specifies the value. E<10>If successful, the return value is true, else, it is false. E<10>If a record with the same key exists in the database, it is overwritten. =item $hdb-EputkeepZ<>(I, I) E<10>Store a new record. E<10>`I' specifies the key. E<10>`I' specifies the value. E<10>If successful, the return value is true, else, it is false. E<10>If a record with the same key exists in the database, this method has no effect. =item $hdb-EputcatZ<>(I, I) E<10>Concatenate a value at the end of the existing record. E<10>`I' specifies the key. E<10>`I' specifies the value. E<10>If successful, the return value is true, else, it is false. E<10>If there is no corresponding record, a new record is created. =item $hdb-EputasyncZ<>(I, I) E<10>Store a record in asynchronous fashion. E<10>`I' specifies the key. E<10>`I' specifies the value. E<10>If successful, the return value is true, else, it is false. E<10>If a record with the same key exists in the database, it is overwritten. Records passed to this method are accumulated into the inner buffer and wrote into the file at a blast. =item $hdb-EoutZ<>(I) E<10>Remove a record. E<10>`I' specifies the key. E<10>If successful, the return value is true, else, it is false. =item $hdb-EgetZ<>(I) E<10>Retrieve a record. E<10>`I' specifies the key. E<10>If successful, the return value is the value of the corresponding record. `undef' is returned if no record corresponds. =item $hdb-EvsizZ<>(I) E<10>Get the size of the value of a record. E<10>`I' specifies the key. E<10>If successful, the return value is the size of the value of the corresponding record, else, it is -1. =item $hdb-EiterinitZ<>() E<10>Initialize the iterator. E<10>If successful, the return value is true, else, it is false. E<10>The iterator is used in order to access the key of every record stored in a database. =item $hdb-EiternextZ<>() E<10>Get the next key of the iterator. E<10>If successful, the return value is the next key, else, it is `undef'. `undef' is returned when no record is to be get out of the iterator. E<10>It is possible to access every record by iteration of calling this method. It is allowed to update or remove records whose keys are fetched while the iteration. However, it is not assured if updating the database is occurred while the iteration. Besides, the order of this traversal access method is arbitrary, so it is not assured that the order of storing matches the one of the traversal access. =item $hdb-EfwmkeysZ<>(I, I) E<10>Get forward matching keys. E<10>`I' specifies the prefix of the corresponding keys. E<10>`I' specifies the maximum number of keys to be fetched. If it is not defined or negative, no limit is specified. E<10>The return value is the reference to an array of the keys of the corresponding records. This method does never fail. It returns an empty array even if no record corresponds. E<10>Note that this method may be very slow because every key in the database is scanned. =item $hdb-EaddintZ<>(I, I) E<10>Add an integer to a record. E<10>`I' specifies the key. E<10>`I' specifies the additional value. E<10>If successful, the return value is the summation value, else, it is `undef'. E<10>If the corresponding record exists, the value is treated as an integer and is added to. If no record corresponds, a new record of the additional value is stored. Because records are stored in binary format, they should be processed with the `unpack' function with the `i' operator after retrieval. =item $hdb-EadddoubleZ<>(I, I) E<10>Add a real number to a record. E<10>`I' specifies the key. E<10>`I' specifies the additional value. E<10>If successful, the return value is the summation value, else, it is `undef'. E<10>If the corresponding record exists, the value is treated as a real number and is added to. If no record corresponds, a new record of the additional value is stored. Because records are stored in binary format, they should be processed with the `unpack' function with the `d' operator after retrieval. =item $hdb-EsyncZ<>() E<10>Synchronize updated contents with the file and the device. E<10>If successful, the return value is true, else, it is false. E<10>This method is useful when another process connects the same database file. =item $hdb-EoptimizeZ<>(I, I, I, I) E<10>Optimize the database file. E<10>`I' specifies the number of elements of the bucket array. If it is not defined or not more than 0, the default value is specified. The default value is two times of the number of records. E<10>`I' specifies the size of record alignment by power of 2. If it is not defined or negative, the current setting is not changed. E<10>`I' specifies the maximum number of elements of the free block pool by power of 2. If it is not defined or negative, the current setting is not changed. E<10>`I' specifies options by bitwise-or: `$hdb-ETLARGE' specifies that the size of the database can be larger than 2GB by using 64-bit bucket array, `$hdb-ETDEFLATE' specifies that each record is compressed with Deflate encoding, `$hdb-ETBZIP' specifies that each record is compressed with BZIP2 encoding, `$hdb-ETTCBS' specifies that each record is compressed with TCBS encoding. If it is not defined or 0xff, the current setting is not changed. E<10>If successful, the return value is true, else, it is false. E<10>This method is useful to reduce the size of the database file with data fragmentation by successive updating. =item $hdb-EvanishZ<>() E<10>Remove all records. E<10>If successful, the return value is true, else, it is false. =item $hdb-EcopyZ<>(I) E<10>Copy the database file. E<10>`I' specifies the path of the destination file. If it begins with `@', the trailing substring is executed as a command line. E<10>If successful, the return value is true, else, it is false. False is returned if the executed command returns non-zero code. E<10>The database file is assured to be kept synchronized and not modified while the copying or executing operation is in progress. So, this method is useful to create a backup file of the database file. =item $hdb-EtranbeginZ<>() E<10>Begin the transaction. E<10>If successful, the return value is true, else, it is false. E<10>The database is locked by the thread while the transaction so that only one transaction can be activated with a database object at the same time. Thus, the serializable isolation level is assumed if every database operation is performed in the transaction. All updated regions are kept track of by write ahead logging while the transaction. If the database is closed during transaction, the transaction is aborted implicitly. =item $hdb-EtrancommitZ<>() E<10>Commit the transaction. E<10>If successful, the return value is true, else, it is false. E<10>Update in the transaction is fixed when it is committed successfully. =item $hdb-EtranabortZ<>() E<10>Abort the transaction. E<10>If successful, the return value is true, else, it is false. E<10>Update in the transaction is discarded when it is aborted. The state of the database is rollbacked to before transaction. =item $hdb-EpathZ<>() E<10>Get the path of the database file. E<10>The return value is the path of the database file or `undef' if the object does not connect to any database file. =item $hdb-ErnumZ<>() E<10>Get the number of records. E<10>The return value is the number of records or 0 if the object does not connect to any database file. =item $hdb-EfsizZ<>() E<10>Get the size of the database file. E<10>The return value is the size of the database file or 0 if the object does not connect to any database file. =back =head2 Tying functions of TokyoCabinet::HDB =over =item tieZ<>(%hash, ETokyoCabinet::HDBE, I, I, I, I, I, I, I) E<10>Tie a hash variable to a hash database file. E<10>`I' specifies the path of the database file. E<10>`I' specifies the connection mode: `TokyoCabinet::HDB::OWRITER' as a writer, `TokyoCabinet::HDB::OREADER' as a reader. If the mode is `TokyoCabinet::HDB::OWRITER', the following may be added by bitwise-or: `TokyoCabinet::HDB::OCREAT', which means it creates a new database if not exist, `TokyoCabinet::HDB::OTRUNC', which means it creates a new database regardless if one exists, `TokyoCabinet::HDB::OTSYNC', which means every transaction synchronizes updated contents with the device. Both of `TokyoCabinet::HDB::OREADER' and `TokyoCabinet::HDB::OWRITER' can be added to by bitwise-or: `TokyoCabinet::HDB::ONOLCK', which means it opens the database file without file locking, or `TokyoCabinet::HDB::OLCKNB', which means locking is performed without blocking. If it is not defined, `TokyoCabinet::HDB::OREADER' is specified. E<10>`I' specifies the number of elements of the bucket array. If it is not defined or not more than 0, the default value is specified. The default value is 131071. Suggested size of the bucket array is about from 0.5 to 4 times of the number of all records to be stored. E<10>`I' specifies the size of record alignment by power of 2. If it is not defined or negative, the default value is specified. The default value is 4 standing for 2^4=16. E<10>`I' specifies the maximum number of elements of the free block pool by power of 2. If it is not defined or negative, the default value is specified. The default value is 10 standing for 2^10=1024. E<10>`I' specifies options by bitwise-or: `TokyoCabinet::HDB::TLARGE' specifies that the size of the database can be larger than 2GB by using 64-bit bucket array, `TokyoCabinet::HDB::TDEFLATE' specifies that each record is compressed with Deflate encoding, `TokyoCabinet::HDB::TBZIP' specifies that each record is compressed with BZIP2 encoding, `TokyoCabinet::HDB::TTCBS' specifies that each record is compressed with TCBS encoding. If it is not defined, no option is specified. E<10>`I' specifies the maximum number of records to be cached. If it is not defined or not more than 0, the record cache is disabled. It is disabled by default. E<10>If successful, the return value is true, else, it is false. =item untieZ<>(%hash) E<10>Untie a hash variable from the database file. E<10>The return value is always true. =item $hash{I} = I E<10>Store a record. E<10>`I' specifies the key. E<10>`I' specifies the value. E<10>If successful, the return value is true, else, it is false. E<10>If a record with the same key exists in the database, it is overwritten. =item delete($hash{I}) E<10>Remove a record. E<10>`I' specifies the key. E<10>If successful, the return value is true, else, it is false. =item $hash{I} E<10>Retrieve a record. E<10>`I' specifies the key. E<10>If successful, the return value is the value of the corresponding record. `undef' is returned if no record corresponds. =item exists($hash{I}) E<10>Check whether a record corrsponding a key exists. E<10>`I' specifies the key. E<10>The return value is true if the record exists, else it is false. =item $hash = Z<>() E<10>Remove all records. E<10>The return value is always `undef'. =item Z<>(the iterator) E<10>The inner methods `FIRSTKEY' and `NEXTKEY' are also implemented so that you can use the tying functions `each', `keys', and so on. =back =head2 Class TokyoCabinet::BDB B+ tree database is a file containing a B+ tree and is handled with the B+ tree database API. Before operations to store or retrieve records, it is necessary to open a database file and connect the B+ tree database object to it. The method `open' is used to open a database file and the method `close' is used to close the database file. To avoid data missing or corruption, it is important to close every database file when it is no longer in use. It is forbidden for multible database objects in a process to open the same database at the same time. =over =item $bdb = TokyoCabinet::BDB-EnewZ<>() E<10>Create a B+ tree database object. E<10>The return value is the new B+ tree database object. =item $bdb-EerrmsgZ<>(I) E<10>Get the message string corresponding to an error code. E<10>`I' specifies the error code. If it is not defined or negative, the last happened error code is specified. E<10>The return value is the message string of the error code. =item $bdb-EecodeZ<>() E<10>Get the last happened error code. E<10>The return value is the last happened error code. E<10>The following error codes are defined: `$bdb-EESUCCESS' for success, `$bdb-EETHREAD' for threading error, `$bdb-EEINVALID' for invalid operation, `$bdb-EENOFILE' for file not found, `$bdb-EENOPERM' for no permission, `$bdb-EEMETA' for invalid meta data, `$bdb-EERHEAD' for invalid record header, `$bdb-EEOPEN' for open error, `$bdb-EECLOSE' for close error, `$bdb-EETRUNC' for trunc error, `$bdb-EESYNC' for sync error, `$bdb-EESTAT' for stat error, `$bdb-EESEEK' for seek error, `$bdb-EEREAD' for read error, `$bdb-EEWRITE' for write error, `$bdb-EEMMAP' for mmap error, `$bdb-EELOCK' for lock error, `$bdb-EEUNLINK' for unlink error, `$bdb-EERENAME' for rename error, `$bdb-EEMKDIR' for mkdir error, `$bdb-EERMDIR' for rmdir error, `$bdb-EEKEEP' for existing record, `$bdb-EENOREC' for no record found, and `$bdb-EEMISC' for miscellaneous error. =item $bdb-EsetcmpfuncZ<>(I) E<10>Set the custom comparison function. E<10>`I' specifies the custom comparison function. It can be either the reference of a block or the name of a function. E<10>If successful, the return value is true, else, it is false. E<10>The default comparison function compares keys of two records by lexical order. The constants `$bdb-ECMPLEXICAL' (dafault), `$bdb-ECMPDECIMAL', `$bdb-ECMPINT32', and `$bdb-ECMPINT64' are built-in. Note that the comparison function should be set before the database is opened. Moreover, user-defined comparison functions should be set every time the database is being opened. =item $bdb-EtuneZ<>(I, I, I, I, I, I) E<10>Set the tuning parameters. E<10>`I' specifies the number of members in each leaf page. If it is not defined or not more than 0, the default value is specified. The default value is 128. E<10>`I' specifies the number of members in each non-leaf page. If it is not defined or not more than 0, the default value is specified. The default value is 256. E<10>`I' specifies the number of elements of the bucket array. If it is not defined or not more than 0, the default value is specified. The default value is 32749. Suggested size of the bucket array is about from 1 to 4 times of the number of all pages to be stored. E<10>`I' specifies the size of record alignment by power of 2. If it is not defined or negative, the default value is specified. The default value is 4 standing for 2^8=256. E<10>`I' specifies the maximum number of elements of the free block pool by power of 2. If it is not defined or negative, the default value is specified. The default value is 10 standing for 2^10=1024. E<10>`I' specifies options by bitwise-or: `$bdb-ETLARGE' specifies that the size of the database can be larger than 2GB by using 64-bit bucket array, `$bdb-ETDEFLATE' specifies that each record is compressed with Deflate encoding, `$bdb-ETBZIP' specifies that each record is compressed with BZIP2 encoding, `$bdb-ETTCBS' specifies that each record is compressed with TCBS encoding. If it is not defined, no option is specified. E<10>If successful, the return value is true, else, it is false. Note that the tuning parameters of the database should be set before the database is opened. =item $bdb-EsetcacheZ<>(I, I) E<10>Set the caching parameters. E<10>`I' specifies the maximum number of leaf nodes to be cached. If it is not defined or not more than 0, the default value is specified. The default value is 1024. E<10>`I' specifies the maximum number of non-leaf nodes to be cached. If it is not defined or not more than 0, the default value is specified. The default value is 512. E<10>If successful, the return value is true, else, it is false. E<10>Note that the caching parameters of the database should be set before the database is opened. =item $bdb-EsetxmsizZ<>(I) E<10>Set the size of the extra mapped memory. E<10>`I' specifies the size of the extra mapped memory. If it is not defined or not more than 0, the extra mapped memory is disabled. It is disabled by default. E<10>If successful, the return value is true, else, it is false. E<10>Note that the mapping parameters should be set before the database is opened. =item $bdb-EsetdfunitZ<>(I) E<10>Set the unit step number of auto defragmentation. E<10>`I' specifie the unit step number. If it is not more than 0, the auto defragmentation is disabled. It is disabled by default. E<10>If successful, the return value is true, else, it is false. E<10>Note that the defragmentation parameters should be set before the database is opened. =item $bdb-EopenZ<>(I, I) E<10>Open a database file. E<10>`I' specifies the path of the database file. E<10>`I' specifies the connection mode: `$bdb-EOWRITER' as a writer, `$bdb-EOREADER' as a reader. If the mode is `$bdb-EOWRITER', the following may be added by bitwise-or: `$bdb-EOCREAT', which means it creates a new database if not exist, `$bdb-EOTRUNC', which means it creates a new database regardless if one exists, `$bdb-EOTSYNC', which means every transaction synchronizes updated contents with the device. Both of `$bdb-EOREADER' and `$bdb-EOWRITER' can be added to by bitwise-or: `$bdb-EONOLCK', which means it opens the database file without file locking, or `$bdb-EOLCKNB', which means locking is performed without blocking. If it is not defined, `$bdb-EOREADER' is specified. E<10>If successful, the return value is true, else, it is false. =item $bdb-EcloseZ<>() E<10>Close the database file. E<10>If successful, the return value is true, else, it is false. E<10>Update of a database is assured to be written when the database is closed. If a writer opens a database but does not close it appropriately, the database will be broken. =item $bdb-EputZ<>(I, I) E<10>Store a record. E<10>`I' specifies the key. E<10>`I' specifies the value. E<10>If successful, the return value is true, else, it is false. E<10>If a record with the same key exists in the database, it is overwritten. =item $bdb-EputkeepZ<>(I, I) E<10>Store a new record. E<10>`I' specifies the key. E<10>`I' specifies the value. E<10>If successful, the return value is true, else, it is false. E<10>If a record with the same key exists in the database, this method has no effect. =item $bdb-EputcatZ<>(I, I) E<10>Concatenate a value at the end of the existing record. E<10>`I' specifies the key. E<10>`I' specifies the value. E<10>If successful, the return value is true, else, it is false. E<10>If there is no corresponding record, a new record is created. =item $bdb-EputdupZ<>(I, I) E<10>Store a record with allowing duplication of keys. E<10>`I' specifies the key. E<10>`I' specifies the value. E<10>If successful, the return value is true, else, it is false. E<10>If a record with the same key exists in the database, the new record is placed after the existing one. =item $bdb-EputlistZ<>(I, I) E<10>Store records with allowing duplication of keys. E<10>`I' specifies the key. E<10>`I' specifies the reference to an array of the values. E<10>If successful, the return value is true, else, it is false. E<10>If a record with the same key exists in the database, the new records are placed after the existing one. =item $bdb-EoutZ<>(I) E<10>Remove a record. E<10>`I' specifies the key. E<10>If successful, the return value is true, else, it is false. E<10>If the key of duplicated records is specified, the first one is selected. =item $bdb-EoutlistZ<>(I) E<10>Remove records. E<10>`I' specifies the key. E<10>If successful, the return value is true, else, it is false. E<10>If the key of duplicated records is specified, all of them are removed. =item $bdb-EgetZ<>(I) E<10>Retrieve a record. E<10>`I' specifies the key. E<10>If successful, the return value is the value of the corresponding record. `undef' is returned if no record corresponds. E<10>If the key of duplicated records is specified, the first one is selected. =item $bdb-EgetlistZ<>(I) E<10>Retrieve records. E<10>`I' specifies the key. E<10>If successful, the return value is the reference to an array of the values of the corresponding records. `undef' is returned if no record corresponds. =item $bdb-EvnumZ<>(I) E<10>Get the number of records corresponding a key. E<10>`I' specifies the key. E<10>If successful, the return value is the number of the corresponding records, else, it is 0. =item $bdb-EvsizZ<>(I) E<10>Get the size of the value of a record. E<10>`I' specifies the key. E<10>If successful, the return value is the size of the value of the corresponding record, else, it is -1. E<10>If the key of duplicated records is specified, the first one is selected. =item $bdb-ErangeZ<>(I, I, I, I, I) E<10>Get keys of ranged records. E<10>`I' specifies the key of the beginning border. If it is not defined, the first record is specified. E<10>`I' specifies whether the beginning border is inclusive or not. If it is not defined, false is specified. E<10>`I' specifies the key of the ending border. If it is not defined, the last record is specified. E<10>`I' specifies whether the ending border is inclusive or not. If it is not defined, false is specified. E<10>`I' specifies the maximum number of keys to be fetched. If it is not defined or negative, no limit is specified. E<10>The return value is the reference to an array of the keys of the corresponding records. This method does never fail. It returns an empty array even if no record corresponds. =item $bdb-EfwmkeysZ<>(I, I) E<10>Get forward matching keys. E<10>`I' specifies the prefix of the corresponding keys. E<10>`I' specifies the maximum number of keys to be fetched. If it is not defined or negative, no limit is specified. E<10>The return value is the reference to an array of the keys of the corresponding records. This method does never fail. It returns an empty array even if no record corresponds. =item $bdb-EaddintZ<>(I, I) E<10>Add an integer to a record. E<10>`I' specifies the key. E<10>`I' specifies the additional value. E<10>If successful, the return value is the summation value, else, it is `undef'. E<10>If the corresponding record exists, the value is treated as an integer and is added to. If no record corresponds, a new record of the additional value is stored. Because records are stored in binary format, they should be processed with the `unpack' function with the `i' operator after retrieval. =item $bdb-EadddoubleZ<>(I, I) E<10>Add a real number to a record. E<10>`I' specifies the key. E<10>`I' specifies the additional value. E<10>If successful, the return value is the summation value, else, it is `undef'. E<10>If the corresponding record exists, the value is treated as a real number and is added to. If no record corresponds, a new record of the additional value is stored. Because records are stored in binary format, they should be processed with the `unpack' function with the `d' operator after retrieval. =item $bdb-EsyncZ<>() E<10>Synchronize updated contents with the file and the device. E<10>If successful, the return value is true, else, it is false. E<10>This method is useful when another process connects the same database file. =item $bdb-EoptimizeZ<>(I, I, I, I, I, I) E<10>Optimize the database file. E<10>`I' specifies the number of members in each leaf page. If it is not defined or not more than 0, the current setting is not changed. E<10>`I' specifies the number of members in each non-leaf page. If it is not defined or not more than 0, the current setting is not changed. E<10>`I' specifies the number of elements of the bucket array. If it is not defined or not more than 0, the default value is specified. The default value is two times of the number of pages. E<10>`I' specifies the size of record alignment by power of 2. If it is not defined or negative, the current setting is not changed. E<10>`I' specifies the maximum number of elements of the free block pool by power of 2. If it is not defined or negative, the current setting is not changed. E<10>`I' specifies options by bitwise-or: `$bdb-ETLARGE' specifies that the size of the database can be larger than 2GB by using 64-bit bucket array, `$bdb-ETDEFLATE' specifies that each record is compressed with Deflate encoding, `$bdb-ETBZIP' specifies that each record is compressed with BZIP2 encoding, `$bdb-ETTCBS' specifies that each record is compressed with TCBS encoding. If it is not defined or 0xff, the current setting is not changed. E<10>If successful, the return value is true, else, it is false. E<10>This method is useful to reduce the size of the database file with data fragmentation by successive updating. =item $bdb-EvanishZ<>() E<10>Remove all records. E<10>If successful, the return value is true, else, it is false. =item $bdb-EcopyZ<>(I) E<10>Copy the database file. E<10>`I' specifies the path of the destination file. If it begins with `@', the trailing substring is executed as a command line. E<10>If successful, the return value is true, else, it is false. False is returned if the executed command returns non-zero code. E<10>The database file is assured to be kept synchronized and not modified while the copying or executing operation is in progress. So, this method is useful to create a backup file of the database file. =item $bdb-EtranbeginZ<>() E<10>Begin the transaction. E<10>If successful, the return value is true, else, it is false. E<10>The database is locked by the thread while the transaction so that only one transaction can be activated with a database object at the same time. Thus, the serializable isolation level is assumed if every database operation is performed in the transaction. Because all pages are cached on memory while the transaction, the amount of referred records is limited by the memory capacity. If the database is closed during transaction, the transaction is aborted implicitly. =item $bdb-EtrancommitZ<>() E<10>Commit the transaction. E<10>If successful, the return value is true, else, it is false. E<10>Update in the transaction is fixed when it is committed successfully. =item $bdb-EtranabortZ<>() E<10>Abort the transaction. E<10>If successful, the return value is true, else, it is false. E<10>Update in the transaction is discarded when it is aborted. The state of the database is rollbacked to before transaction. =item $bdb-EpathZ<>() E<10>Get the path of the database file. E<10>The return value is the path of the database file or `undef' if the object does not connect to any database file. =item $bdb-ErnumZ<>() E<10>Get the number of records. E<10>The return value is the number of records or 0 if the object does not connect to any database file. =item $bdb-EfsizZ<>() E<10>Get the size of the database file. E<10>The return value is the size of the database file or 0 if the object does not connect to any database file. =back =head2 Class TokyoCabinet::BDBCUR =over =item $cur = TokyoCabinet::BDBCUR-EnewZ<>(I) E<10>Create a cursor object. E<10>`I' specifies the B+ tree database object. E<10>The return value is the new cursor object. E<10>Note that the cursor is available only after initialization with the `first' or the `jump' methods and so on. Moreover, the position of the cursor will be indefinite when the database is updated after the initialization of the cursor. =item $cur-EfirstZ<>() E<10>Move the cursor to the first record. E<10>If successful, the return value is true, else, it is false. False is returned if there is no record in the database. =item $cur-ElastZ<>() E<10>Move the cursor to the last record. E<10>If successful, the return value is true, else, it is false. False is returned if there is no record in the database. =item $cur-EjumpZ<>(I) E<10>Move the cursor to the front of records corresponding a key. E<10>`I' specifies the key. E<10>If successful, the return value is true, else, it is false. False is returned if there is no record corresponding the condition. E<10>The cursor is set to the first record corresponding the key or the next substitute if completely matching record does not exist. =item $cur-EprevZ<>() E<10>Move the cursor to the previous record. E<10>If successful, the return value is true, else, it is false. False is returned if there is no previous record. =item $cur-EnextZ<>() E<10>Move the cursor to the next record. E<10>If successful, the return value is true, else, it is false. False is returned if there is no next record. =item $cur-EputZ<>(I, I) E<10>Insert a record around the cursor. E<10>`I' specifies the value. E<10>`I' specifies detail adjustment: `$cur-ECPCURRENT', which means that the value of the current record is overwritten, `$cur-ECPBEFORE', which means that the new record is inserted before the current record, `$cur-ECPAFTER', which means that the new record is inserted after the current record. E<10>If successful, the return value is true, else, it is false. False is returned when the cursor is at invalid position. E<10>After insertion, the cursor is moved to the inserted record. =item $cur-EoutZ<>() E<10>Remove the record where the cursor is. E<10>If successful, the return value is true, else, it is false. False is returned when the cursor is at invalid position. E<10>After deletion, the cursor is moved to the next record if possible. =item $cur-EkeyZ<>() E<10>Get the key of the record where the cursor is. E<10>If successful, the return value is the key, else, it is `undef'. 'undef' is returned when the cursor is at invalid position. =item $cur-EvalZ<>() E<10>Get the value of the record where the cursor is. E<10>If successful, the return value is the value, else, it is `undef'. 'undef' is returned when the cursor is at invalid position. =back =head2 Tying functions of TokyoCabinet::BDB =over =item tieZ<>(%hash, ETokyoCabinet::BDBE, I, I, I, I, I, I, I, I, I, I) E<10>Tie a hash variable to a B+ tree database file. E<10>`I' specifies the path of the database file. E<10>`I' specifies the connection mode: `TokyoCabinet::BDB::OWRITER' as a writer, `TokyoCabinet::BDB::OREADER' as a reader. If the mode is `TokyoCabinet::BDB::OWRITER', the following may be added by bitwise-or: `TokyoCabinet::BDB::OCREAT', which means it creates a new database if not exist, `TokyoCabinet::BDB::OTRUNC', which means it creates a new database regardless if one exists, `TokyoCabinet::BDB::OTSYNC', which means every transaction synchronizes updated contents with the device. Both of `TokyoCabinet::BDB::OREADER' and `TokyoCabinet::BDB::OWRITER' can be added to by bitwise-or: `TokyoCabinet::BDB::ONOLCK', which means it opens the database file without file locking, or `TokyoCabinet::BDB::OLCKNB', which means locking is performed without blocking. If it is not defined, `TokyoCabinet::BDB::OREADER' is specified. E<10>`I' specifies the number of members in each leaf page. If it is not defined or not more than 0, the default value is specified. The default value is 128. E<10>`I' specifies the number of members in each non-leaf page. If it is not defined or not more than 0, the default value is specified. The default value is 256. E<10>`I' specifies the number of elements of the bucket array. If it is not defined or not more than 0, the default value is specified. The default value is 32749. E<10>`I' specifies the size of record alignment by power of 2. If it is not defined or negative, the default value is specified. The default value is 4 standing for 2^8=256. E<10>`I' specifies the maximum number of elements of the free block pool by power of 2. If it is not defined or negative, the default value is specified. The default value is 10 standing for 2^10=1024. E<10>`I' specifies options by bitwise-or: `TokyoCabinet::BDB::TLARGE' specifies that the size of the database can be larger than 2GB by using 64-bit bucket array, `TokyoCabinet::BDB::TDEFLATE' specifies that each record is compressed with Deflate encoding, `TokyoCabinet::BDB::TBZIP' specifies that each record is compressed with BZIP2 encoding, `TokyoCabinet::BDB::TTCBS' specifies that each record is compressed with TCBS encoding. If it is not defined, no option is specified. E<10>`I' specifies the maximum number of leaf nodes to be cached. If it is not defined or not more than 0, the default value is specified. E<10>`I' specifies the maximum number of non-leaf nodes to be cached. If it is not defined or not more than 0, the default value is specified. E<10>If successful, the return value is true, else, it is false. =item untieZ<>(%hash) E<10>Untie a hash variable from the database file. E<10>The return value is always true. =item $hash{I} = I E<10>Store a record. E<10>`I' specifies the key. E<10>`I' specifies the value. E<10>If successful, the return value is true, else, it is false. E<10>If a record with the same key exists in the database, it is overwritten. =item delete($hash{I}) E<10>Remove a record. E<10>`I' specifies the key. E<10>If successful, the return value is true, else, it is false. =item $hash{I} E<10>Retrieve a record. E<10>`I' specifies the key. E<10>If successful, the return value is the value of the corresponding record. `undef' is returned if no record corresponds. =item exists($hash{I}) E<10>Check whether a record corrsponding a key exists. E<10>`I' specifies the key. E<10>The return value is true if the record exists, else it is false. =item $hash = Z<>() E<10>Remove all records. E<10>The return value is always `undef'. =item (the iterator) E<10>The inner methods `FIRSTKEY' and `NEXTKEY' are also implemented so that you can use the tying functions `each', `keys', and so on. =back =head2 Class TokyoCabinet::FDB Fixed-length database is a file containing an array of fixed-length elements and is handled with the fixed-length database API. Before operations to store or retrieve records, it is necessary to open a database file and connect the fixed-length database object to it. The method `open' is used to open a database file and the method `close' is used to close the database file. To avoid data missing or corruption, it is important to close every database file when it is no longer in use. It is forbidden for multible database objects in a process to open the same database at the same time. =over =item $fdb = TokyoCabinet::FDB-EnewZ<>() E<10>Create a fixed-length database object. E<10>The return value is the new fixed-length database object. =item $fdb-EerrmsgZ<>(I) E<10>Get the message string corresponding to an error code. E<10>`I' specifies the error code. If it is not defined or negative, the last happened error code is specified. E<10>The return value is the message string of the error code. =item $fdb-EecodeZ<>() E<10>Get the last happened error code. E<10>The return value is the last happened error code. E<10>The following error codes are defined: `$fdb-EESUCCESS' for success, `$fdb-EETHREAD' for threading error, `$fdb-EEINVALID' for invalid operation, `$fdb-EENOFILE' for file not found, `$fdb-EENOPERM' for no permission, `$fdb-EEMETA' for invalid meta data, `$fdb-EERHEAD' for invalid record header, `$fdb-EEOPEN' for open error, `$fdb-EECLOSE' for close error, `$fdb-EETRUNC' for trunc error, `$fdb-EESYNC' for sync error, `$fdb-EESTAT' for stat error, `$fdb-EESEEK' for seek error, `$fdb-EEREAD' for read error, `$fdb-EEWRITE' for write error, `$fdb-EEMMAP' for mmap error, `$fdb-EELOCK' for lock error, `$fdb-EEUNLINK' for unlink error, `$fdb-EERENAME' for rename error, `$fdb-EEMKDIR' for mkdir error, `$fdb-EERMDIR' for rmdir error, `$fdb-EEKEEP' for existing record, `$fdb-EENOREC' for no record found, and `$fdb-EEMISC' for miscellaneous error. =item $fdb-EtuneZ<>(I, I); E<10>Set the tuning parameters. E<10>`I' specifies the width of the value of each record. If it is not defined or not more than 0, the default value is specified. The default value is 255. E<10>`I' specifies the limit size of the database file. If it is not defined or not more than 0, the default value is specified. The default value is 268435456. E<10>If successful, the return value is true, else, it is false. Note that the tuning parameters of the database should be set before the database is opened. =item $fdb-EopenZ<>(I, I) E<10>Open a database file. E<10>`I' specifies the path of the database file. E<10>`I' specifies the connection mode: `$fdb-EOWRITER' as a writer, `$fdb-EOREADER' as a reader. If the mode is `$fdb-EOWRITER', the following may be added by bitwise-or: `$fdb-EOCREAT', which means it creates a new database if not exist, `$fdb-EOTRUNC', which means it creates a new database regardless if one exists. Both of `$fdb-EOREADER' and `$fdb-EOWRITER' can be added to by bitwise-or: `$fdb-EONOLCK', which means it opens the database file without file locking, or `$fdb-EOLCKNB', which means locking is performed without blocking. If it is not defined, `$fdb-EOREADER' is specified. E<10>If successful, the return value is true, else, it is false. =item $fdb-EcloseZ<>() E<10>Close the database file. E<10>If successful, the return value is true, else, it is false. E<10>Update of a database is assured to be written when the database is closed. If a writer opens a database but does not close it appropriately, the database will be broken. =item $fdb-EputZ<>(I, I) E<10>Store a record. E<10>`I' specifies the key. It should be more than 0. If it is "min", the minimum ID number of existing records is specified. If it is "prev", the number less by one than the minimum ID number of existing records is specified. If it is "max", the maximum ID number of existing records is specified. If it is "next", the number greater by one than the maximum ID number of existing records is specified. E<10>`I' specifies the value. E<10>If successful, the return value is true, else, it is false. E<10>If a record with the same key exists in the database, it is overwritten. =item $fdb-EputkeepZ<>(I, I) E<10>Store a new record. E<10>`I' specifies the key. It should be more than 0. If it is "min", the minimum ID number of existing records is specified. If it is "prev", the number less by one than the minimum ID number of existing records is specified. If it is "max", the maximum ID number of existing records is specified. If it is "next", the number greater by one than the maximum ID number of existing records is specified. E<10>`I' specifies the value. E<10>If successful, the return value is true, else, it is false. E<10>If a record with the same key exists in the database, this method has no effect. =item $fdb-EputcatZ<>(I, I) E<10>Concatenate a value at the end of the existing record. E<10>`I' specifies the key. It should be more than 0. If it is "min", the minimum ID number of existing records is specified. If it is "prev", the number less by one than the minimum ID number of existing records is specified. If it is "max", the maximum ID number of existing records is specified. If it is "next", the number greater by one than the maximum ID number of existing records is specified. E<10>`I' specifies the value. E<10>If successful, the return value is true, else, it is false. E<10>If there is no corresponding record, a new record is created. =item $fdb-EoutZ<>(I) E<10>Remove a record. E<10>`I' specifies the key. It should be more than 0. If it is "min", the minimum ID number of existing records is specified. If it is "max", the maximum ID number of existing records is specified. E<10>If successful, the return value is true, else, it is false. =item $fdb-EgetZ<>(I) E<10>Retrieve a record. E<10>`I' specifies the key. It should be more than 0. If it is "min", the minimum ID number of existing records is specified. If it is "max", the maximum ID number of existing records is specified. E<10>If successful, the return value is the value of the corresponding record. `undef' is returned if no record corresponds. =item $fdb-EvsizZ<>(I) E<10>Get the size of the value of a record. E<10>`I' specifies the key. It should be more than 0. If it is "min", the minimum ID number of existing records is specified. If it is "max", the maximum ID number of existing records is specified. E<10>If successful, the return value is the size of the value of the corresponding record, else, it is -1. =item $fdb-EiterinitZ<>() E<10>Initialize the iterator. E<10>If successful, the return value is true, else, it is false. E<10>The iterator is used in order to access the key of every record stored in a database. =item $fdb-EiternextZ<>() E<10>Get the next key of the iterator. E<10>If successful, the return value is the next key, else, it is `undef'. `undef' is returned when no record is to be get out of the iterator. E<10>It is possible to access every record by iteration of calling this method. It is allowed to update or remove records whose keys are fetched while the iteration. The order of this traversal access method is ascending of the ID number. =item $fdb-ErangeZ<>(I, I) E<10>Get keys with an interval notation. E<10>`I' specifies the interval notation. E<10>`I' specifies the maximum number of keys to be fetched. If it is not defined or negative, no limit is specified. E<10>The return value is the reference to an array of the keys of the corresponding records. This method does never fail. It returns an empty array even if no record corresponds. =item $fdb-EaddintZ<>(I, I) E<10>Add an integer to a record. E<10>`I' specifies the key. It should be more than 0. If it is "min", the minimum ID number of existing records is specified. If it is "prev", the number less by one than the minimum ID number of existing records is specified. If it is "max", the maximum ID number of existing records is specified. If it is "next", the number greater by one than the maximum ID number of existing records is specified. E<10>`I' specifies the additional value. E<10>If successful, the return value is the summation value, else, it is `undef'. E<10>If the corresponding record exists, the value is treated as an integer and is added to. If no record corresponds, a new record of the additional value is stored. Because records are stored in binary format, they should be processed with the `unpack' function with the `i' operator after retrieval. =item $fdb-EadddoubleZ<>(I, I) E<10>Add a real number to a record. E<10>`I' specifies the key. It should be more than 0. If it is "min", the minimum ID number of existing records is specified. If it is "prev", the number less by one than the minimum ID number of existing records is specified. If it is "max", the maximum ID number of existing records is specified. If it is "next", the number greater by one than the maximum ID number of existing records is specified. E<10>`I' specifies the additional value. E<10>If successful, the return value is the summation value, else, it is `undef'. E<10>If the corresponding record exists, the value is treated as a real number and is added to. If no record corresponds, a new record of the additional value is stored. Because records are stored in binary format, they should be processed with the `unpack' function with the `d' operator after retrieval. =item $fdb-EsyncZ<>() E<10>Synchronize updated contents with the file and the device. E<10>If successful, the return value is true, else, it is false. E<10>This method is useful when another process connects the same database file. =item $fdb-EoptimizeZ<>(I, I) E<10>Optimize the database file. E<10>`I' specifies the width of the value of each record. If it is not defined or not more than 0, the current setting is not changed. E<10>`I' specifies the limit size of the database file. If it is not defined or not more than 0, the current setting is not changed. E<10>If successful, the return value is true, else, it is false. =item $fdb-EvanishZ<>() E<10>Remove all records. E<10>If successful, the return value is true, else, it is false. =item $fdb-EcopyZ<>(I) E<10>Copy the database file. E<10>`I' specifies the path of the destination file. If it begins with `@', the trailing substring is executed as a command line. E<10>If successful, the return value is true, else, it is false. False is returned if the executed command returns non-zero code. E<10>The database file is assured to be kept synchronized and not modified while the copying or executing operation is in progress. So, this method is useful to create a backup file of the database file. =item $fdb-EtranbeginZ<>() E<10>Begin the transaction. E<10>If successful, the return value is true, else, it is false. E<10>The database is locked by the thread while the transaction so that only one transaction can be activated with a database object at the same time. Thus, the serializable isolation level is assumed if every database operation is performed in the transaction. All updated regions are kept track of by write ahead logging while the transaction. If the database is closed during transaction, the transaction is aborted implicitly. =item $fdb-EtrancommitZ<>() E<10>Commit the transaction. E<10>If successful, the return value is true, else, it is false. E<10>Update in the transaction is fixed when it is committed successfully. =item $fdb-EtranabortZ<>() E<10>Abort the transaction. E<10>If successful, the return value is true, else, it is false. E<10>Update in the transaction is discarded when it is aborted. The state of the database is rollbacked to before transaction. =item $fdb-EpathZ<>() E<10>Get the path of the database file. E<10>The return value is the path of the database file or `undef' if the object does not connect to any database file. =item $fdb-ErnumZ<>() E<10>Get the number of records. E<10>The return value is the number of records or 0 if the object does not connect to any database file. =item $fdb-EfsizZ<>() E<10>Get the size of the database file. E<10>The return value is the size of the database file or 0 if the object does not connect to any database file. =back =head2 Tying functions of TokyoCabinet::FDB =over =item tieZ<>(%hash, ETokyoCabinet::FDBE, I, I, I, I) E<10>Tie a hash variable to a hash database file. E<10>`I' specifies the path of the database file. E<10>`I' specifies the connection mode: `TokyoCabinet::FDB::OWRITER' as a writer, `TokyoCabinet::FDB::OREADER' as a reader. If the mode is `TokyoCabinet::FDB::OWRITER', the following may be added by bitwise-or: `TokyoCabinet::FDB::OCREAT', which means it creates a new database if not exist, `TokyoCabinet::FDB::OTRUNC', which means it creates a new database regardless if one exists. Both of `TokyoCabinet::FDB::OREADER' and `TokyoCabinet::FDB::OWRITER' can be added to by bitwise-or: `TokyoCabinet::FDB::ONOLCK', which means it opens the database file without file locking, or `TokyoCabinet::FDB::OLCKNB', which means locking is performed without blocking. If it is not defined, `TokyoCabinet::FDB::OREADER' is specified. E<10>`I' specifies the width of the value of each record. If it is not defined or not more than 0, the default value is specified. The default value is 255. E<10>`I' specifies the limit size of the database file. If it is not defined or not more than 0, the default value is specified. The default value is 268435456. E<10>If successful, the return value is true, else, it is false. =item untieZ<>(%hash) E<10>Untie a hash variable from the database file. E<10>The return value is always true. =item $hash{I} = I E<10>Store a record. E<10>`I' specifies the key. It should be more than 0. If it is "min", the minimum ID number of existing records is specified. If it is "prev", the number less by one than the minimum ID number of existing records is specified. If it is "max", the maximum ID number of existing records is specified. If it is "next", the number greater by one than the maximum ID number of existing records is specified. E<10>`I' specifies the value. E<10>If successful, the return value is true, else, it is false. E<10>If a record with the same key exists in the database, it is overwritten. =item delete($hash{I}) E<10>Remove a record. E<10>`I' specifies the key. It should be more than 0. If it is "min", the minimum ID number of existing records is specified. If it is "max", the maximum ID number of existing records is specified. E<10>If successful, the return value is true, else, it is false. =item $hash{I} E<10>Retrieve a record. E<10>`I' specifies the key. It should be more than 0. If it is "min", the minimum ID number of existing records is specified. If it is "max", the maximum ID number of existing records is specified. E<10>If successful, the return value is the value of the corresponding record. `undef' is returned if no record corresponds. =item exists($hash{I}) E<10>Check whether a record corrsponding a key exists. E<10>`I' specifies the key. It should be more than 0. If it is "min", the minimum ID number of existing records is specified. If it is "max", the maximum ID number of existing records is specified. E<10>The return value is true if the record exists, else it is false. =item $hash = Z<>() E<10>Remove all records. E<10>The return value is always `undef'. =item Z<>(the iterator) E<10>The inner methods `FIRSTKEY' and `NEXTKEY' are also implemented so that you can use the tying functions `each', `keys', and so on. =back =head2 Class TokyoCabinet::TDB Table database is a file containing records composed of the primary keys and arbitrary columns and is handled with the table database API. Before operations to store or retrieve records, it is necessary to open a database file and connect the table database object to it. The method `open' is used to open a database file and the method `close' is used to close the database file. To avoid data missing or corruption, it is important to close every database file when it is no longer in use. It is forbidden for multible database objects in a process to open the same database at the same time. =over =item $tdb = TokyoCabinet::TDB-EnewZ<>() E<10>Create a table database object. E<10>The return value is the new table database object. =item $tdb-EerrmsgZ<>(I) E<10>Get the message string corresponding to an error code. E<10>`I' specifies the error code. If it is not defined or negative, the last happened error code is specified. E<10>The return value is the message string of the error code. =item $tdb-EecodeZ<>() E<10>Get the last happened error code. E<10>The return value is the last happened error code. E<10>The following error codes are defined: `$tdb-EESUCCESS' for success, `$tdb-EETHREAD' for threading error, `$tdb-EEINVALID' for invalid operation, `$tdb-EENOFILE' for file not found, `$tdb-EENOPERM' for no permission, `$tdb-EEMETA' for invalid meta data, `$tdb-EERHEAD' for invalid record header, `$tdb-EEOPEN' for open error, `$tdb-EECLOSE' for close error, `$tdb-EETRUNC' for trunc error, `$tdb-EESYNC' for sync error, `$tdb-EESTAT' for stat error, `$tdb-EESEEK' for seek error, `$tdb-EEREAD' for read error, `$tdb-EEWRITE' for write error, `$tdb-EEMMAP' for mmap error, `$tdb-EELOCK' for lock error, `$tdb-EEUNLINK' for unlink error, `$tdb-EERENAME' for rename error, `$tdb-EEMKDIR' for mkdir error, `$tdb-EERMDIR' for rmdir error, `$tdb-EEKEEP' for existing record, `$tdb-EENOREC' for no record found, and `$tdb-EEMISC' for miscellaneous error. =item $tdb-EtuneZ<>(I, I, I, I) E<10>Set the tuning parameters. E<10>`I' specifies the number of elements of the bucket array. If it is not defined or not more than 0, the default value is specified. The default value is 131071. Suggested size of the bucket array is about from 0.5 to 4 times of the number of all records to be stored. E<10>`I' specifies the size of record alignment by power of 2. If it is not defined or negative, the default value is specified. The default value is 4 standing for 2^4=16. E<10>`I' specifies the maximum number of elements of the free block pool by power of 2. If it is not defined or negative, the default value is specified. The default value is 10 standing for 2^10=1024. E<10>`I' specifies options by bitwise-or: `$tdb-ETLARGE' specifies that the size of the database can be larger than 2GB by using 64-bit bucket array, `$tdb-ETDEFLATE' specifies that each record is compressed with Deflate encoding, `$tdb-ETBZIP' specifies that each record is compressed with BZIP2 encoding, `$tdb-ETTCBS' specifies that each record is compressed with TCBS encoding. If it is not defined, no option is specified. E<10>If successful, the return value is true, else, it is false. Note that the tuning parameters of the database should be set before the database is opened. =item $tdb-EsetcacheZ<>(I, I, I) E<10>Set the caching parameters. E<10>`I' specifies the maximum number of records to be cached. If it is not defined or not more than 0, the record cache is disabled. It is disabled by default. E<10>`I' specifies the maximum number of leaf nodes to be cached. If it is not defined or not more than 0, the default value is specified. The default value is 4096. E<10>`I' specifies the maximum number of non-leaf nodes to be cached. If it is not defined or not more than 0, the default value is specified. The default value is 512. E<10>If successful, the return value is true, else, it is false. E<10>Note that the caching parameters of the database should be set before the database is opened. =item $tdb-EsetxmsizZ<>(I) E<10>Set the size of the extra mapped memory. E<10>`I' specifies the size of the extra mapped memory. If it is not defined or not more than 0, the extra mapped memory is disabled. The default size is 67108864. E<10>If successful, the return value is true, else, it is false. E<10>Note that the mapping parameters should be set before the database is opened. =item $tdb-EsetdfunitZ<>(I) E<10>Set the unit step number of auto defragmentation. E<10>`I' specifie the unit step number. If it is not more than 0, the auto defragmentation is disabled. It is disabled by default. E<10>If successful, the return value is true, else, it is false. E<10>Note that the defragmentation parameters should be set before the database is opened. =item $tdb-EopenZ<>(I, I) E<10>Open a database file. E<10>`I' specifies the path of the database file. E<10>`I' specifies the connection mode: `$tdb-EOWRITER' as a writer, `$tdb-EOREADER' as a reader. If the mode is `$tdb-EOWRITER', the following may be added by bitwise-or: `$tdb-EOCREAT', which means it creates a new database if not exist, `$tdb-EOTRUNC', which means it creates a new database regardless if one exists, `$tdb-EOTSYNC', which means every transaction synchronizes updated contents with the device. Both of `$tdb-EOREADER' and `$tdb-EOWRITER' can be added to by bitwise-or: `$tdb-EONOLCK', which means it opens the database file without file locking, or `$tdb-EOLCKNB', which means locking is performed without blocking. If it is not defined, `$tdb-EOREADER' is specified. E<10>If successful, the return value is true, else, it is false. =item $tdb-EcloseZ<>() E<10>Close the database file. E<10>If successful, the return value is true, else, it is false. E<10>Update of a database is assured to be written when the database is closed. If a writer opens a database but does not close it appropriately, the database will be broken. =item $tdb-EputZ<>(I, I) E<10>Store a record. E<10>`I' specifies the primary key. E<10>`I' specifies the reference to a hash containing columns. E<10>If successful, the return value is true, else, it is false. E<10>If a record with the same key exists in the database, it is overwritten. =item $tdb-EputkeepZ<>(I, I) E<10>Store a new record. E<10>`I' specifies the primary key. E<10>`I' specifies the reference to a hash containing columns. E<10>If successful, the return value is true, else, it is false. E<10>If a record with the same key exists in the database, this method has no effect. =item $tdb-EputcatZ<>(I, I) E<10>Concatenate columns of the existing record. E<10>`I' specifies the primary key. E<10>`I' specifies the reference to a hash containing columns. E<10>If successful, the return value is true, else, it is false. E<10>If there is no corresponding record, a new record is created. =item $tdb-EoutZ<>(I) E<10>Remove a record. E<10>`I' specifies the primary key. E<10>If successful, the return value is true, else, it is false. =item $tdb-EgetZ<>(I) E<10>Retrieve a record. E<10>`I' specifies the primary key. E<10>If successful, the return value is the reference to a hash of the columns of the corresponding record. `undef' is returned if no record corresponds. =item $tdb-EvsizZ<>(I) E<10>Get the size of the value of a record. E<10>`I' specifies the primary key. E<10>If successful, the return value is the size of the value of the corresponding record, else, it is -1. =item $tdb-EiterinitZ<>() E<10>Initialize the iterator. E<10>If successful, the return value is true, else, it is false. E<10>The iterator is used in order to access the primary key of every record stored in a database. =item $tdb-EiternextZ<>() E<10>Get the next primary key of the iterator. E<10>If successful, the return value is the next primary key, else, it is `undef'. `undef' is returned when no record is to be get out of the iterator. E<10>It is possible to access every record by iteration of calling this method. It is allowed to update or remove records whose keys are fetched while the iteration. However, it is not assured if updating the database is occurred while the iteration. Besides, the order of this traversal access method is arbitrary, so it is not assured that the order of storing matches the one of the traversal access. =item $tdb-EfwmkeysZ<>(I, I) E<10>Get forward matching primary keys. E<10>`I' specifies the prefix of the corresponding keys. E<10>`I' specifies the maximum number of keys to be fetched. If it is not defined or negative, no limit is specified. E<10>The return value is the reference to an array of the keys of the corresponding records. This method does never fail. It returns an empty array even if no record corresponds. E<10>Note that this method may be very slow because every key in the database is scanned. =item $tdb-EaddintZ<>(I, I) E<10>Add an integer to a record. E<10>`I' specifies primary key. E<10>`I' specifies the additional value. E<10>If successful, the return value is the summation value, else, it is `undef'. E<10>The additional value is stored as a decimal string value of a column whose name is "_num". If no record corresponds, a new record with the additional value is stored. =item $tdb-EadddoubleZ<>(I, I) E<10>Add a real number to a record. E<10>`I' specifies primary key. E<10>`I' specifies the additional value. E<10>If successful, the return value is the summation value, else, it is `undef'. E<10>The additional value is stored as a decimal string value of a column whose name is "_num". If no record corresponds, a new record with the additional value is stored. =item $tdb-EsyncZ<>() E<10>Synchronize updated contents with the file and the device. E<10>If successful, the return value is true, else, it is false. E<10>This method is useful when another process connects the same database file. =item $tdb-EoptimizeZ<>(I, I, I, I) E<10>Optimize the database file. E<10>`I' specifies the number of elements of the bucket array. If it is not defined or not more than 0, the default value is specified. The default value is two times of the number of records. E<10>`I' specifies the size of record alignment by power of 2. If it is not defined or negative, the current setting is not changed. E<10>`I' specifies the maximum number of elements of the free block pool by power of 2. If it is not defined or negative, the current setting is not changed. E<10>`I' specifies options by bitwise-or: `$tdb-ETLARGE' specifies that the size of the database can be larger than 2GB by using 64-bit bucket array, `$tdb-ETDEFLATE' specifies that each record is compressed with Deflate encoding, `$tdb-ETBZIP' specifies that each record is compressed with BZIP2 encoding, `$tdb-ETTCBS' specifies that each record is compressed with TCBS encoding. If it is not defined or 0xff, the current setting is not changed. E<10>If successful, the return value is true, else, it is false. E<10>This method is useful to reduce the size of the database file with data fragmentation by successive updating. =item $tdb-EvanishZ<>() E<10>Remove all records. E<10>If successful, the return value is true, else, it is false. =item $tdb-EcopyZ<>(I) E<10>Copy the database file. E<10>`I' specifies the path of the destination file. If it begins with `@', the trailing substring is executed as a command line. E<10>If successful, the return value is true, else, it is false. False is returned if the executed command returns non-zero code. E<10>The database file is assured to be kept synchronized and not modified while the copying or executing operation is in progress. So, this method is useful to create a backup file of the database file. =item $tdb-EtranbeginZ<>() E<10>Begin the transaction. E<10>If successful, the return value is true, else, it is false. E<10>The database is locked by the thread while the transaction so that only one transaction can be activated with a database object at the same time. Thus, the serializable isolation level is assumed if every database operation is performed in the transaction. All updated regions are kept track of by write ahead logging while the transaction. If the database is closed during transaction, the transaction is aborted implicitly. =item $tdb-EtrancommitZ<>() E<10>Commit the transaction. E<10>If successful, the return value is true, else, it is false. E<10>Update in the transaction is fixed when it is committed successfully. =item $tdb-EtranabortZ<>() E<10>Abort the transaction. E<10>If successful, the return value is true, else, it is false. E<10>Update in the transaction is discarded when it is aborted. The state of the database is rollbacked to before transaction. =item $tdb-EpathZ<>() E<10>Get the path of the database file. E<10>The return value is the path of the database file or `undef' if the object does not connect to any database file. =item $tdb-ErnumZ<>() E<10>Get the number of records. E<10>The return value is the number of records or 0 if the object does not connect to any database file. =item $tdb-EfsizZ<>() E<10>Get the size of the database file. E<10>The return value is the size of the database file or 0 if the object does not connect to any database file. =item $tdb-EsetindexZ<>(I, I) E<10>Set a column index. E<10>`I' specifies the name of a column. If the name of an existing index is specified, the index is rebuilt. An empty string means the primary key. E<10>`I' specifies the index type: `$tdb-EITLEXICAL' for lexical string, `$tdb-EITDECIMAL' for decimal string, `$tdb-EITTOKEN' for token inverted index, `$tdb-EITQGRAM' for q-gram inverted index. If it is `$tdb-EITOPT', the index is optimized. If it is `$tdb-EITVOID', the index is removed. If `$tdb-EITKEEP' is added by bitwise-or and the index exists, this method merely returns failure. E<10>If successful, the return value is true, else, it is false. =item $tdb-EgenuidZ<>() E<10>Generate a unique ID number. E<10>The return value is the new unique ID number or -1 on failure. =back =head2 Class TokyoCabinet::TDBQRY =over =item $qry = TokyoCabinet::TDBQRY-EnewZ<>(I) E<10>Create a query object. E<10>`I' specifies the table database object. E<10>The return value is the new query object. =item $qry-EaddcondZ<>(I, I, I) E<10>Add a narrowing condition. E<10>`I' specifies the name of a column. An empty string means the primary key. E<10>`I' specifies an operation type: `$qry-EQCSTREQ' for string which is equal to the expression, `$qry-EQCSTRINC' for string which is included in the expression, `$qry-EQCSTRBW' for string which begins with the expression, `$qry-EQCSTREW' for string which ends with the expression, `$qry-EQCSTRAND' for string which includes all tokens in the expression, `$qry-EQCSTROR' for string which includes at least one token in the expression, `$qry-EQCSTROREQ' for string which is equal to at least one token in the expression, `$qry-EQCSTRRX' for string which matches regular expressions of the expression, `$qry-EQCNUMEQ' for number which is equal to the expression, `$qry-EQCNUMGT' for number which is greater than the expression, `$qry-EQCNUMGE' for number which is greater than or equal to the expression, `$qry-EQCNUMLT' for number which is less than the expression, `$qry-EQCNUMLE' for number which is less than or equal to the expression, `$qry-EQCNUMBT' for number which is between two tokens of the expression, `$qry-EQCNUMOREQ' for number which is equal to at least one token in the expression, `$qry-EQCFTSPH' for full-text search with the phrase of the expression, `$qry-EQCFTSAND' for full-text search with all tokens in the expression, `$qry-EQCFTSOR' for full-text search with at least one token in the expression, `$qry-EQCFTSEX' for full-text search with the compound expression. All operations can be flagged by bitwise-or: `$qry-EQCNEGATE' for negation, `$qry-EQCNOIDX' for using no index. E<10>`I' specifies an operand exression. E<10>The return value is always `undef'. =item $qry-EsetorderZ<>(I, I) E<10>Set the order of the result. E<10>`I' specifies the name of a column. An empty string means the primary key. E<10>`I' specifies the order type: `$qry-EQOSTRASC' for string ascending, `$qry-EQOSTRDESC' for string descending, `$qry-EQONUMASC' for number ascending, `$qry-EQONUMDESC' for number descending. If it is not defined, `$qry-EQOSTRASC' is specified. E<10>The return value is always `undef'. =item $qry-EsetlimitZ<>(I, I) E<10>Set the maximum number of records of the result. E<10>`I' specifies the maximum number of records of the result. If it is not defined or negative, no limit is specified. E<10>`I' specifies the number of skipped records of the result. If it is not defined or not more than 0, no record is skipped. E<10>The return value is always `undef'. =item $qry-EsearchZ<>() E<10>Execute the search. E<10>The return value is the reference to an array of the primary keys of the corresponding records. This method does never fail. It returns an empty array even if no record corresponds. =item $qry-EsearchoutZ<>() E<10>Remove each corresponding record. E<10>If successful, the return value is true, else, it is false. =item $qry-EprocZ<>(I) E<10>Process each corresponding record. E<10>`I' specifies the iterator function called for each record. It can be either the reference of a block or the name of a function. The function receives two parameters. The first parameter is the primary key. The second parameter is the reference to a hash containing columns. It returns flags of the post treatment by bitwise-or: `$qry-EQPPUT' to modify the record, `$qry-EQPOUT' to remove the record, `$qry-EQPSTOP' to stop the iteration. E<10>If successful, the return value is true, else, it is false. =item $qry-EhintZ<>() E<10>Get the hint string. E<10>The return value is the hint string. =item $qry-EmetasearchZ<>(I, I) E<10>Retrieve records with multiple query objects and get the set of the result. E<10>`I' specifies the reference to an array of the query objects except for the self object. E<10>`I' specifies a set operation type: `$qry-EMSUNION' for the union set, `$qry-EMSISECT' for the intersection set, `$qry-EMSDIFF' for the difference set. If it is not defined, `$qry-EMSUNION' is specified. E<10>The return value is the reference to an array of the primary keys of the corresponding records. This method does never fail. It returns an empty array even if no record corresponds. E<10>If the first query object has the order setting, the result array is sorted by the order. =item $qry-EkwicZ<>(I, I, I, I) E<10>Generate keyword-in-context strings. E<10>`I' specifies the reference to a hash containing columns. E<10>`I' specifies the name of a column. If it is not defined, the first column of the query is specified. E<10>`I' specifies the width of strings picked up around each keyword. If it is not defined or negative, the whole text is picked up. E<10>`I' specifies options by bitwise-or: `$qry-EKWMUTAB' specifies that each keyword is marked up between two tab characters, `$qry-EKWMUCTRL' specifies that each keyword is marked up by the STX (0x02) code and the ETX (0x03) code, `$qry-EKWMUBRCT' specifies that each keyword is marked up by the two square brackets, `$qry-EKWNOOVER' specifies that each context does not overlap, `$qry-EKWPULEAD' specifies that the lead string is picked up forcibly. If it is not defined, no option is specified. E<10>The return value is the reference to an array of strings around keywords. =back =head2 Tying functions of TokyoCabinet::TDB =over =item tieZ<>(%hash, ETokyoCabinet::TDBE, I, I, I, I, I, I, I, I, I) E<10>Tie a hash variable to a table database file. E<10>`I' specifies the path of the database file. E<10>`I' specifies the connection mode: `TokyoCabinet::TDB::OWRITER' as a writer, `TokyoCabinet::TDB::OREADER' as a reader. If the mode is `TokyoCabinet::TDB::OWRITER', the following may be added by bitwise-or: `TokyoCabinet::TDB::OCREAT', which means it creates a new database if not exist, `TokyoCabinet::TDB::OTRUNC', which means it creates a new database regardless if one exists, `TokyoCabinet::TDB::OTSYNC', which means every transaction synchronizes updated contents with the device. Both of `TokyoCabinet::TDB::OREADER' and `TokyoCabinet::TDB::OWRITER' can be added to by bitwise-or: `TokyoCabinet::TDB::ONOLCK', which means it opens the database file without file locking, or `TokyoCabinet::TDB::OLCKNB', which means locking is performed without blocking. If it is not defined, `TokyoCabinet::TDB::OREADER' is specified. E<10>`I' specifies the number of elements of the bucket array. If it is not defined or not more than 0, the default value is specified. The default value is 131071. Suggested size of the bucket array is about from 0.5 to 4 times of the number of all records to be stored. E<10>`I' specifies the size of record alignment by power of 2. If it is not defined or negative, the default value is specified. The default value is 4 standing for 2^4=16. E<10>`I' specifies the maximum number of elements of the free block pool by power of 2. If it is not defined or negative, the default value is specified. The default value is 10 standing for 2^10=1024. E<10>`I' specifies options by bitwise-or: `TokyoCabinet::TDB::TLARGE' specifies that the size of the database can be larger than 2GB by using 64-bit bucket array, `TokyoCabinet::TDB::TDEFLATE' specifies that each record is compressed with Deflate encoding, `TokyoCabinet::TDB::TBZIP' specifies that each record is compressed with BZIP2 encoding, `TokyoCabinet::TDB::TTCBS' specifies that each record is compressed with TCBS encoding. If it is not defined, no option is specified. E<10>`I' specifies the maximum number of records to be cached. If it is not defined or not more than 0, the record cache is disabled. It is disabled by default. E<10>`I' specifies the maximum number of leaf nodes to be cached. If it is not defined or not more than 0, the default value is specified. The default value is 2048. E<10>`I' specifies the maximum number of non-leaf nodes to be cached. If it is not defined or not more than 0, the default value is specified. The default value is 512. E<10>If successful, the return value is true, else, it is false. =item untieZ<>(%hash) E<10>Untie a hash variable from the database file. E<10>The return value is always true. =item $hash{I} = I E<10>Store a record. E<10>`I' specifies primary key. E<10>`I' specifies the reference to a hash containing columns. E<10>If successful, the return value is true, else, it is false. E<10>If a record with the same key exists in the database, it is overwritten. =item delete($hash{I}) E<10>Remove a record. E<10>`I' specifies primary key. E<10>If successful, the return value is true, else, it is false. =item $hash{I} E<10>Retrieve a record. E<10>`I' specifies primary key. E<10>If successful, the return value is the reference to a hash of the columns of the corresponding record. `undef' is returned if no record corresponds. =item exists($hash{I}) E<10>Check whether a record corrsponding a key exists. E<10>`I' specifies primary key. E<10>The return value is true if the record exists, else it is false. =item $hash = Z<>() E<10>Remove all records. E<10>The return value is always `undef'. =item Z<>(the iterator) E<10>The inner methods `FIRSTKEY' and `NEXTKEY' are also implemented so that you can use the tying functions `each', `keys', and so on. =back =head2 Class TokyoCabinet::ADB Abstract database is a set of interfaces to use on-memory hash database, on-memory tree database, hash database, B+ tree database, fixed-length database, and table database with the same API. Before operations to store or retrieve records, it is necessary to connect the abstract database object to the concrete one. The method `open' is used to open a concrete database and the method `close' is used to close the database. To avoid data missing or corruption, it is important to close every database instance when it is no longer in use. It is forbidden for multible database objects in a process to open the same database at the same time. =over =item $adb = TokyoCabinet::ADB-EnewZ<>() E<10>Create an abstract database object. E<10>The return value is the new abstract database object. =item $adb-EopenZ<>(I) E<10>Open a database. E<10>`I' specifies the name of the database. If it is "*", the database will be an on-memory hash database. If it is "+", the database will be an on-memory tree database. If its suffix is ".tch", the database will be a hash database. If its suffix is ".tcb", the database will be a B+ tree database. If its suffix is ".tcf", the database will be a fixed-length database. If its suffix is ".tct", the database will be a table database. Otherwise, this method fails. Tuning parameters can trail the name, separated by "#". Each parameter is composed of the name and the value, separated by "=". On-memory hash database supports "bnum", "capnum", and "capsiz". On-memory tree database supports "capnum" and "capsiz". Hash database supports "mode", "bnum", "apow", "fpow", "opts", "rcnum", and "xmsiz". B+ tree database supports "mode", "lmemb", "nmemb", "bnum", "apow", "fpow", "opts", "lcnum", "ncnum", and "xmsiz". Fixed-length database supports "mode", "width", and "limsiz". Table database supports "mode", "bnum", "apow", "fpow", "opts", "rcnum", "lcnum", "ncnum", "xmsiz", and "idx". E<10>If successful, the return value is true, else, it is false. E<10>The tuning parameter "capnum" specifies the capacity number of records. "capsiz" specifies the capacity size of using memory. Records spilled the capacity are removed by the storing order. "mode" can contain "w" of writer, "r" of reader, "c" of creating, "t" of truncating, "e" of no locking, and "f" of non-blocking lock. The default mode is relevant to "wc". "opts" can contains "l" of large option, "d" of Deflate option, "b" of BZIP2 option, and "t" of TCBS option. "idx" specifies the column name of an index and its type separated by ":". For example, "casket.tch#bnum=1000000#opts=ld" means that the name of the database file is "casket.tch", and the bucket number is 1000000, and the options are large and Deflate. =item $adb-EcloseZ<>() E<10>Close the database. E<10>If successful, the return value is true, else, it is false. E<10>Update of a database is assured to be written when the database is closed. If a writer opens a database but does not close it appropriately, the database will be broken. =item $adb-EputZ<>(I, I) E<10>Store a record. E<10>`I' specifies the key. E<10>`I' specifies the value. E<10>If successful, the return value is true, else, it is false. E<10>If a record with the same key exists in the database, it is overwritten. =item $adb-EputkeepZ<>(I, I) E<10>Store a new record. E<10>`I' specifies the key. E<10>`I' specifies the value. E<10>If successful, the return value is true, else, it is false. E<10>If a record with the same key exists in the database, this method has no effect. =item $adb-EputcatZ<>(I, I) E<10>Concatenate a value at the end of the existing record. E<10>`I' specifies the key. E<10>`I' specifies the value. E<10>If successful, the return value is true, else, it is false. E<10>If there is no corresponding record, a new record is created. =item $adb-EoutZ<>(I) E<10>Remove a record. E<10>`I' specifies the key. E<10>If successful, the return value is true, else, it is false. =item $adb-EgetZ<>(I) E<10>Retrieve a record. E<10>`I' specifies the key. E<10>If successful, the return value is the value of the corresponding record. `undef' is returned if no record corresponds. =item $adb-EvsizZ<>(I) E<10>Get the size of the value of a record. E<10>`I' specifies the key. E<10>If successful, the return value is the size of the value of the corresponding record, else, it is -1. =item $adb-EiterinitZ<>() E<10>Initialize the iterator. E<10>If successful, the return value is true, else, it is false. E<10>The iterator is used in order to access the key of every record stored in a database. =item $adb-EiternextZ<>() E<10>Get the next key of the iterator. E<10>If successful, the return value is the next key, else, it is `undef'. `undef' is returned when no record is to be get out of the iterator. E<10>It is possible to access every record by iteration of calling this method. It is allowed to update or remove records whose keys are fetched while the iteration. However, it is not assured if updating the database is occurred while the iteration. Besides, the order of this traversal access method is arbitrary, so it is not assured that the order of storing matches the one of the traversal access. =item $adb-EfwmkeysZ<>(I, I) E<10>Get forward matching keys. E<10>`I' specifies the prefix of the corresponding keys. E<10>`I' specifies the maximum number of keys to be fetched. If it is not defined or negative, no limit is specified. E<10>The return value is the reference to an array of the keys of the corresponding records. This method does never fail. It returns an empty array even if no record corresponds. E<10>Note that this method may be very slow because every key in the database is scanned. =item $adb-EaddintZ<>(I, I) E<10>Add an integer to a record. E<10>`I' specifies the key. E<10>`I' specifies the additional value. E<10>If successful, the return value is the summation value, else, it is `undef'. E<10>If the corresponding record exists, the value is treated as an integer and is added to. If no record corresponds, a new record of the additional value is stored. Because records are stored in binary format, they should be processed with the `unpack' function with the `i' operator after retrieval. =item $adb-EadddoubleZ<>(I, I) E<10>Add a real number to a record. E<10>`I' specifies the key. E<10>`I' specifies the additional value. E<10>If successful, the return value is the summation value, else, it is `undef'. E<10>If the corresponding record exists, the value is treated as a real number and is added to. If no record corresponds, a new record of the additional value is stored. Because records are stored in binary format, they should be processed with the `unpack' function with the `d' operator after retrieval. =item $adb-EsyncZ<>() E<10>Synchronize updated contents with the file and the device. E<10>If successful, the return value is true, else, it is false. =item $adb-EoptimizeZ<>(I) E<10>Optimize the storage. E<10>`I' specifies the string of the tuning parameters, which works as with the tuning of parameters the method `open'. If it is not defined, it is not used. E<10>If successful, the return value is true, else, it is false. =item $adb-EvanishZ<>() E<10>Remove all records. E<10>If successful, the return value is true, else, it is false. =item $adb-EcopyZ<>(I) E<10>Copy the database file. E<10>`I' specifies the path of the destination file. If it begins with `@', the trailing substring is executed as a command line. E<10>If successful, the return value is true, else, it is false. False is returned if the executed command returns non-zero code. E<10>The database file is assured to be kept synchronized and not modified while the copying or executing operation is in progress. So, this method is useful to create a backup file of the database file. =item $adb-EtranbeginZ<>() E<10>Begin the transaction. E<10>If successful, the return value is true, else, it is false. E<10>The database is locked by the thread while the transaction so that only one transaction can be activated with a database object at the same time. Thus, the serializable isolation level is assumed if every database operation is performed in the transaction. All updated regions are kept track of by write ahead logging while the transaction. If the database is closed during transaction, the transaction is aborted implicitly. =item $adb-EtrancommitZ<>() E<10>Commit the transaction. E<10>If successful, the return value is true, else, it is false. E<10>Update in the transaction is fixed when it is committed successfully. =item $adb-EtranabortZ<>() E<10>Abort the transaction. E<10>If successful, the return value is true, else, it is false. E<10>Update in the transaction is discarded when it is aborted. The state of the database is rollbacked to before transaction. =item $adb-EpathZ<>() E<10>Get the path of the database file. E<10>The return value is the path of the database file or `undef' if the object does not connect to any database instance. "*" stands for on-memory hash database. "+" stands for on-memory tree database. =item $adb-ErnumZ<>() E<10>Get the number of records. E<10>The return value is the number of records or 0 if the object does not connect to any database instance. =item $adb-EsizeZ<>() E<10>Get the size of the database. E<10>The return value is the size of the database file or 0 if the object does not connect to any database instance. =item $adb-EmiscZ<>(I, I) E<10>Call a versatile function for miscellaneous operations. E<10>`I' specifies the name of the function. E<10>`I' specifies the reference to an array of arguments. If it is not defined, no argument is specified. E<10>If successful, the return value is the reference to an array of the result. `undef' is returned on failure. =back =head2 Tying functions of TokyoCabinet::ADB =over =item tieZ<>(%hash, ETokyoCabinet::ADBE, I) E<10>Tie a hash variable to an abstract database instance. E<10>`I' specifies the name of the database. If it is "*", the database will be an on-memory hash database. If it is "+", the database will be an on-memory tree database. If its suffix is ".tch", the database will be a hash database. If its suffix is ".tcb", the database will be a B+ tree database. If its suffix is ".tcf", the database will be a fixed-length database. If its suffix is ".tct", the database will be a table database. Otherwise, this method fails. Tuning parameters can trail the name, separated by "#". Each parameter is composed of the name and the value, separated by "=". On-memory hash database supports "bnum", "capnum", and "capsiz". On-memory tree database supports "capnum" and "capsiz". Hash database supports "mode", "bnum", "apow", "fpow", "opts", "rcnum", and "xmsiz". B+ tree database supports "mode", "lmemb", "nmemb", "bnum", "apow", "fpow", "opts", "lcnum", "ncnum", and "xmsiz". Fixed-length database supports "mode", "width", and "limsiz". Table database supports "mode", "bnum", "apow", "fpow", "opts", "rcnum", "lcnum", "ncnum", "xmsiz", and "idx". E<10>If successful, the return value is true, else, it is false. =item untieZ<>(%hash) E<10>Untie a hash variable from the database. E<10>The return value is always true. =item $hash{I} = I E<10>Store a record. E<10>`I' specifies the key. E<10>`I' specifies the value. E<10>If successful, the return value is true, else, it is false. E<10>If a record with the same key exists in the database, it is overwritten. =item delete($hash{I}) E<10>Remove a record. E<10>`I' specifies the key. E<10>If successful, the return value is true, else, it is false. =item $hash{I} E<10>Retrieve a record. E<10>`I' specifies the key. E<10>If successful, the return value is the value of the corresponding record. `undef' is returned if no record corresponds. =item exists($hash{I}) E<10>Check whether a record corrsponding a key exists. E<10>`I' specifies the key. E<10>The return value is true if the record exists, else it is false. =item $hash = Z<>() E<10>Remove all records. E<10>The return value is always `undef'. =item Z<>(the iterator) E<10>The inner methods `FIRSTKEY' and `NEXTKEY' are also implemented so that you can use the tying functions `each', `keys', and so on. =back =head1 LICENSE Copyright (C) 2006-2010 FAL Labs All rights reserved. Tokyo Cabinet is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as published by the Free Software Foundation; either version 2.1 of the License or any later version. Tokyo Cabinet is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more details. You should have received a copy of the GNU Lesser General Public License along with Tokyo Cabinet; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA. tokyocabinet-perl-1.34/example/0000755000175000017500000000000011420766705015541 5ustar mikiomikiotokyocabinet-perl-1.34/example/tchdbex.pl0000644000175000017500000000243311420766705017521 0ustar mikiomikiouse TokyoCabinet; use strict; use warnings; # create the object my $hdb = TokyoCabinet::HDB->new(); # open the database if(!$hdb->open("casket.tch", $hdb->OWRITER | $hdb->OCREAT)){ my $ecode = $hdb->ecode(); printf STDERR ("open error: %s\n", $hdb->errmsg($ecode)); } # store records if(!$hdb->put("foo", "hop") || !$hdb->put("bar", "step") || !$hdb->put("baz", "jump")){ my $ecode = $hdb->ecode(); printf STDERR ("put error: %s\n", $hdb->errmsg($ecode)); } # retrieve records my $value = $hdb->get("foo"); if(defined($value)){ printf("%s\n", $value); } else { my $ecode = $hdb->ecode(); printf STDERR ("get error: %s\n", $hdb->errmsg($ecode)); } # traverse records $hdb->iterinit(); while(defined(my $key = $hdb->iternext())){ my $value = $hdb->get($key); if(defined($value)){ printf("%s:%s\n", $key, $value); } } # close the database if(!$hdb->close()){ my $ecode = $hdb->ecode(); printf STDERR ("close error: %s\n", $hdb->errmsg($ecode)); } # tying usage my %hash; if(!tie(%hash, "TokyoCabinet::HDB", "casket.tch", TokyoCabinet::HDB::OWRITER)){ printf STDERR ("tie error\n"); } $hash{"quux"} = "touchdown"; printf("%s\n", $hash{"quux"}); while(my ($key, $value) = each(%hash)){ printf("%s:%s\n", $key, $value); } untie(%hash); tokyocabinet-perl-1.34/example/tcbdbex.pl0000644000175000017500000000251411420766705017513 0ustar mikiomikiouse TokyoCabinet; use strict; use warnings; # create the object my $bdb = TokyoCabinet::BDB->new(); # open the database if(!$bdb->open("casket.tcb", $bdb->OWRITER | $bdb->OCREAT)){ my $ecode = $bdb->ecode(); printf STDERR ("open error: %s\n", $bdb->errmsg($ecode)); } # store records if(!$bdb->put("foo", "hop") || !$bdb->put("bar", "step") || !$bdb->put("baz", "jump")){ my $ecode = $bdb->ecode(); printf STDERR ("put error: %s\n", $bdb->errmsg($ecode)); } # retrieve records my $value = $bdb->get("foo"); if(defined($value)){ printf("%s\n", $value); } else { my $ecode = $bdb->ecode(); printf STDERR ("get error: %s\n", $bdb->errmsg($ecode)); } # traverse records my $cur = TokyoCabinet::BDBCUR->new($bdb); $cur->first(); while(defined(my $key = $cur->key())){ my $value = $cur->val(); if(defined($value)){ printf("%s:%s\n", $key, $value); } $cur->next(); } # close the database if(!$bdb->close()){ my $ecode = $bdb->ecode(); printf STDERR ("close error: %s\n", $bdb->errmsg($ecode)); } # tying usage my %hash; if(!tie(%hash, "TokyoCabinet::BDB", "casket.tcb", TokyoCabinet::BDB::OWRITER)){ printf STDERR ("tie error\n"); } $hash{"quux"} = "touchdown"; printf("%s\n", $hash{"quux"}); while(my ($key, $value) = each(%hash)){ printf("%s:%s\n", $key, $value); } untie(%hash); tokyocabinet-perl-1.34/example/tcfdbex.pl0000644000175000017500000000244311420766705017520 0ustar mikiomikiouse TokyoCabinet; use strict; use warnings; # create the object my $fdb = TokyoCabinet::FDB->new(); # open the database if(!$fdb->open("casket.tcf", $fdb->OWRITER | $fdb->OCREAT)){ my $ecode = $fdb->ecode(); printf STDERR ("open error: %s\n", $fdb->errmsg($ecode)); } # store records if(!$fdb->put(1, "one") || !$fdb->put(12, "twelve") || !$fdb->put(144, "one forty four")){ my $ecode = $fdb->ecode(); printf STDERR ("put error: %s\n", $fdb->errmsg($ecode)); } # retrieve records my $value = $fdb->get(1); if(defined($value)){ printf("%s\n", $value); } else { my $ecode = $fdb->ecode(); printf STDERR ("get error: %s\n", $fdb->errmsg($ecode)); } # traverse records $fdb->iterinit(); while(defined(my $key = $fdb->iternext())){ my $value = $fdb->get($key); if(defined($value)){ printf("%s:%s\n", $key, $value); } } # close the database if(!$fdb->close()){ my $ecode = $fdb->ecode(); printf STDERR ("close error: %s\n", $fdb->errmsg($ecode)); } # tying usage my %hash; if(!tie(%hash, "TokyoCabinet::FDB", "casket.tcf", TokyoCabinet::FDB::OWRITER)){ printf STDERR ("tie error\n"); } $hash{1728} = "seventeen twenty eight"; printf("%s\n", $hash{1728}); while(my ($key, $value) = each(%hash)){ printf("%s:%s\n", $key, $value); } untie(%hash); tokyocabinet-perl-1.34/example/tctdbex.pl0000644000175000017500000000307611420766705017541 0ustar mikiomikiouse TokyoCabinet; use strict; use warnings; # create the object my $tdb = TokyoCabinet::TDB->new(); # open the database if(!$tdb->open("casket.tct", $tdb->OWRITER | $tdb->OCREAT)){ my $ecode = $tdb->ecode(); printf STDERR ("open error: %s\n", $tdb->errmsg($ecode)); } # store a record my $pkey = $tdb->genuid(); my $cols = { "name" => "mikio", "age" => "30", "lang" => "ja,en,c" }; if(!$tdb->put($pkey, $cols)){ my $ecode = $tdb->ecode(); printf STDERR ("put error: %s\n", $tdb->errmsg($ecode)); } # store another record $cols = { "name" => "falcon", "age" => "31", "lang" => "ja", "skill" => "cook,blog" }; if(!$tdb->put("x12345", $cols)){ my $ecode = $tdb->ecode(); printf STDERR ("put error: %s\n", $tdb->errmsg($ecode)); } # search for records my $qry = TokyoCabinet::TDBQRY->new($tdb); $qry->addcond("age", $qry->QCNUMGE, "20"); $qry->addcond("lang", $qry->QCSTROR, "ja,en"); $qry->setorder("name", $qry->QOSTRASC); $qry->setlimit(10); my $res = $qry->search(); foreach my $rkey (@$res){ my $rcols = $tdb->get($rkey); printf("name:%s\n", $rcols->{name}); } # close the database if(!$tdb->close()){ my $ecode = $tdb->ecode(); printf STDERR ("close error: %s\n", $tdb->errmsg($ecode)); } # tying usage my %hash; if(!tie(%hash, "TokyoCabinet::TDB", "casket.tct", TokyoCabinet::TDB::OWRITER)){ printf STDERR ("tie error\n"); } $hash{"joker"} = { "name" => "ozma", "lang" => "en", "skill" => "song,dance" }; printf("%s\n", $hash{joker}->{name}); while(my ($key, $value) = each(%hash)){ printf("%s:%s\n", $key, $value->{name}); } untie(%hash); tokyocabinet-perl-1.34/example/tcadbex.pl0000644000175000017500000000177511420766705017522 0ustar mikiomikiouse TokyoCabinet; use strict; use warnings; # create the object my $adb = TokyoCabinet::ADB->new(); # open the database if(!$adb->open("casket.tch")){ printf STDERR ("open error\n"); } # store records if(!$adb->put("foo", "hop") || !$adb->put("bar", "step") || !$adb->put("baz", "jump")){ printf STDERR ("put error\n"); } # retrieve records my $value = $adb->get("foo"); if(defined($value)){ printf("%s\n", $value); } else { printf STDERR ("get error\n"); } # traverse records $adb->iterinit(); while(defined(my $key = $adb->iternext())){ my $value = $adb->get($key); if(defined($value)){ printf("%s:%s\n", $key, $value); } } # close the database if(!$adb->close()){ printf STDERR ("close error\n"); } # tying usage my %hash; if(!tie(%hash, "TokyoCabinet::ADB", "casket.tch")){ printf STDERR ("tie error\n"); } $hash{"quux"} = "touchdown"; printf("%s\n", $hash{"quux"}); while(my ($key, $value) = each(%hash)){ printf("%s:%s\n", $key, $value); } untie(%hash); tokyocabinet-perl-1.34/package.sh0000755000175000017500000000043711076073453016042 0ustar mikiomikio#! /bin/sh LANG=C LC_ALL=C PATH="$PATH:/usr/local/bin:$HOME/bin:.:.." export LANG LC_ALL PATH if [ -f Makefile ] then make distclean fi rm -rf casket casket* *~ *.tmp hoge moge TokyoCabinet-*.tar* name="${PWD##*/}" cd .. if [ -d "$name" ] then tar zcvf "$name.tar.gz" "$name" fi tokyocabinet-perl-1.34/MANIFEST0000644000175000017500000000050611170626433015233 0ustar mikiomikioMANIFEST Makefile.PL TokyoCabinet.pm TokyoCabinet.xs TokyoCabinet.pod tchtest.pl tcbtest.pl tcftest.pl tcttest.pl tcatest.pl test.pl memsize.pl example/tchdbex.pl example/tcbdbex.pl example/tcfdbex.pl example/tctdbex.pl example/tcadbex.pl COPYING META.yml Module meta-data (added by MakeMaker) tokyocabinet-perl-1.34/tcftest.pl0000644000175000017500000003772511420766744016140 0ustar mikiomikio#! /usr/bin/perl -w #------------------------------------------------------------------------------------------------- # The test cases of the fixed-length database API # Copyright (C) 2006-2010 FAL Labs # This file is part of Tokyo Cabinet. # Tokyo Cabinet is free software; you can redistribute it and/or modify it under the terms of # the GNU Lesser General Public License as published by the Free Software Foundation; either # version 2.1 of the License or any later version. Tokyo Cabinet is distributed in the hope # that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public # License for more details. # You should have received a copy of the GNU Lesser General Public License along with Tokyo # Cabinet; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, # Boston, MA 02111-1307 USA. #------------------------------------------------------------------------------------------------- use lib qw(./blib/lib ./blib/arch); use strict; use warnings; use ExtUtils::testlib; use Time::HiRes qw(gettimeofday); use Data::Dumper; use TokyoCabinet; $TokyoCabinet::DEBUG = 1; # main routine sub main { my $rv; scalar(@ARGV) >= 1 || usage(); if($ARGV[0] eq "write"){ $rv = runwrite(); } elsif($ARGV[0] eq "read"){ $rv = runread(); } elsif($ARGV[0] eq "remove"){ $rv = runremove(); } elsif($ARGV[0] eq "misc"){ $rv = runmisc(); } else { usage(); } return $rv; } # print the usage and exit sub usage { printf STDERR ("$0: test cases of the fixed-length database API\n"); printf STDERR ("\n"); printf STDERR ("usage:\n"); printf STDERR (" $0 write [-nl|-nb] path rnum [width [limsiz]]\n"); printf STDERR (" $0 read [-nl|-nb] path\n"); printf STDERR (" $0 remove [-nl|-nb] path\n"); printf STDERR (" $0 misc [-nl|-nb] path rnum\n"); printf STDERR ("\n"); exit(1); } # parse arguments of write command sub runwrite { my $path = undef; my $rnum = undef; my $width = undef; my $limsiz = undef; my $omode = 0; for(my $i = 1; $i < scalar(@ARGV); $i++){ if(!defined($path) && $ARGV[$i] =~ /^-/){ if($ARGV[$i] eq "-nl"){ $omode |= TokyoCabinet::FDB::ONOLCK; } elsif($ARGV[$i] eq "-nb"){ $omode |= TokyoCabinet::FDB::OLCKNB; } else { usage(); } } elsif(!defined($path)){ $path = $ARGV[$i]; } elsif(!defined($rnum)){ $rnum = TokyoCabinet::atoi($ARGV[$i]); } elsif(!defined($width)){ $width = TokyoCabinet::atoi($ARGV[$i]); } elsif(!defined($limsiz)){ $limsiz = TokyoCabinet::atoi($ARGV[$i]); } else { usage(); } } usage() if(!defined($path) || !defined($rnum) || $rnum < 1); $width = defined($width) ? $width : -1; $limsiz = defined($limsiz) ? $limsiz : -1; my $rv = procwrite($path, $rnum, $width, $limsiz, $omode); return $rv; } # parse arguments of read command sub runread { my $path = undef; my $omode = 0; for(my $i = 1; $i < scalar(@ARGV); $i++){ if(!defined($path) && $ARGV[$i] =~ /^-/){ if($ARGV[$i] eq "-nl"){ $omode |= TokyoCabinet::FDB::ONOLCK; } elsif($ARGV[$i] eq "-nb"){ $omode |= TokyoCabinet::FDB::OLCKNB; } else { usage(); } } elsif(!defined($path)){ $path = $ARGV[$i]; } else { usage(); } } usage() if(!defined($path)); my $rv = procread($path, $omode); return $rv; } # parse arguments of remove command sub runremove { my $path = undef; my $omode = 0; for(my $i = 1; $i < scalar(@ARGV); $i++){ if(!defined($path) && $ARGV[$i] =~ /^-/){ if($ARGV[$i] eq "-nl"){ $omode |= TokyoCabinet::FDB::ONOLCK; } elsif($ARGV[$i] eq "-nb"){ $omode |= TokyoCabinet::FDB::OLCKNB; } else { usage(); } } elsif(!defined($path)){ $path = $ARGV[$i]; } else { usage(); } } usage() if(!defined($path)); my $rv = procremove($path, $omode); return $rv; } # parse arguments of misc command sub runmisc { my $path = undef; my $rnum = undef; my $omode = 0; for(my $i = 1; $i < scalar(@ARGV); $i++){ if(!defined($path) && $ARGV[$i] =~ /^-/){ if($ARGV[$i] eq "-nl"){ $omode |= TokyoCabinet::FDB::ONOLCK; } elsif($ARGV[$i] eq "-nb"){ $omode |= TokyoCabinet::FDB::OLCKNB; } else { usage(); } } elsif(!defined($path)){ $path = $ARGV[$i]; } elsif(!defined($rnum)){ $rnum = TokyoCabinet::atoi($ARGV[$i]); } else { usage(); } } usage() if(!defined($path) || !defined($rnum) || $rnum < 1); my $rv = procmisc($path, $rnum, $omode); return $rv; } # print error message of fixed-length database sub eprint { my $fdb = shift; my $func = shift; my $path = $fdb->path(); printf STDERR ("%s: %s: %s: %s\n", $0, defined($path) ? $path : "-", $func, $fdb->errmsg()); } # perform write command sub procwrite { my $path = shift; my $rnum = shift; my $width = shift; my $limsiz = shift; my $omode = shift; printf("\n path=%s rnum=%d width=%d limsiz=%d omode=%d\n\n", $path, $rnum, $width, $limsiz, $omode); my $err = 0; my $stime = gettimeofday(); my $fdb = TokyoCabinet::FDB->new(); if(!$fdb->tune($width, $limsiz)){ eprint($fdb, "tune"); $err = 1; } if(!$fdb->open($path, $fdb->OWRITER | $fdb->OCREAT | $fdb->OTRUNC | $omode)){ eprint($fdb, "open"); $err = 1; } for(my $i = 1; $i <= $rnum; $i++){ my $buf = sprintf("%08d", $i); if(!$fdb->put($buf, $buf)){ eprint($fdb, "put"); $err = 1; last; } if($rnum > 250 && $i % ($rnum / 250) == 0){ print('.'); if($i == $rnum || $i % ($rnum / 10) == 0){ printf(" (%08d)\n", $i); } } } printf("record number: %llu\n", $fdb->rnum()); printf("size: %llu\n", $fdb->fsiz()); if(!$fdb->close()){ eprint($fdb, "close"); $err = 1; } printf("time: %.3f\n", gettimeofday() - $stime); printf("%s\n\n", $err ? "error" : "ok"); return $err ? 1 : 0; } # perform read command sub procread { my $path = shift; my $omode = shift; printf("\n path=%s omode=%d\n\n", $path, $omode); my $err = 0; my $stime = gettimeofday(); my $fdb = TokyoCabinet::FDB->new(); if(!$fdb->open($path, $fdb->OREADER | $omode)){ eprint($fdb, "open"); $err = 1; } my $rnum = $fdb->rnum(); for(my $i = 1; $i <= $rnum; $i++){ my $buf = sprintf("%08d", $i); if(!$fdb->get($buf)){ eprint($fdb, "get"); $err = 1; last; } if($rnum > 250 && $i % ($rnum / 250) == 0){ print('.'); if($i == $rnum || $i % ($rnum / 10) == 0){ printf(" (%08d)\n", $i); } } } printf("record number: %llu\n", $fdb->rnum()); printf("size: %llu\n", $fdb->fsiz()); if(!$fdb->close()){ eprint($fdb, "close"); $err = 1; } printf("time: %.3f\n", gettimeofday() - $stime); printf("%s\n\n", $err ? "error" : "ok"); return $err ? 1 : 0; } # perform remove command sub procremove { my $path = shift; my $omode = shift; printf("\n path=%s omode=%d\n\n", $path, $omode); my $err = 0; my $stime = gettimeofday(); my $fdb = TokyoCabinet::FDB->new(); if(!$fdb->open($path, $fdb->OWRITER | $omode)){ eprint($fdb, "open"); $err = 1; } my $rnum = $fdb->rnum(); for(my $i = 1; $i <= $rnum; $i++){ my $buf = sprintf("%08d", $i); if(!$fdb->out($buf)){ eprint($fdb, "out"); $err = 1; last; } if($rnum > 250 && $i % ($rnum / 250) == 0){ print('.'); if($i == $rnum || $i % ($rnum / 10) == 0){ printf(" (%08d)\n", $i); } } } printf("record number: %llu\n", $fdb->rnum()); printf("size: %llu\n", $fdb->fsiz()); if(!$fdb->close()){ eprint($fdb, "close"); $err = 1; } printf("time: %.3f\n", gettimeofday() - $stime); printf("%s\n\n", $err ? "error" : "ok"); return $err ? 1 : 0; } # perform misc command sub procmisc { my $path = shift; my $rnum = shift; my $omode = shift; printf("\n path=%s rnum=%d omode=%d\n\n", $path, $rnum, $omode); my $err = 0; my $stime = gettimeofday(); my $fdb = TokyoCabinet::FDB->new(); if(!$fdb->tune(10, 1024 + 32 * $rnum)){ eprint($fdb, "tune"); $err = 1; } if(!$fdb->open($path, $fdb->OWRITER | $fdb->OCREAT | $fdb->OTRUNC | $omode)){ eprint($fdb, "open"); $err = 1; } printf("writing:\n"); for(my $i = 1; $i <= $rnum; $i++){ my $buf = sprintf("%08d", $i); if(!$fdb->put($buf, $buf)){ eprint($fdb, "put"); $err = 1; last; } if($rnum > 250 && $i % ($rnum / 250) == 0){ print('.'); if($i == $rnum || $i % ($rnum / 10) == 0){ printf(" (%08d)\n", $i); } } } printf("reading:\n"); for(my $i = 1; $i <= $rnum; $i++){ my $buf = sprintf("%08d", $i); if(!$fdb->get($buf)){ eprint($fdb, "get"); $err = 1; last; } if($rnum > 250 && $i % ($rnum / 250) == 0){ print('.'); if($i == $rnum || $i % ($rnum / 10) == 0){ printf(" (%08d)\n", $i); } } } printf("removing:\n"); for(my $i = 1; $i <= $rnum; $i++){ my $buf = sprintf("%08d", $i); if(int(rand(2)) == 0 && !$fdb->out($buf)){ eprint($fdb, "out"); $err = 1; last; } if($rnum > 250 && $i % ($rnum / 250) == 0){ print('.'); if($i == $rnum || $i % ($rnum / 10) == 0){ printf(" (%08d)\n", $i); } } } printf("checking iterator:\n"); if(!$fdb->iterinit()){ eprint($fdb, "iterinit"); $err = 1; } my $inum = 0; while(defined(my $key = $fdb->iternext())){ $inum++; my $value = $fdb->get($key); if(!defined($value)){ eprint($fdb, "get"); $err = 1; } if($rnum > 250 && $inum % ($rnum / 250) == 0){ print('.'); if($inum == $rnum || $inum % ($rnum / 10) == 0){ printf(" (%08d)\n", $inum); } } } printf(" (%08d)\n", $inum) if($rnum > 250); if($fdb->ecode() != $fdb->ENOREC || $inum != $fdb->rnum()){ eprint($fdb, "(validation)"); $err = 1; } my $keys = $fdb->range("[min,max]", 10); if($fdb->rnum() >= 10 && scalar(@$keys) != 10){ eprint($fdb, "range"); $err = 1; } printf("checking counting:\n"); for(my $i = 1; $i <= $rnum; $i++){ my $buf = sprintf("[%d]", int(rand($rnum)) + 1); if(int(rand(2)) == 0){ if(!$fdb->addint($buf, 1) && $fdb->ecode() != $fdb->EKEEP){ eprint($fdb, "addint"); $err = 1; last; } } else { if(!$fdb->adddouble($buf, 1) && $fdb->ecode() != $fdb->EKEEP){ eprint($fdb, "adddouble"); $err = 1; last; } } if($rnum > 250 && $i % ($rnum / 250) == 0){ print('.'); if($i == $rnum || $i % ($rnum / 10) == 0){ printf(" (%08d)\n", $i); } } } if(!$fdb->sync()){ eprint($fdb, "sync"); $err = 1; } if(!$fdb->optimize()){ eprint($fdb, "optimize"); $err = 1; } my $npath = $path . "-tmp"; if(!$fdb->copy($npath)){ eprint($fdb, "copy"); $err = 1; } unlink($npath); if(!$fdb->vanish()){ eprint($fdb, "vanish"); $err = 1; } printf("checking transaction commit:\n"); if(!$fdb->tranbegin()){ eprint($fdb, "tranbegin"); $err = 1; } for(my $i = 1; $i <= $rnum; $i++){ my $buf = sprintf("%d", int(rand($rnum)) + 1); if(int(rand(2)) == 0){ if(!$fdb->putcat($buf, $buf)){ eprint($fdb, "putcat"); $err = 1; last; } } else { if(!$fdb->out($buf) && $fdb->ecode() != $fdb->ENOREC){ eprint($fdb, "out"); $err = 1; last; } } if($rnum > 250 && $i % ($rnum / 250) == 0){ print('.'); if($i == $rnum || $i % ($rnum / 10) == 0){ printf(" (%08d)\n", $i); } } } if(!$fdb->trancommit()){ eprint($fdb, "trancommit"); $err = 1; } printf("checking transaction abort:\n"); my $ornum = $fdb->rnum(); my $ofsiz = $fdb->fsiz(); if(!$fdb->tranbegin()){ eprint($fdb, "tranbegin"); $err = 1; } for(my $i = 1; $i <= $rnum; $i++){ my $buf = sprintf("%d", int(rand($rnum)) + 1); if(int(rand(2)) == 0){ if(!$fdb->putcat($buf, $buf)){ eprint($fdb, "putcat"); $err = 1; last; } } else { if(!$fdb->out($buf) && $fdb->ecode() != $fdb->ENOREC){ eprint($fdb, "out"); $err = 1; last; } } if($rnum > 250 && $i % ($rnum / 250) == 0){ print('.'); if($i == $rnum || $i % ($rnum / 10) == 0){ printf(" (%08d)\n", $i); } } } if(!$fdb->tranabort()){ eprint($fdb, "tranabort"); $err = 1; } if($fdb->rnum() != $ornum || $fdb->fsiz() != $ofsiz){ eprint($fdb, "(validation)"); $err = 1; } printf("record number: %llu\n", $fdb->rnum()); printf("size: %llu\n", $fdb->fsiz()); if(!$fdb->close()){ eprint($fdb, "close"); $err = 1; } printf("checking tied updating:\n"); my %hash; if(!tie(%hash, "TokyoCabinet::FDB", $path, TokyoCabinet::FDB::OWRITER)){ eprint($fdb, "tie"); $err = 1; } for(my $i = 1; $i <= $rnum; $i++){ my $buf = sprintf("[%d]", int(rand($rnum))); my $rnd = int(rand(4)); if($rnd == 0){ $hash{$buf} = $buf; } elsif($rnd == 1){ my $value = $hash{$buf}; } elsif($rnd == 2){ my $res = exists($hash{$buf}); } elsif($rnd == 3){ delete($hash{$buf}); } if($rnum > 250 && $i % ($rnum / 250) == 0){ print('.'); if($i == $rnum || $i % ($rnum / 10) == 0){ printf(" (%08d)\n", $i); } } } printf("checking tied iterator:\n"); $inum = 0; while(my ($key, $value) = each(%hash)){ $inum++; if($rnum > 250 && $inum % ($rnum / 250) == 0){ print('.'); if($inum == $rnum || $inum % ($rnum / 10) == 0){ printf(" (%08d)\n", $inum); } } } printf(" (%08d)\n", $inum) if($rnum > 250); %hash = (); untie(%hash); printf("time: %.3f\n", gettimeofday() - $stime); printf("version: %s\n", TokyoCabinet::VERSION); printf("%s\n\n", $err ? "error" : "ok"); return $err ? 1 : 0; } # execute main $| = 1; $0 =~ s/.*\///; exit(main()); # END OF FILE tokyocabinet-perl-1.34/tchtest.pl0000644000175000017500000004317711420766742016136 0ustar mikiomikio#! /usr/bin/perl -w #------------------------------------------------------------------------------------------------- # The test cases of the hash database API # Copyright (C) 2006-2010 FAL Labs # This file is part of Tokyo Cabinet. # Tokyo Cabinet is free software; you can redistribute it and/or modify it under the terms of # the GNU Lesser General Public License as published by the Free Software Foundation; either # version 2.1 of the License or any later version. Tokyo Cabinet is distributed in the hope # that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public # License for more details. # You should have received a copy of the GNU Lesser General Public License along with Tokyo # Cabinet; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, # Boston, MA 02111-1307 USA. #------------------------------------------------------------------------------------------------- use lib qw(./blib/lib ./blib/arch); use strict; use warnings; use ExtUtils::testlib; use Time::HiRes qw(gettimeofday); use Data::Dumper; use TokyoCabinet; $TokyoCabinet::DEBUG = 1; # main routine sub main { my $rv; scalar(@ARGV) >= 1 || usage(); if($ARGV[0] eq "write"){ $rv = runwrite(); } elsif($ARGV[0] eq "read"){ $rv = runread(); } elsif($ARGV[0] eq "remove"){ $rv = runremove(); } elsif($ARGV[0] eq "misc"){ $rv = runmisc(); } else { usage(); } return $rv; } # print the usage and exit sub usage { printf STDERR ("$0: test cases of the hash database API\n"); printf STDERR ("\n"); printf STDERR ("usage:\n"); printf STDERR (" $0 write [-tl] [-td|-tb|-tt] [-nl|-nb] [-as] path rnum" . " [bnum [apow [fpow]]]\n"); printf STDERR (" $0 read [-nl|-nb] path\n"); printf STDERR (" $0 remove [-nl|-nb] path\n"); printf STDERR (" $0 misc [-tl] [-td|-tb|-tt] [-nl|-nb] path rnum\n"); printf STDERR ("\n"); exit(1); } # parse arguments of write command sub runwrite { my $path = undef; my $rnum = undef; my $bnum = undef; my $apow = undef; my $fpow = undef; my $opts = 0; my $omode = 0; my $as = 0; for(my $i = 1; $i < scalar(@ARGV); $i++){ if(!defined($path) && $ARGV[$i] =~ /^-/){ if($ARGV[$i] eq "-tl"){ $opts |= TokyoCabinet::HDB::TLARGE; } elsif($ARGV[$i] eq "-td"){ $opts |= TokyoCabinet::HDB::TDEFLATE; } elsif($ARGV[$i] eq "-tb"){ $opts |= TokyoCabinet::HDB::TBZIP; } elsif($ARGV[$i] eq "-tt"){ $opts |= TokyoCabinet::HDB::TTCBS; } elsif($ARGV[$i] eq "-nl"){ $omode |= TokyoCabinet::HDB::ONOLCK; } elsif($ARGV[$i] eq "-nb"){ $omode |= TokyoCabinet::HDB::OLCKNB; } elsif($ARGV[$i] eq "-as"){ $as = 1; } else { usage(); } } elsif(!defined($path)){ $path = $ARGV[$i]; } elsif(!defined($rnum)){ $rnum = TokyoCabinet::atoi($ARGV[$i]); } elsif(!defined($bnum)){ $bnum = TokyoCabinet::atoi($ARGV[$i]); } elsif(!defined($apow)){ $apow = TokyoCabinet::atoi($ARGV[$i]); } elsif(!defined($fpow)){ $fpow = TokyoCabinet::atoi($ARGV[$i]); } else { usage(); } } usage() if(!defined($path) || !defined($rnum) || $rnum < 1); $bnum = defined($bnum) ? $bnum : -1; $apow = defined($apow) ? $apow : -1; $fpow = defined($fpow) ? $fpow : -1; my $rv = procwrite($path, $rnum, $bnum, $apow, $fpow, $opts, $omode, $as); return $rv; } # parse arguments of read command sub runread { my $path = undef; my $omode = 0; for(my $i = 1; $i < scalar(@ARGV); $i++){ if(!defined($path) && $ARGV[$i] =~ /^-/){ if($ARGV[$i] eq "-nl"){ $omode |= TokyoCabinet::HDB::ONOLCK; } elsif($ARGV[$i] eq "-nb"){ $omode |= TokyoCabinet::HDB::OLCKNB; } else { usage(); } } elsif(!defined($path)){ $path = $ARGV[$i]; } else { usage(); } } usage() if(!defined($path)); my $rv = procread($path, $omode); return $rv; } # parse arguments of remove command sub runremove { my $path = undef; my $omode = 0; for(my $i = 1; $i < scalar(@ARGV); $i++){ if(!defined($path) && $ARGV[$i] =~ /^-/){ if($ARGV[$i] eq "-nl"){ $omode |= TokyoCabinet::HDB::ONOLCK; } elsif($ARGV[$i] eq "-nb"){ $omode |= TokyoCabinet::HDB::OLCKNB; } else { usage(); } } elsif(!defined($path)){ $path = $ARGV[$i]; } else { usage(); } } usage() if(!defined($path)); my $rv = procremove($path, $omode); return $rv; } # parse arguments of misc command sub runmisc { my $path = undef; my $rnum = undef; my $opts = 0; my $omode = 0; for(my $i = 1; $i < scalar(@ARGV); $i++){ if(!defined($path) && $ARGV[$i] =~ /^-/){ if($ARGV[$i] eq "-tl"){ $opts |= TokyoCabinet::HDB::TLARGE; } elsif($ARGV[$i] eq "-td"){ $opts |= TokyoCabinet::HDB::TDEFLATE; } elsif($ARGV[$i] eq "-tb"){ $opts |= TokyoCabinet::HDB::TBZIP; } elsif($ARGV[$i] eq "-tt"){ $opts |= TokyoCabinet::HDB::TTCBS; } elsif($ARGV[$i] eq "-nl"){ $omode |= TokyoCabinet::HDB::ONOLCK; } elsif($ARGV[$i] eq "-nb"){ $omode |= TokyoCabinet::HDB::OLCKNB; } else { usage(); } } elsif(!defined($path)){ $path = $ARGV[$i]; } elsif(!defined($rnum)){ $rnum = TokyoCabinet::atoi($ARGV[$i]); } else { usage(); } } usage() if(!defined($path) || !defined($rnum) || $rnum < 1); my $rv = procmisc($path, $rnum, $opts, $omode); return $rv; } # print error message of hash database sub eprint { my $hdb = shift; my $func = shift; my $path = $hdb->path(); printf STDERR ("%s: %s: %s: %s\n", $0, defined($path) ? $path : "-", $func, $hdb->errmsg()); } # perform write command sub procwrite { my $path = shift; my $rnum = shift; my $bnum = shift; my $apow = shift; my $fpow = shift; my $opts = shift; my $omode = shift; my $as = shift; printf("\n path=%s rnum=%d bnum=%d apow=%d fpow=%d opts=%d" . " omode=%d as=%d\n\n", $path, $rnum, $bnum, $apow, $fpow, $opts, $omode, $as); my $err = 0; my $stime = gettimeofday(); my $hdb = TokyoCabinet::HDB->new(); if(!$hdb->tune($bnum, $apow, $fpow, $opts)){ eprint($hdb, "tune"); $err = 1; } if(!$hdb->open($path, $hdb->OWRITER | $hdb->OCREAT | $hdb->OTRUNC | $omode)){ eprint($hdb, "open"); $err = 1; } for(my $i = 1; $i <= $rnum; $i++){ my $buf = sprintf("%08d", $i); if($as){ if(!$hdb->putasync($buf, $buf)){ eprint($hdb, "putasync"); $err = 1; last; } } else { if(!$hdb->put($buf, $buf)){ eprint($hdb, "put"); $err = 1; last; } } if($rnum > 250 && $i % ($rnum / 250) == 0){ print('.'); if($i == $rnum || $i % ($rnum / 10) == 0){ printf(" (%08d)\n", $i); } } } printf("record number: %llu\n", $hdb->rnum()); printf("size: %llu\n", $hdb->fsiz()); if(!$hdb->close()){ eprint($hdb, "close"); $err = 1; } printf("time: %.3f\n", gettimeofday() - $stime); printf("%s\n\n", $err ? "error" : "ok"); return $err ? 1 : 0; } # perform read command sub procread { my $path = shift; my $omode = shift; printf("\n path=%s omode=%d\n\n", $path, $omode); my $err = 0; my $stime = gettimeofday(); my $hdb = TokyoCabinet::HDB->new(); if(!$hdb->open($path, $hdb->OREADER | $omode)){ eprint($hdb, "open"); $err = 1; } my $rnum = $hdb->rnum(); for(my $i = 1; $i <= $rnum; $i++){ my $buf = sprintf("%08d", $i); if(!$hdb->get($buf)){ eprint($hdb, "get"); $err = 1; last; } if($rnum > 250 && $i % ($rnum / 250) == 0){ print('.'); if($i == $rnum || $i % ($rnum / 10) == 0){ printf(" (%08d)\n", $i); } } } printf("record number: %llu\n", $hdb->rnum()); printf("size: %llu\n", $hdb->fsiz()); if(!$hdb->close()){ eprint($hdb, "close"); $err = 1; } printf("time: %.3f\n", gettimeofday() - $stime); printf("%s\n\n", $err ? "error" : "ok"); return $err ? 1 : 0; } # perform remove command sub procremove { my $path = shift; my $omode = shift; printf("\n path=%s omode=%d\n\n", $path, $omode); my $err = 0; my $stime = gettimeofday(); my $hdb = TokyoCabinet::HDB->new(); if(!$hdb->open($path, $hdb->OWRITER | $omode)){ eprint($hdb, "open"); $err = 1; } my $rnum = $hdb->rnum(); for(my $i = 1; $i <= $rnum; $i++){ my $buf = sprintf("%08d", $i); if(!$hdb->out($buf)){ eprint($hdb, "out"); $err = 1; last; } if($rnum > 250 && $i % ($rnum / 250) == 0){ print('.'); if($i == $rnum || $i % ($rnum / 10) == 0){ printf(" (%08d)\n", $i); } } } printf("record number: %llu\n", $hdb->rnum()); printf("size: %llu\n", $hdb->fsiz()); if(!$hdb->close()){ eprint($hdb, "close"); $err = 1; } printf("time: %.3f\n", gettimeofday() - $stime); printf("%s\n\n", $err ? "error" : "ok"); return $err ? 1 : 0; } # perform misc command sub procmisc { my $path = shift; my $rnum = shift; my $opts = shift; my $omode = shift; printf("\n path=%s rnum=%d opts=%d omode=%d\n\n", $path, $rnum, $opts, $omode); my $err = 0; my $stime = gettimeofday(); my $hdb = TokyoCabinet::HDB->new(); if(!$hdb->tune($rnum / 50, 2, -1, $opts)){ eprint($hdb, "tune"); $err = 1; } if(!$hdb->setcache($rnum / 10)){ eprint($hdb, "setcache"); $err = 1; } if(!$hdb->setxmsiz($rnum * 4)){ eprint($hdb, "setxmsiz"); $err = 1; } if(!$hdb->setdfunit(8)){ eprint($hdb, "setdfunit"); $err = 1; } if(!$hdb->open($path, $hdb->OWRITER | $hdb->OCREAT | $hdb->OTRUNC | $omode)){ eprint($hdb, "open"); $err = 1; } printf("writing:\n"); for(my $i = 1; $i <= $rnum; $i++){ my $buf = sprintf("%08d", $i); if(!$hdb->put($buf, $buf)){ eprint($hdb, "put"); $err = 1; last; } if($rnum > 250 && $i % ($rnum / 250) == 0){ print('.'); if($i == $rnum || $i % ($rnum / 10) == 0){ printf(" (%08d)\n", $i); } } } printf("reading:\n"); for(my $i = 1; $i <= $rnum; $i++){ my $buf = sprintf("%08d", $i); if(!$hdb->get($buf)){ eprint($hdb, "get"); $err = 1; last; } if($rnum > 250 && $i % ($rnum / 250) == 0){ print('.'); if($i == $rnum || $i % ($rnum / 10) == 0){ printf(" (%08d)\n", $i); } } } printf("removing:\n"); for(my $i = 1; $i <= $rnum; $i++){ my $buf = sprintf("%08d", $i); if(int(rand(2)) == 0 && !$hdb->out($buf)){ eprint($hdb, "out"); $err = 1; last; } if($rnum > 250 && $i % ($rnum / 250) == 0){ print('.'); if($i == $rnum || $i % ($rnum / 10) == 0){ printf(" (%08d)\n", $i); } } } printf("checking iterator:\n"); if(!$hdb->iterinit()){ eprint($hdb, "iterinit"); $err = 1; } my $inum = 0; while(defined(my $key = $hdb->iternext())){ $inum++; my $value = $hdb->get($key); if(!defined($value)){ eprint($hdb, "get"); $err = 1; } if($rnum > 250 && $inum % ($rnum / 250) == 0){ print('.'); if($inum == $rnum || $inum % ($rnum / 10) == 0){ printf(" (%08d)\n", $inum); } } } printf(" (%08d)\n", $inum) if($rnum > 250); if($hdb->ecode() != $hdb->ENOREC || $inum != $hdb->rnum()){ eprint($hdb, "(validation)"); $err = 1; } my $keys = $hdb->fwmkeys("0", 10); if($hdb->rnum() >= 10 && scalar(@$keys) != 10){ eprint($hdb, "fwmkeys"); $err = 1; } printf("checking counting:\n"); for(my $i = 1; $i <= $rnum; $i++){ my $buf = sprintf("[%d]", int(rand($rnum))); if(int(rand(2)) == 0){ if(!$hdb->addint($buf, 1) && $hdb->ecode() != $hdb->EKEEP){ eprint($hdb, "addint"); $err = 1; last; } } else { if(!$hdb->adddouble($buf, 1) && $hdb->ecode() != $hdb->EKEEP){ eprint($hdb, "adddouble"); $err = 1; last; } } if($rnum > 250 && $i % ($rnum / 250) == 0){ print('.'); if($i == $rnum || $i % ($rnum / 10) == 0){ printf(" (%08d)\n", $i); } } } if(!$hdb->sync()){ eprint($hdb, "sync"); $err = 1; } if(!$hdb->optimize()){ eprint($hdb, "optimize"); $err = 1; } my $npath = $path . "-tmp"; if(!$hdb->copy($npath)){ eprint($hdb, "copy"); $err = 1; } unlink($npath); if(!$hdb->vanish()){ eprint($hdb, "vanish"); $err = 1; } printf("checking transaction commit:\n"); if(!$hdb->tranbegin()){ eprint($hdb, "tranbegin"); $err = 1; } for(my $i = 1; $i <= $rnum; $i++){ my $buf = sprintf("%d", int(rand($rnum))); if(int(rand(2)) == 0){ if(!$hdb->putcat($buf, $buf)){ eprint($hdb, "putcat"); $err = 1; last; } } else { if(!$hdb->out($buf) && $hdb->ecode() != $hdb->ENOREC){ eprint($hdb, "out"); $err = 1; last; } } if($rnum > 250 && $i % ($rnum / 250) == 0){ print('.'); if($i == $rnum || $i % ($rnum / 10) == 0){ printf(" (%08d)\n", $i); } } } if(!$hdb->trancommit()){ eprint($hdb, "trancommit"); $err = 1; } printf("checking transaction abort:\n"); my $ornum = $hdb->rnum(); my $ofsiz = $hdb->fsiz(); if(!$hdb->tranbegin()){ eprint($hdb, "tranbegin"); $err = 1; } for(my $i = 1; $i <= $rnum; $i++){ my $buf = sprintf("%d", int(rand($rnum))); if(int(rand(2)) == 0){ if(!$hdb->putcat($buf, $buf)){ eprint($hdb, "putcat"); $err = 1; last; } } else { if(!$hdb->out($buf) && $hdb->ecode() != $hdb->ENOREC){ eprint($hdb, "out"); $err = 1; last; } } if($rnum > 250 && $i % ($rnum / 250) == 0){ print('.'); if($i == $rnum || $i % ($rnum / 10) == 0){ printf(" (%08d)\n", $i); } } } if(!$hdb->tranabort()){ eprint($hdb, "tranabort"); $err = 1; } if($hdb->rnum() != $ornum || $hdb->fsiz() != $ofsiz){ eprint($hdb, "(validation)"); $err = 1; } printf("record number: %llu\n", $hdb->rnum()); printf("size: %llu\n", $hdb->fsiz()); if(!$hdb->close()){ eprint($hdb, "close"); $err = 1; } printf("checking tied updating:\n"); my %hash; if(!tie(%hash, "TokyoCabinet::HDB", $path, TokyoCabinet::HDB::OWRITER)){ eprint($hdb, "tie"); $err = 1; } for(my $i = 1; $i <= $rnum; $i++){ my $buf = sprintf("[%d]", int(rand($rnum))); my $rnd = int(rand(4)); if($rnd == 0){ $hash{$buf} = $buf; } elsif($rnd == 1){ my $value = $hash{$buf}; } elsif($rnd == 2){ my $res = exists($hash{$buf}); } elsif($rnd == 3){ delete($hash{$buf}); } if($rnum > 250 && $i % ($rnum / 250) == 0){ print('.'); if($i == $rnum || $i % ($rnum / 10) == 0){ printf(" (%08d)\n", $i); } } } printf("checking tied iterator:\n"); $inum = 0; while(my ($key, $value) = each(%hash)){ $inum++; if($rnum > 250 && $inum % ($rnum / 250) == 0){ print('.'); if($inum == $rnum || $inum % ($rnum / 10) == 0){ printf(" (%08d)\n", $inum); } } } printf(" (%08d)\n", $inum) if($rnum > 250); %hash = (); untie(%hash); printf("time: %.3f\n", gettimeofday() - $stime); printf("version: %s\n", TokyoCabinet::VERSION); printf("%s\n\n", $err ? "error" : "ok"); return $err ? 1 : 0; } # execute main $| = 1; $0 =~ s/.*\///; exit(main()); # END OF FILE tokyocabinet-perl-1.34/makedoc.sh0000755000175000017500000000142311420766766016057 0ustar mikiomikio#! /bin/sh LANG=C LC_ALL=C PATH="$PATH:/usr/local/bin:$HOME/bin:.:.." export LANG LC_ALL PATH rm -rf doc mkdir doc pod2html --title "Tokyo Cabinet" TokyoCabinet.pod | sed \ -e 's/^\t
    /\t
    • /' \ -e 's/^\t<\/ul>/\t<\/ul><\/li>/' \ -e 's/^

      /

      /' \ -e 's/^ /
      /g' \ -e 's/mailto:root@localhost/mailto:info@fallabs.com/' \ -e 's/ *style="[^"]*"//' \ -e '/<\/head>/ i' \ -e '/<\/head>/ i' \ > doc/index.html tokyocabinet-perl-1.34/tcatest.pl0000644000175000017500000003402711420766752016122 0ustar mikiomikio#! /usr/bin/perl -w #------------------------------------------------------------------------------------------------- # The test cases of the abstract database API # Copyright (C) 2006-2010 FAL Labs # This file is part of Tokyo Cabinet. # Tokyo Cabinet is free software; you can redistribute it and/or modify it under the terms of # the GNU Lesser General Public License as published by the Free Software Foundation; either # version 2.1 of the License or any later version. Tokyo Cabinet is distributed in the hope # that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public # License for more details. # You should have received a copy of the GNU Lesser General Public License along with Tokyo # Cabinet; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, # Boston, MA 02111-1307 USA. #------------------------------------------------------------------------------------------------- use lib qw(./blib/lib ./blib/arch); use strict; use warnings; use ExtUtils::testlib; use Time::HiRes qw(gettimeofday); use Data::Dumper; use TokyoCabinet; $TokyoCabinet::DEBUG = 1; # main routine sub main { my $rv; scalar(@ARGV) >= 1 || usage(); if($ARGV[0] eq "write"){ $rv = runwrite(); } elsif($ARGV[0] eq "read"){ $rv = runread(); } elsif($ARGV[0] eq "remove"){ $rv = runremove(); } elsif($ARGV[0] eq "misc"){ $rv = runmisc(); } else { usage(); } return $rv; } # print the usage and exit sub usage { printf STDERR ("$0: test cases of the abstract database API\n"); printf STDERR ("\n"); printf STDERR ("usage:\n"); printf STDERR (" $0 write name rnum\n"); printf STDERR (" $0 read name\n"); printf STDERR (" $0 remove name\n"); printf STDERR (" $0 misc name rnum\n"); printf STDERR ("\n"); exit(1); } # parse arguments of write command sub runwrite { my $name = undef; my $rnum = undef; for(my $i = 1; $i < scalar(@ARGV); $i++){ if(!defined($name) && $ARGV[$i] =~ /^-/){ usage(); } elsif(!defined($name)){ $name = $ARGV[$i]; } elsif(!defined($rnum)){ $rnum = TokyoCabinet::atoi($ARGV[$i]); } else { usage(); } } usage() if(!defined($name) || !defined($rnum) || $rnum < 1); my $rv = procwrite($name, $rnum); return $rv; } # parse arguments of read command sub runread { my $name = undef; for(my $i = 1; $i < scalar(@ARGV); $i++){ if(!defined($name) && $ARGV[$i] =~ /^-/){ usage(); } elsif(!defined($name)){ $name = $ARGV[$i]; } else { usage(); } } usage() if(!defined($name)); my $rv = procread($name); return $rv; } # parse arguments of remove command sub runremove { my $name = undef; for(my $i = 1; $i < scalar(@ARGV); $i++){ if(!defined($name) && $ARGV[$i] =~ /^-/){ usage(); } elsif(!defined($name)){ $name = $ARGV[$i]; } else { usage(); } } usage() if(!defined($name)); my $rv = procremove($name); return $rv; } # parse arguments of misc command sub runmisc { my $name = undef; my $rnum = undef; for(my $i = 1; $i < scalar(@ARGV); $i++){ if(!defined($name) && $ARGV[$i] =~ /^-/){ usage(); } elsif(!defined($name)){ $name = $ARGV[$i]; } elsif(!defined($rnum)){ $rnum = TokyoCabinet::atoi($ARGV[$i]); } else { usage(); } } usage() if(!defined($name) || !defined($rnum) || $rnum < 1); my $rv = procmisc($name, $rnum); return $rv; } # print error message of abstract database sub eprint { my $adb = shift; my $func = shift; my $path = $adb->path(); printf STDERR ("%s: %s: %s: error\n", $0, defined($path) ? $path : "-", $func); } # perform write command sub procwrite { my $name = shift; my $rnum = shift; printf("\n name=%s rnum=%d\n\n", $name, $rnum); my $err = 0; my $stime = gettimeofday(); my $adb = TokyoCabinet::ADB->new(); if(!$adb->open($name)){ eprint($adb, "open"); $err = 1; } for(my $i = 1; $i <= $rnum; $i++){ my $buf = sprintf("%08d", $i); if(!$adb->put($buf, $buf)){ eprint($adb, "put"); $err = 1; last; } if($rnum > 250 && $i % ($rnum / 250) == 0){ print('.'); if($i == $rnum || $i % ($rnum / 10) == 0){ printf(" (%08d)\n", $i); } } } printf("record number: %llu\n", $adb->rnum()); printf("size: %llu\n", $adb->size()); if(!$adb->close()){ eprint($adb, "close"); $err = 1; } printf("time: %.3f\n", gettimeofday() - $stime); printf("%s\n\n", $err ? "error" : "ok"); return $err ? 1 : 0; } # perform read command sub procread { my $name = shift; printf("\n name=%s\n\n", $name); my $err = 0; my $stime = gettimeofday(); my $adb = TokyoCabinet::ADB->new(); if(!$adb->open($name)){ eprint($adb, "open"); $err = 1; } my $rnum = $adb->rnum(); for(my $i = 1; $i <= $rnum; $i++){ my $buf = sprintf("%08d", $i); if(!$adb->get($buf)){ eprint($adb, "get"); $err = 1; last; } if($rnum > 250 && $i % ($rnum / 250) == 0){ print('.'); if($i == $rnum || $i % ($rnum / 10) == 0){ printf(" (%08d)\n", $i); } } } printf("record number: %llu\n", $adb->rnum()); printf("size: %llu\n", $adb->size()); if(!$adb->close()){ eprint($adb, "close"); $err = 1; } printf("time: %.3f\n", gettimeofday() - $stime); printf("%s\n\n", $err ? "error" : "ok"); return $err ? 1 : 0; } # perform remove command sub procremove { my $name = shift; my $omode = shift; printf("\n name=%s\n\n", $name); my $err = 0; my $stime = gettimeofday(); my $adb = TokyoCabinet::ADB->new(); if(!$adb->open($name)){ eprint($adb, "open"); $err = 1; } my $rnum = $adb->rnum(); for(my $i = 1; $i <= $rnum; $i++){ my $buf = sprintf("%08d", $i); if(!$adb->out($buf)){ eprint($adb, "out"); $err = 1; last; } if($rnum > 250 && $i % ($rnum / 250) == 0){ print('.'); if($i == $rnum || $i % ($rnum / 10) == 0){ printf(" (%08d)\n", $i); } } } printf("record number: %llu\n", $adb->rnum()); printf("size: %llu\n", $adb->size()); if(!$adb->close()){ eprint($adb, "close"); $err = 1; } printf("time: %.3f\n", gettimeofday() - $stime); printf("%s\n\n", $err ? "error" : "ok"); return $err ? 1 : 0; } # perform misc command sub procmisc { my $name = shift; my $rnum = shift; printf("\n name=%s rnum=%d\n\n", $name, $rnum); my $err = 0; my $stime = gettimeofday(); my $adb = TokyoCabinet::ADB->new(); if(!$adb->open($name)){ eprint($adb, "open"); $err = 1; } printf("writing:\n"); for(my $i = 1; $i <= $rnum; $i++){ my $buf = sprintf("%08d", $i); if(!$adb->put($buf, $buf)){ eprint($adb, "put"); $err = 1; last; } if($rnum > 250 && $i % ($rnum / 250) == 0){ print('.'); if($i == $rnum || $i % ($rnum / 10) == 0){ printf(" (%08d)\n", $i); } } } printf("reading:\n"); for(my $i = 1; $i <= $rnum; $i++){ my $buf = sprintf("%08d", $i); if(!$adb->get($buf)){ eprint($adb, "get"); $err = 1; last; } if($rnum > 250 && $i % ($rnum / 250) == 0){ print('.'); if($i == $rnum || $i % ($rnum / 10) == 0){ printf(" (%08d)\n", $i); } } } printf("removing:\n"); for(my $i = 1; $i <= $rnum; $i++){ my $buf = sprintf("%08d", $i); if(int(rand(2)) == 0 && !$adb->out($buf)){ eprint($adb, "out"); $err = 1; last; } if($rnum > 250 && $i % ($rnum / 250) == 0){ print('.'); if($i == $rnum || $i % ($rnum / 10) == 0){ printf(" (%08d)\n", $i); } } } printf("checking iterator:\n"); if(!$adb->iterinit()){ eprint($adb, "iterinit"); $err = 1; } my $inum = 0; while(defined(my $key = $adb->iternext())){ $inum++; my $value = $adb->get($key); if(!defined($value)){ eprint($adb, "get"); $err = 1; } if($rnum > 250 && $inum % ($rnum / 250) == 0){ print('.'); if($inum == $rnum || $inum % ($rnum / 10) == 0){ printf(" (%08d)\n", $inum); } } } printf(" (%08d)\n", $inum) if($rnum > 250); if($inum != $adb->rnum()){ eprint($adb, "(validation)"); $err = 1; } my $keys = $adb->fwmkeys("0", 10); if($adb->rnum() >= 10 && scalar(@$keys) != 10){ eprint($adb, "fwmkeys"); $err = 1; } printf("checking counting:\n"); for(my $i = 1; $i <= $rnum; $i++){ my $buf = sprintf("[%d]", int(rand($rnum))); if(int(rand(2)) == 0){ $adb->addint($buf, 1); } else { $adb->adddouble($buf, 1); } if($rnum > 250 && $i % ($rnum / 250) == 0){ print('.'); if($i == $rnum || $i % ($rnum / 10) == 0){ printf(" (%08d)\n", $i); } } } printf("checking versatile functions:\n"); for(my $i = 1; $i <= $rnum; $i++){ my $rnd = int(rand(3)); my $name; if($rnd == 0){ $name = "putlist"; } elsif($rnd == 1){ $name = "outlist"; } else { $name = "getlist"; } if(!defined($adb->misc($name, [int(rand($rnum)), int(rand($rnum))]))){ eprint($adb, "misc"); $err = 1; } if($rnum > 250 && $i % ($rnum / 250) == 0){ print('.'); if($i == $rnum || $i % ($rnum / 10) == 0){ printf(" (%08d)\n", $i); } } } if(!$adb->sync()){ eprint($adb, "sync"); $err = 1; } if(!$adb->optimize()){ eprint($adb, "optimize"); $err = 1; } my $npath = $adb->path() . "-tmp"; if(!$adb->copy($npath)){ eprint($adb, "copy"); $err = 1; } unlink($npath); if(!$adb->vanish()){ eprint($adb, "vanish"); $err = 1; } printf("checking transaction commit:\n"); if(!$adb->tranbegin()){ eprint($adb, "tranbegin"); $err = 1; } for(my $i = 1; $i <= $rnum; $i++){ my $buf = sprintf("%d", int(rand($rnum))); if(int(rand(2)) == 0){ if(!$adb->putcat($buf, $buf)){ eprint($adb, "putcat"); $err = 1; last; } } else { $adb->out($buf); } if($rnum > 250 && $i % ($rnum / 250) == 0){ print('.'); if($i == $rnum || $i % ($rnum / 10) == 0){ printf(" (%08d)\n", $i); } } } if(!$adb->trancommit()){ eprint($adb, "trancommit"); $err = 1; } printf("checking transaction abort:\n"); my $ornum = $adb->rnum(); my $ofsiz = $adb->size(); if(!$adb->tranbegin()){ eprint($adb, "tranbegin"); $err = 1; } for(my $i = 1; $i <= $rnum; $i++){ my $buf = sprintf("%d", int(rand($rnum))); if(int(rand(2)) == 0){ if(!$adb->putcat($buf, $buf)){ eprint($adb, "putcat"); $err = 1; last; } } else { $adb->out($buf); } if($rnum > 250 && $i % ($rnum / 250) == 0){ print('.'); if($i == $rnum || $i % ($rnum / 10) == 0){ printf(" (%08d)\n", $i); } } } if(!$adb->tranabort()){ eprint($adb, "tranabort"); $err = 1; } if($adb->rnum() != $ornum || $adb->size() != $ofsiz){ eprint($adb, "(validation)"); $err = 1; } printf("record number: %llu\n", $adb->rnum()); printf("size: %llu\n", $adb->size()); if(!$adb->close()){ eprint($adb, "close"); $err = 1; } printf("checking tied updating:\n"); my %hash; if(!tie(%hash, "TokyoCabinet::ADB", $name)){ eprint($adb, "tie"); $err = 1; } for(my $i = 1; $i <= $rnum; $i++){ my $buf = sprintf("[%d]", int(rand($rnum))); my $rnd = int(rand(4)); if($rnd == 0){ $hash{$buf} = $buf; } elsif($rnd == 1){ my $value = $hash{$buf}; } elsif($rnd == 2){ my $res = exists($hash{$buf}); } elsif($rnd == 3){ delete($hash{$buf}); } if($rnum > 250 && $i % ($rnum / 250) == 0){ print('.'); if($i == $rnum || $i % ($rnum / 10) == 0){ printf(" (%08d)\n", $i); } } } printf("checking tied iterator:\n"); $inum = 0; while(my ($key, $value) = each(%hash)){ $inum++; if($rnum > 250 && $inum % ($rnum / 250) == 0){ print('.'); if($inum == $rnum || $inum % ($rnum / 10) == 0){ printf(" (%08d)\n", $inum); } } } printf(" (%08d)\n", $inum) if($rnum > 250); %hash = (); untie(%hash); printf("time: %.3f\n", gettimeofday() - $stime); printf("version: %s\n", TokyoCabinet::VERSION); printf("%s\n\n", $err ? "error" : "ok"); return $err ? 1 : 0; } # execute main $| = 1; $0 =~ s/.*\///; exit(main()); # END OF FILE tokyocabinet-perl-1.34/test.pl0000644000175000017500000000364511420766705015432 0ustar mikiomikio#! /usr/bin/perl use lib qw(./blib/lib ./blib/arch); use strict; use warnings; use Test::More qw(no_plan); use TokyoCabinet; $TokyoCabinet::DEBUG = 1; my @commands = ( "tchtest.pl write casket 10000", "tchtest.pl read casket", "tchtest.pl remove casket", "tchtest.pl misc casket 1000", "tchtest.pl write -tl -as -td casket 10000 10000 1 1", "tchtest.pl read -nl casket", "tchtest.pl remove -nb casket", "tchtest.pl misc -tl -tb casket 1000", "tcbtest.pl write casket 10000", "tcbtest.pl read casket", "tcbtest.pl remove casket", "tcbtest.pl misc casket 1000", "tcbtest.pl write -tl casket 10000 10 10 100 1 1", "tcbtest.pl read -nl casket", "tcbtest.pl remove -nb casket", "tcbtest.pl misc -tl -tb casket 1000", "tcftest.pl write casket 10000", "tcftest.pl read casket", "tcftest.pl remove casket", "tcftest.pl misc casket 1000", "tcttest.pl write -ip -is -in casket 1000", "tcttest.pl read casket", "tcttest.pl remove casket", "tcttest.pl misc casket 500", "tcttest.pl write -tl -is -td casket 1000 1000 1 1", "tcttest.pl read -nl casket", "tcttest.pl remove -nb casket", "tcttest.pl misc -tl -tb casket 500", "tcatest.pl write 'casket.tch#mode=wct' 10000", "tcatest.pl read 'casket.tch#mode=r'", "tcatest.pl remove 'casket.tch#mode=w'", "tcatest.pl misc 'casket.tch#mode=wct' 1000", ); foreach my $command (@commands){ my $rv = system("$^X $command >/dev/null"); ok($rv == 0, $command); } system("rm -rf casket*"); tokyocabinet-perl-1.34/tcttest.pl0000644000175000017500000005742511420766737016157 0ustar mikiomikio#! /usr/bin/perl -w #------------------------------------------------------------------------------------------------- # The test cases of the table database API # Copyright (C) 2006-2010 FAL Labs # This file is part of Tokyo Cabinet. # Tokyo Cabinet is free software; you can redistribute it and/or modify it under the terms of # the GNU Lesser General Public License as published by the Free Software Foundation; either # version 2.1 of the License or any later version. Tokyo Cabinet is distributed in the hope # that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public # License for more details. # You should have received a copy of the GNU Lesser General Public License along with Tokyo # Cabinet; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, # Boston, MA 02111-1307 USA. #------------------------------------------------------------------------------------------------- use lib qw(./blib/lib ./blib/arch); use strict; use warnings; use ExtUtils::testlib; use Time::HiRes qw(gettimeofday); use Data::Dumper; use TokyoCabinet; $TokyoCabinet::DEBUG = 1; # main routine sub main { my $rv; scalar(@ARGV) >= 1 || usage(); if($ARGV[0] eq "write"){ $rv = runwrite(); } elsif($ARGV[0] eq "read"){ $rv = runread(); } elsif($ARGV[0] eq "remove"){ $rv = runremove(); } elsif($ARGV[0] eq "misc"){ $rv = runmisc(); } else { usage(); } return $rv; } # print the usage and exit sub usage { printf STDERR ("$0: test cases of the table database API\n"); printf STDERR ("\n"); printf STDERR ("usage:\n"); printf STDERR (" $0 write [-tl] [-td|-tb|-tt] [-ip|-is|-in|-it|-if|-ix] [-nl|-nb] path rnum" . " [bnum [apow [fpow]]]\n"); printf STDERR (" $0 read [-nl|-nb] path\n"); printf STDERR (" $0 remove [-nl|-nb] path\n"); printf STDERR (" $0 misc [-tl] [-td|-tb|-tt] [-nl|-nb] path rnum\n"); printf STDERR ("\n"); exit(1); } # parse arguments of write command sub runwrite { my $path = undef; my $rnum = undef; my $bnum = undef; my $apow = undef; my $fpow = undef; my $opts = 0; my $iflags = 0; my $omode = 0; for(my $i = 1; $i < scalar(@ARGV); $i++){ if(!defined($path) && $ARGV[$i] =~ /^-/){ if($ARGV[$i] eq "-tl"){ $opts |= TokyoCabinet::TDB::TLARGE; } elsif($ARGV[$i] eq "-td"){ $opts |= TokyoCabinet::TDB::TDEFLATE; } elsif($ARGV[$i] eq "-tb"){ $opts |= TokyoCabinet::TDB::TBZIP; } elsif($ARGV[$i] eq "-tt"){ $opts |= TokyoCabinet::TDB::TTCBS; } elsif($ARGV[$i] eq "-ip"){ $iflags |= 1 << 0; } elsif($ARGV[$i] eq "-is"){ $iflags |= 1 << 1; } elsif($ARGV[$i] eq "-in"){ $iflags |= 1 << 2; } elsif($ARGV[$i] eq "-it"){ $iflags |= 1 << 3; } elsif($ARGV[$i] eq "-if"){ $iflags |= 1 << 4; } elsif($ARGV[$i] eq "-ix"){ $iflags |= 1 << 5; } elsif($ARGV[$i] eq "-nl"){ $omode |= TokyoCabinet::TDB::ONOLCK; } elsif($ARGV[$i] eq "-nb"){ $omode |= TokyoCabinet::TDB::OLCKNB; } else { usage(); } } elsif(!defined($path)){ $path = $ARGV[$i]; } elsif(!defined($rnum)){ $rnum = TokyoCabinet::atoi($ARGV[$i]); } elsif(!defined($bnum)){ $bnum = TokyoCabinet::atoi($ARGV[$i]); } elsif(!defined($apow)){ $apow = TokyoCabinet::atoi($ARGV[$i]); } elsif(!defined($fpow)){ $fpow = TokyoCabinet::atoi($ARGV[$i]); } else { usage(); } } usage() if(!defined($path) || !defined($rnum) || $rnum < 1); $bnum = defined($bnum) ? $bnum : -1; $apow = defined($apow) ? $apow : -1; $fpow = defined($fpow) ? $fpow : -1; my $rv = procwrite($path, $rnum, $bnum, $apow, $fpow, $opts, $iflags, $omode); return $rv; } # parse arguments of read command sub runread { my $path = undef; my $omode = 0; for(my $i = 1; $i < scalar(@ARGV); $i++){ if(!defined($path) && $ARGV[$i] =~ /^-/){ if($ARGV[$i] eq "-nl"){ $omode |= TokyoCabinet::TDB::ONOLCK; } elsif($ARGV[$i] eq "-nb"){ $omode |= TokyoCabinet::TDB::OLCKNB; } else { usage(); } } elsif(!defined($path)){ $path = $ARGV[$i]; } else { usage(); } } usage() if(!defined($path)); my $rv = procread($path, $omode); return $rv; } # parse arguments of remove command sub runremove { my $path = undef; my $omode = 0; for(my $i = 1; $i < scalar(@ARGV); $i++){ if(!defined($path) && $ARGV[$i] =~ /^-/){ if($ARGV[$i] eq "-nl"){ $omode |= TokyoCabinet::TDB::ONOLCK; } elsif($ARGV[$i] eq "-nb"){ $omode |= TokyoCabinet::TDB::OLCKNB; } else { usage(); } } elsif(!defined($path)){ $path = $ARGV[$i]; } else { usage(); } } usage() if(!defined($path)); my $rv = procremove($path, $omode); return $rv; } # parse arguments of misc command sub runmisc { my $path = undef; my $rnum = undef; my $opts = 0; my $omode = 0; for(my $i = 1; $i < scalar(@ARGV); $i++){ if(!defined($path) && $ARGV[$i] =~ /^-/){ if($ARGV[$i] eq "-tl"){ $opts |= TokyoCabinet::TDB::TLARGE; } elsif($ARGV[$i] eq "-td"){ $opts |= TokyoCabinet::TDB::TDEFLATE; } elsif($ARGV[$i] eq "-tb"){ $opts |= TokyoCabinet::TDB::TBZIP; } elsif($ARGV[$i] eq "-tt"){ $opts |= TokyoCabinet::TDB::TTCBS; } elsif($ARGV[$i] eq "-nl"){ $omode |= TokyoCabinet::TDB::ONOLCK; } elsif($ARGV[$i] eq "-nb"){ $omode |= TokyoCabinet::TDB::OLCKNB; } else { usage(); } } elsif(!defined($path)){ $path = $ARGV[$i]; } elsif(!defined($rnum)){ $rnum = TokyoCabinet::atoi($ARGV[$i]); } else { usage(); } } usage() if(!defined($path) || !defined($rnum) || $rnum < 1); my $rv = procmisc($path, $rnum, $opts, $omode); return $rv; } # print error message of table database sub eprint { my $tdb = shift; my $func = shift; my $path = $tdb->path(); printf STDERR ("%s: %s: %s: %s\n", $0, defined($path) ? $path : "-", $func, $tdb->errmsg()); } # perform write command sub procwrite { my $path = shift; my $rnum = shift; my $bnum = shift; my $apow = shift; my $fpow = shift; my $opts = shift; my $iflags = shift; my $omode = shift; printf("\n path=%s rnum=%d bnum=%d apow=%d fpow=%d opts=%d iflags=%d" . " omode=%d\n\n", $path, $rnum, $bnum, $apow, $fpow, $opts, $iflags, $omode); my $err = 0; my $stime = gettimeofday(); my $tdb = TokyoCabinet::TDB->new(); if(!$tdb->tune($bnum, $apow, $fpow, $opts)){ eprint($tdb, "tune"); $err = 1; } if(!$tdb->open($path, $tdb->OWRITER | $tdb->OCREAT | $tdb->OTRUNC | $omode)){ eprint($tdb, "open"); $err = 1; } if(($iflags & (1 << 0)) && !$tdb->setindex("", $tdb->ITDECIMAL)){ eprint($tdb, "setindex"); $err = 1; } if(($iflags & (1 << 1)) && !$tdb->setindex("str", $tdb->ITLEXICAL)){ eprint($tdb, "setindex"); $err = 1; } if(($iflags & (1 << 2)) && !$tdb->setindex("num", $tdb->ITDECIMAL)){ eprint($tdb, "setindex"); $err = 1; } if(($iflags & (1 << 3)) && !$tdb->setindex("type", $tdb->ITDECIMAL)){ eprint($tdb, "setindex"); $err = 1; } if(($iflags & (1 << 4)) && !$tdb->setindex("flag", $tdb->ITTOKEN)){ eprint($tdb, "setindex"); $err = 1; } if(($iflags & (1 << 5)) && !$tdb->setindex("text", $tdb->ITQGRAM)){ eprint($tdb, "setindex"); $err = 1; } for(my $i = 1; $i <= $rnum; $i++){ my $id = $tdb->genuid(); my $cols = { str => $id, num => int(rand($id)) + 1, type => int(rand(32)) + 1, }; my $vbuf = ""; my $num = int(rand(5)); my $pt = 0; for(my $j = 0; $j < $num; $j++){ $pt += int(rand(5)) + 1; $vbuf .= "," if(length($vbuf) > 0); $vbuf .= $pt; } if(length($vbuf) > 0){ $cols->{flag} = $vbuf; $cols->{text} = $vbuf; } if(!$tdb->put($id, $cols)){ eprint($tdb, "put"); $err = 1; last; } if($rnum > 250 && $i % ($rnum / 250) == 0){ print('.'); if($i == $rnum || $i % ($rnum / 10) == 0){ printf(" (%08d)\n", $i); } } } printf("record number: %llu\n", $tdb->rnum()); printf("size: %llu\n", $tdb->fsiz()); if(!$tdb->close()){ eprint($tdb, "close"); $err = 1; } printf("time: %.3f\n", gettimeofday() - $stime); printf("%s\n\n", $err ? "error" : "ok"); return $err ? 1 : 0; } # perform read command sub procread { my $path = shift; my $omode = shift; printf("\n path=%s omode=%d\n\n", $path, $omode); my $err = 0; my $stime = gettimeofday(); my $tdb = TokyoCabinet::TDB->new(); if(!$tdb->open($path, $tdb->OREADER | $omode)){ eprint($tdb, "open"); $err = 1; } my $rnum = $tdb->rnum(); for(my $i = 1; $i <= $rnum; $i++){ if(!$tdb->get($i)){ eprint($tdb, "get"); $err = 1; last; } if($rnum > 250 && $i % ($rnum / 250) == 0){ print('.'); if($i == $rnum || $i % ($rnum / 10) == 0){ printf(" (%08d)\n", $i); } } } printf("record number: %llu\n", $tdb->rnum()); printf("size: %llu\n", $tdb->fsiz()); if(!$tdb->close()){ eprint($tdb, "close"); $err = 1; } printf("time: %.3f\n", gettimeofday() - $stime); printf("%s\n\n", $err ? "error" : "ok"); return $err ? 1 : 0; } # perform remove command sub procremove { my $path = shift; my $omode = shift; printf("\n path=%s omode=%d\n\n", $path, $omode); my $err = 0; my $stime = gettimeofday(); my $tdb = TokyoCabinet::TDB->new(); if(!$tdb->open($path, $tdb->OWRITER | $omode)){ eprint($tdb, "open"); $err = 1; } my $rnum = $tdb->rnum(); for(my $i = 1; $i <= $rnum; $i++){ if(!$tdb->out($i)){ eprint($tdb, "out"); $err = 1; last; } if($rnum > 250 && $i % ($rnum / 250) == 0){ print('.'); if($i == $rnum || $i % ($rnum / 10) == 0){ printf(" (%08d)\n", $i); } } } printf("record number: %llu\n", $tdb->rnum()); printf("size: %llu\n", $tdb->fsiz()); if(!$tdb->close()){ eprint($tdb, "close"); $err = 1; } printf("time: %.3f\n", gettimeofday() - $stime); printf("%s\n\n", $err ? "error" : "ok"); return $err ? 1 : 0; } # perform misc command sub procmisc { my $path = shift; my $rnum = shift; my $opts = shift; my $omode = shift; printf("\n path=%s rnum=%d opts=%d omode=%d\n\n", $path, $rnum, $opts, $omode); my $err = 0; my $stime = gettimeofday(); my $tdb = TokyoCabinet::TDB->new(); if(!$tdb->tune($rnum / 50, 2, -1, $opts)){ eprint($tdb, "tune"); $err = 1; } if(!$tdb->setcache($rnum / 10, 128, 256)){ eprint($tdb, "setcache"); $err = 1; } if(!$tdb->setxmsiz($rnum * 4)){ eprint($tdb, "setxmsiz"); $err = 1; } if(!$tdb->setdfunit(8)){ eprint($tdb, "setdfunit"); $err = 1; } if(!$tdb->open($path, $tdb->OWRITER | $tdb->OCREAT | $tdb->OTRUNC | $omode)){ eprint($tdb, "open"); $err = 1; } if(!$tdb->setindex("", $tdb->ITDECIMAL)){ eprint($tdb, "setindex"); $err = 1; } if(!$tdb->setindex("str", $tdb->ITLEXICAL)){ eprint($tdb, "setindex"); $err = 1; } if(!$tdb->setindex("num", $tdb->ITDECIMAL)){ eprint($tdb, "setindex"); $err = 1; } if(!$tdb->setindex("type", $tdb->ITDECIMAL)){ eprint($tdb, "setindex"); $err = 1; } if(!$tdb->setindex("flag", $tdb->ITTOKEN)){ eprint($tdb, "setindex"); $err = 1; } if(!$tdb->setindex("text", $tdb->ITQGRAM)){ eprint($tdb, "setindex"); $err = 1; } printf("writing:\n"); for(my $i = 1; $i <= $rnum; $i++){ my $id = $tdb->genuid(); my $cols = { str => $id, num => int(rand($id)) + 1, type => int(rand(32)) + 1, }; my $vbuf = ""; my $num = int(rand(5)); my $pt = 0; for(my $j = 0; $j < $num; $j++){ $pt += int(rand(5)) + 1; $vbuf .= "," if(length($vbuf) > 0); $vbuf .= $pt; } if(length($vbuf) > 0){ $cols->{flag} = $vbuf; $cols->{text} = $vbuf; } if(!$tdb->put($id, $cols)){ eprint($tdb, "put"); $err = 1; last; } if($rnum > 250 && $i % ($rnum / 250) == 0){ print('.'); if($i == $rnum || $i % ($rnum / 10) == 0){ printf(" (%08d)\n", $i); } } } printf("reading:\n"); for(my $i = 1; $i <= $rnum; $i++){ if(!$tdb->get($i)){ eprint($tdb, "get"); $err = 1; last; } if($rnum > 250 && $i % ($rnum / 250) == 0){ print('.'); if($i == $rnum || $i % ($rnum / 10) == 0){ printf(" (%08d)\n", $i); } } } printf("removing:\n"); for(my $i = 1; $i <= $rnum; $i++){ if(int(rand(2)) == 0 && !$tdb->out($i)){ eprint($tdb, "out"); $err = 1; last; } if($rnum > 250 && $i % ($rnum / 250) == 0){ print('.'); if($i == $rnum || $i % ($rnum / 10) == 0){ printf(" (%08d)\n", $i); } } } printf("checking iterator:\n"); if(!$tdb->iterinit()){ eprint($tdb, "iterinit"); $err = 1; } my $inum = 0; while(defined(my $pkey = $tdb->iternext())){ $inum++; my $cols = $tdb->get($pkey); if(!defined($cols)){ eprint($tdb, "get"); $err = 1; } if($rnum > 250 && $inum % ($rnum / 250) == 0){ print('.'); if($inum == $rnum || $inum % ($rnum / 10) == 0){ printf(" (%08d)\n", $inum); } } } printf(" (%08d)\n", $inum) if($rnum > 250); if($tdb->ecode() != $tdb->ENOREC || $inum != $tdb->rnum()){ eprint($tdb, "(validation)"); $err = 1; } my $keys = $tdb->fwmkeys("1", 10); printf("checking counting:\n"); for(my $i = 1; $i <= $rnum; $i++){ my $buf = sprintf("i:%d", int(rand($rnum))); if(int(rand(2)) == 0){ if(!$tdb->addint($buf, 1)){ eprint($tdb, "addint"); $err = 1; last; } } else { if(!$tdb->adddouble($buf, 1)){ eprint($tdb, "adddouble"); $err = 1; last; } } if($rnum > 250 && $i % ($rnum / 250) == 0){ print('.'); if($i == $rnum || $i % ($rnum / 10) == 0){ printf(" (%08d)\n", $i); } } } if(!$tdb->sync()){ eprint($tdb, "sync"); $err = 1; } if(!$tdb->optimize()){ eprint($tdb, "optimize"); $err = 1; } my $npath = $path . "-tmp"; if(!$tdb->copy($npath)){ eprint($tdb, "copy"); $err = 1; } foreach my $tnpath (glob("$npath.idx.*")){ unlink($tnpath); } unlink($npath); printf("searching:\n"); my $qry = TokyoCabinet::TDBQRY->new($tdb); my @names = ( "", "str", "num", "type", "flag", "text", "c1" ); my @ops = ( $qry->QCSTREQ, $qry->QCSTRINC, $qry->QCSTRBW, $qry->QCSTREW, $qry->QCSTRAND, $qry->QCSTROR, $qry->QCSTROREQ, $qry->QCSTRRX, $qry->QCNUMEQ, $qry->QCNUMGT, $qry->QCNUMGE, $qry->QCNUMLT, $qry->QCNUMLE, $qry->QCNUMBT, $qry->QCNUMOREQ ); my @ftsops = ( $qry->QCFTSPH, $qry->QCFTSAND, $qry->QCFTSOR, $qry->QCFTSEX ); my @types = ( $qry->QOSTRASC, $qry->QOSTRDESC, $qry->QONUMASC, $qry->QONUMDESC ); for(my $i = 1; $i <= $rnum; $i++){ $qry = TokyoCabinet::TDBQRY->new($tdb) if(int(rand(10)) > 0); my $cnum = int(rand(4)); for(my $j = 0; $j < $cnum; $j++){ my $name = $names[int(rand(scalar(@names)))]; my $op = $ops[int(rand(scalar(@ops)))]; $op = $ftsops[int(rand(scalar(@ftsops)))] if(int(rand(10)) == 0); $op |= $qry->QCNEGATE if(int(rand(20)) == 0); $op |= $qry->QCNOIDX if(int(rand(20)) == 0); my $expr = int(rand($i)); $expr .= "," . int(rand($i)) if(int(rand(10)) == 0); $expr .= "," . int(rand($i)) if(int(rand(10)) == 0); $qry->addcond($name, $op, $expr); } if(int(rand(3)) != 0){ my $name = $names[int(rand(scalar(@names)))]; my $type = $types[int(rand(scalar(@types)))]; $qry->setorder($name, $type); } $qry->setlimit(int(rand($i)), int(rand(10))) if(int(rand(3)) != 0); my $res = $qry->search(); if($rnum > 250 && $i % ($rnum / 250) == 0){ print('.'); if($i == $rnum || $i % ($rnum / 10) == 0){ printf(" (%08d)\n", $i); } } } $qry = TokyoCabinet::TDBQRY->new($tdb); $qry->addcond("", $qry->QCSTRBW, "i:"); $qry->setorder("_num", $qry->QONUMDESC); my $ires = $qry->search(); my $irnum = scalar(@$ires); my $itnum = $tdb->rnum(); my $icnt = 0; my $iter = sub { my $pkey = shift; my $cols = shift; $cols->{icnt} = ++$icnt; $qry->QPPUT; }; if(!$qry->proc($iter)){ eprint($tdb, "qry::proc"); $err = 1; } $qry->addcond("icnt", $qry->QCNUMGT, 0); my $mures = $qry->metasearch([ $qry, $qry ], $qry->MSUNION); if(scalar(@$mures) != $irnum){ eprint($tdb, "qry::metasearch"); $err = 1; } my $mires = $qry->metasearch([ $qry, $qry ], $qry->MSISECT); if(scalar(@$mires) != $irnum){ eprint($tdb, "qry::metasearch"); $err = 1; } my $mdres = $qry->metasearch([ $qry, $qry ], $qry->MSDIFF); if(scalar(@$mdres) != 0){ eprint($tdb, "qry::metasearch"); $err = 1; } if(!$qry->searchout()){ eprint($tdb, "qry::searchout"); $err = 1; } if($tdb->rnum() != $itnum - $irnum){ eprint($tdb, "(validation)"); $err = 1; } $qry = TokyoCabinet::TDBQRY->new($tdb); $qry->addcond("text", $qry->QCSTRBW, "1"); $qry->setlimit(100, 1); $ires = $qry->search(); for(my $i = 0; $i < scalar(@$ires); $i++){ my $cols = $tdb->get($ires->[$i]); if(defined($cols)){ my $texts = $qry->kwic($cols, "text", -1, $qry->KWMUBRCT); if(scalar($texts) > 0){ for(my $j = 0; $j < scalar(@$texts); $j++){ if(index($texts->[$j], "1") < 0){ eprint($tdb, "(validation)"); $err = 1; last; } } } else { eprint($tdb, "(validation)"); $err = 1; last; } } else { eprint($tdb, "get"); $err = 1; last; } } if(!$tdb->vanish()){ eprint($tdb, "vanish"); $err = 1; } printf("checking transaction commit:\n"); if(!$tdb->tranbegin()){ eprint($tdb, "tranbegin"); $err = 1; } for(my $i = 1; $i <= $rnum; $i++){ my $id = int(rand($rnum)) + 1; if(int(rand(2)) == 0){ if(!$tdb->addint($id, 1)){ eprint($tdb, "addint"); $err = 1; last; } } else { if(!$tdb->out($id) && $tdb->ecode() != $tdb->ENOREC){ eprint($tdb, "out"); $err = 1; last; } } if($rnum > 250 && $i % ($rnum / 250) == 0){ print('.'); if($i == $rnum || $i % ($rnum / 10) == 0){ printf(" (%08d)\n", $i); } } } if(!$tdb->trancommit()){ eprint($tdb, "trancommit"); $err = 1; } printf("checking transaction abort:\n"); my $ornum = $tdb->rnum(); my $ofsiz = $tdb->fsiz(); if(!$tdb->tranbegin()){ eprint($tdb, "tranbegin"); $err = 1; } for(my $i = 1; $i <= $rnum; $i++){ my $id = int(rand($rnum)) + 1; if(int(rand(2)) == 0){ if(!$tdb->addint($id, 1)){ eprint($tdb, "addint"); $err = 1; last; } } else { if(!$tdb->out($id) && $tdb->ecode() != $tdb->ENOREC){ eprint($tdb, "out"); $err = 1; last; } } if($rnum > 250 && $i % ($rnum / 250) == 0){ print('.'); if($i == $rnum || $i % ($rnum / 10) == 0){ printf(" (%08d)\n", $i); } } } if(!$tdb->tranabort()){ eprint($tdb, "tranabort"); $err = 1; } if($tdb->rnum() != $ornum || $tdb->fsiz() != $ofsiz){ eprint($tdb, "(validation)"); $err = 1; } printf("record number: %llu\n", $tdb->rnum()); printf("size: %llu\n", $tdb->fsiz()); if(!$tdb->close()){ eprint($tdb, "close"); $err = 1; } printf("checking tied updating:\n"); my %hash; if(!tie(%hash, "TokyoCabinet::TDB", $path, TokyoCabinet::TDB::OWRITER)){ eprint($tdb, "tie"); $err = 1; } for(my $i = 1; $i <= $rnum; $i++){ my $buf = sprintf("[%d]", int(rand($rnum))); my $rnd = int(rand(4)); if($rnd == 0){ my $cols = { name => $buf, num => $i, }; $hash{$buf} = $cols; } elsif($rnd == 1){ my $value = $hash{$buf}; } elsif($rnd == 2){ my $res = exists($hash{$buf}); } elsif($rnd == 3){ delete($hash{$buf}); } if($rnum > 250 && $i % ($rnum / 250) == 0){ print('.'); if($i == $rnum || $i % ($rnum / 10) == 0){ printf(" (%08d)\n", $i); } } } printf("checking tied iterator:\n"); $inum = 0; while(my ($key, $value) = each(%hash)){ $inum++; if($rnum > 250 && $inum % ($rnum / 250) == 0){ print('.'); if($inum == $rnum || $inum % ($rnum / 10) == 0){ printf(" (%08d)\n", $inum); } } } printf(" (%08d)\n", $inum) if($rnum > 250); %hash = (); untie(%hash); printf("time: %.3f\n", gettimeofday() - $stime); printf("version: %s\n", TokyoCabinet::VERSION); printf("%s\n\n", $err ? "error" : "ok"); return $err ? 1 : 0; } # execute main $| = 1; $0 =~ s/.*\///; exit(main()); # END OF FILE tokyocabinet-perl-1.34/TokyoCabinet.xs0000644000175000017500000011655011420767015017060 0ustar mikiomikio/************************************************************************************************* * Perl binding of Tokyo Cabinet * Copyright (C) 2006-2010 FAL Labs * This file is part of Tokyo Cabinet. * Tokyo Cabinet is free software; you can redistribute it and/or modify it under the terms of * the GNU Lesser General Public License as published by the Free Software Foundation; either * version 2.1 of the License or any later version. Tokyo Cabinet is distributed in the hope * that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public * License for more details. * You should have received a copy of the GNU Lesser General Public License along with Tokyo * Cabinet; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, * Boston, MA 02111-1307 USA. *************************************************************************************************/ #include "EXTERN.h" #include "perl.h" #include "XSUB.h" #include #include #include #include #include #include #include #include #include #include #include static int bdb_cmp(const char *aptr, int asiz, const char *bptr, int bsiz, SV *cmp){ int rv; dSP; ENTER; SAVETMPS; PUSHMARK(SP); XPUSHs(sv_2mortal(newSVpvn(aptr, asiz))); XPUSHs(sv_2mortal(newSVpvn(bptr, bsiz))); PUTBACK; rv = call_sv(cmp, G_SCALAR); SPAGAIN; rv = (rv == 1) ? POPi : 0; PUTBACK; FREETMPS; LEAVE; return rv; } static int tdbqry_proc(const void *pkbuf, int pksiz, TCMAP *tcols, SV *proc){ HV *cols; SV *sv; const char *kbuf, *vbuf; char *rkbuf, *rvbuf; int ksiz, vsiz, rv; STRLEN rvsiz; I32 rksiz; cols = newHV(); tcmapiterinit(tcols); while((kbuf = tcmapiternext(tcols, &ksiz)) != NULL){ vbuf = tcmapiterval(kbuf, &vsiz); hv_store(cols, kbuf, ksiz, newSVpvn(vbuf, vsiz), 0); } dSP; ENTER; SAVETMPS; PUSHMARK(SP); XPUSHs(sv_2mortal(newSVpvn(pkbuf, pksiz))); XPUSHs(sv_2mortal(newRV_inc((SV *)cols))); PUTBACK; rv = call_sv(proc, G_SCALAR); SPAGAIN; rv = (rv == 1) ? POPi : 0; PUTBACK; FREETMPS; LEAVE; if(rv & TDBQPPUT){ tcmapclear(tcols); hv_iterinit(cols); while((sv = hv_iternextsv(cols, &rkbuf, &rksiz)) != NULL){ rvbuf = SvPV(sv, rvsiz); tcmapput(tcols, rkbuf, rksiz, rvbuf, rvsiz); } } SvREFCNT_dec(cols); return rv; } MODULE = TokyoCabinet PACKAGE = TokyoCabinet PROTOTYPES: DISABLE ##---------------------------------------------------------------- ## common functions ##---------------------------------------------------------------- const char * tc_version() CODE: RETVAL = tcversion; OUTPUT: RETVAL double tc_atoi(str) char * str CODE: RETVAL = tcatoi(str); OUTPUT: RETVAL double tc_atof(str) char * str CODE: RETVAL = tcatof(str); OUTPUT: RETVAL SV * tc_bercompress(sv) SV * sv PREINIT: AV *av; unsigned char *buf, *wp; int i, len; unsigned int num; CODE: av = (AV *)SvRV(sv); len = av_len(av) + 1; buf = tcmalloc(len * 5 + 1); wp = buf; for(i = 0; i < len; i++){ num = SvIV(*av_fetch(av, i, 0)); if(num < (1 << 7)){ *(wp++) = num; } else if(num < (1 << 14)){ *(wp++) = (num >> 7) | 0x80; *(wp++) = num & 0x7f; } else if(num < (1 << 21)){ *(wp++) = (num >> 14) | 0x80; *(wp++) = ((num >> 7) & 0x7f) | 0x80; *(wp++) = num & 0x7f; } else if(num < (1 << 28)){ *(wp++) = (num >> 21) | 0x80; *(wp++) = ((num >> 14) & 0x7f) | 0x80; *(wp++) = ((num >> 7) & 0x7f) | 0x80; *(wp++) = num & 0x7f; } else { *(wp++) = (num >> 28) | 0x80; *(wp++) = ((num >> 21) & 0x7f) | 0x80; *(wp++) = ((num >> 14) & 0x7f) | 0x80; *(wp++) = ((num >> 7) & 0x7f) | 0x80; *(wp++) = num & 0x7f; } } RETVAL = newRV_noinc(newSVpvn((char *)buf, wp - buf)); tcfree(buf); OUTPUT: RETVAL AV * tc_beruncompress(sv) SV * sv PREINIT: AV *av; const unsigned char *ptr; STRLEN size; unsigned int left, c, num; CODE: av = newAV(); sv = SvRV(sv); ptr = (unsigned char *)SvPV(sv, size); left = size; while(left > 0){ num = 0; do { c = *ptr; num = num * 0x80 + (c & 0x7f); ptr++; left--; } while(c >= 0x80); av_push(av, newSViv(num)); } RETVAL = (AV *)sv_2mortal((SV *)av); OUTPUT: RETVAL SV * tc_diffcompress(sv) SV * sv PREINIT: AV *av; unsigned char *buf, *wp; int i, len; unsigned int lnum, num, tnum; CODE: av = (AV *)SvRV(sv); len = av_len(av) + 1; lnum = 0; buf = tcmalloc(len * 5 + 1); wp = buf; for(i = 0; i < len; i++){ num = SvIV(*av_fetch(av, i, 0)); tnum = num; num -= lnum; if(num < (1 << 7)){ *(wp++) = num; } else if(num < (1 << 14)){ *(wp++) = (num >> 7) | 0x80; *(wp++) = num & 0x7f; } else if(num < (1 << 21)){ *(wp++) = (num >> 14) | 0x80; *(wp++) = ((num >> 7) & 0x7f) | 0x80; *(wp++) = num & 0x7f; } else if(num < (1 << 28)){ *(wp++) = (num >> 21) | 0x80; *(wp++) = ((num >> 14) & 0x7f) | 0x80; *(wp++) = ((num >> 7) & 0x7f) | 0x80; *(wp++) = num & 0x7f; } else { *(wp++) = (num >> 28) | 0x80; *(wp++) = ((num >> 21) & 0x7f) | 0x80; *(wp++) = ((num >> 14) & 0x7f) | 0x80; *(wp++) = ((num >> 7) & 0x7f) | 0x80; *(wp++) = num & 0x7f; } lnum = tnum; } RETVAL = newRV_noinc(newSVpvn((char *)buf, wp - buf)); tcfree(buf); OUTPUT: RETVAL AV * tc_diffuncompress(sv) SV * sv PREINIT: AV *av; const unsigned char *ptr; STRLEN size; unsigned int left, c, num, sum; CODE: av = newAV(); sv = SvRV(sv); ptr = (unsigned char *)SvPV(sv, size); left = size; sum = 0; while(left > 0){ num = 0; do { c = *ptr; num = num * 0x80 + (c & 0x7f); ptr++; left--; } while(c >= 0x80); sum += num; av_push(av, newSViv(sum)); } RETVAL = (AV *)sv_2mortal((SV *)av); OUTPUT: RETVAL int tc_strdistance(asv, bsv, isutf) SV * asv SV * bsv int isutf PREINIT: const char *astr, *bstr; CODE: asv = SvRV(asv); astr = SvPV_nolen(asv); bsv = SvRV(bsv); bstr = SvPV_nolen(bsv); RETVAL = isutf ? tcstrdistutf(astr, bstr) : tcstrdist(astr, bstr); OUTPUT: RETVAL ##---------------------------------------------------------------- ## the hash database API ##---------------------------------------------------------------- void * hdb_new() PREINIT: TCHDB *hdb; CODE: hdb = tchdbnew(); tchdbsetmutex(hdb); RETVAL = hdb; OUTPUT: RETVAL void hdb_del(hdb) void * hdb CODE: tchdbdel(hdb); const char * hdb_errmsg(ecode) int ecode CODE: RETVAL = tchdberrmsg(ecode); OUTPUT: RETVAL int hdb_ecode(hdb) void * hdb CODE: RETVAL = tchdbecode(hdb); OUTPUT: RETVAL int hdb_tune(hdb, bnum, apow, fpow, opts) void * hdb double bnum int apow int fpow int opts CODE: RETVAL = tchdbtune(hdb, bnum, apow, fpow, opts); OUTPUT: RETVAL int hdb_setcache(hdb, rcnum) void * hdb int rcnum CODE: RETVAL = tchdbsetcache(hdb, rcnum); OUTPUT: RETVAL int hdb_setxmsiz(hdb, xmsiz) void * hdb double xmsiz CODE: RETVAL = tchdbsetxmsiz(hdb, xmsiz); OUTPUT: RETVAL int hdb_setdfunit(hdb, dfunit) void * hdb int dfunit CODE: RETVAL = tchdbsetdfunit(hdb, dfunit); OUTPUT: RETVAL int hdb_open(hdb, path, omode) void * hdb char * path int omode CODE: RETVAL = tchdbopen(hdb, path, omode); OUTPUT: RETVAL int hdb_close(hdb) void * hdb CODE: RETVAL = tchdbclose(hdb); OUTPUT: RETVAL int hdb_put(hdb, key, val) void * hdb SV * key SV * val PREINIT: const char *kbuf, *vbuf; STRLEN ksiz, vsiz; CODE: kbuf = SvPV(key, ksiz); vbuf = SvPV(val, vsiz); RETVAL = tchdbput(hdb, kbuf, (int)ksiz, vbuf, (int)vsiz); OUTPUT: RETVAL int hdb_putkeep(hdb, key, val) void * hdb SV * key SV * val PREINIT: const char *kbuf, *vbuf; STRLEN ksiz, vsiz; CODE: kbuf = SvPV(key, ksiz); vbuf = SvPV(val, vsiz); RETVAL = tchdbputkeep(hdb, kbuf, (int)ksiz, vbuf, (int)vsiz); OUTPUT: RETVAL int hdb_putcat(hdb, key, val) void * hdb SV * key SV * val PREINIT: const char *kbuf, *vbuf; STRLEN ksiz, vsiz; CODE: kbuf = SvPV(key, ksiz); vbuf = SvPV(val, vsiz); RETVAL = tchdbputcat(hdb, kbuf, (int)ksiz, vbuf, (int)vsiz); OUTPUT: RETVAL int hdb_putasync(hdb, key, val) void * hdb SV * key SV * val PREINIT: const char *kbuf, *vbuf; STRLEN ksiz, vsiz; CODE: kbuf = SvPV(key, ksiz); vbuf = SvPV(val, vsiz); RETVAL = tchdbputasync(hdb, kbuf, (int)ksiz, vbuf, (int)vsiz); OUTPUT: RETVAL int hdb_out(hdb, key) void * hdb SV * key PREINIT: const char *kbuf; STRLEN ksiz; CODE: kbuf = SvPV(key, ksiz); RETVAL = tchdbout(hdb, kbuf, (int)ksiz); OUTPUT: RETVAL void hdb_get(hdb, key) void * hdb SV * key PREINIT: const char *kbuf; STRLEN ksiz; char *vbuf; int vsiz; PPCODE: kbuf = SvPV(key, ksiz); vbuf = tchdbget(hdb, kbuf, (int)ksiz, &vsiz); if(vbuf){ XPUSHs(sv_2mortal(newSVpvn(vbuf, vsiz))); tcfree(vbuf); } else { XPUSHs((SV *)&PL_sv_undef); } XSRETURN(1); int hdb_vsiz(hdb, key) void * hdb SV * key PREINIT: const char *kbuf; STRLEN ksiz; CODE: kbuf = SvPV(key, ksiz); RETVAL = tchdbvsiz(hdb, kbuf, (int)ksiz); OUTPUT: RETVAL int hdb_iterinit(hdb) void * hdb CODE: RETVAL = tchdbiterinit(hdb); OUTPUT: RETVAL void hdb_iternext(hdb) void * hdb PREINIT: char *vbuf; int vsiz; PPCODE: vbuf = tchdbiternext(hdb, &vsiz); if(vbuf){ XPUSHs(sv_2mortal(newSVpvn(vbuf, vsiz))); tcfree(vbuf); } else { XPUSHs((SV *)&PL_sv_undef); } XSRETURN(1); void hdb_fwmkeys(hdb, prefix, max) void * hdb SV * prefix int max PREINIT: AV *av; STRLEN psiz; TCLIST *keys; const char *pbuf, *kbuf; int i, ksiz; PPCODE: pbuf = SvPV(prefix, psiz); keys = tchdbfwmkeys(hdb, pbuf, (int)psiz, max); av = newAV(); for(i = 0; i < tclistnum(keys); i++){ kbuf = tclistval(keys, i, &ksiz); av_push(av, newSVpvn(kbuf, ksiz)); } tclistdel(keys); XPUSHs(sv_2mortal(newRV_noinc((SV *)av))); XSRETURN(1); void hdb_addint(hdb, key, num) void * hdb SV * key int num PREINIT: const char *kbuf; STRLEN ksiz; PPCODE: kbuf = SvPV(key, ksiz); num = tchdbaddint(hdb, kbuf, (int)ksiz, num); if(num == INT_MIN){ XPUSHs((SV *)&PL_sv_undef); } else { XPUSHs(sv_2mortal(newSViv(num))); } XSRETURN(1); void hdb_adddouble(hdb, key, num) void * hdb SV * key double num PREINIT: const char *kbuf; STRLEN ksiz; PPCODE: kbuf = SvPV(key, ksiz); num = tchdbadddouble(hdb, kbuf, (int)ksiz, num); if(isnan(num)){ XPUSHs((SV *)&PL_sv_undef); } else { XPUSHs(sv_2mortal(newSVnv(num))); } XSRETURN(1); int hdb_sync(hdb) void * hdb CODE: RETVAL = tchdbsync(hdb); OUTPUT: RETVAL int hdb_optimize(hdb, bnum, apow, fpow, opts) void * hdb double bnum int apow int fpow int opts CODE: RETVAL = tchdboptimize(hdb, bnum, apow, fpow, opts); OUTPUT: RETVAL int hdb_vanish(hdb) void * hdb CODE: RETVAL = tchdbvanish(hdb); OUTPUT: RETVAL int hdb_copy(hdb, path) void * hdb char * path CODE: RETVAL = tchdbcopy(hdb, path); OUTPUT: RETVAL int hdb_tranbegin(hdb) void * hdb CODE: RETVAL = tchdbtranbegin(hdb); OUTPUT: RETVAL int hdb_trancommit(hdb) void * hdb CODE: RETVAL = tchdbtrancommit(hdb); OUTPUT: RETVAL int hdb_tranabort(hdb) void * hdb CODE: RETVAL = tchdbtranabort(hdb); OUTPUT: RETVAL void hdb_path(hdb) void * hdb PREINIT: const char *path; PPCODE: path = tchdbpath(hdb); if(path){ XPUSHs(sv_2mortal(newSVpv(path, 0))); } else { XPUSHs((SV *)&PL_sv_undef); } XSRETURN(1); double hdb_rnum(hdb) void * hdb CODE: RETVAL = tchdbrnum(hdb); OUTPUT: RETVAL double hdb_fsiz(hdb) void * hdb CODE: RETVAL = tchdbfsiz(hdb); OUTPUT: RETVAL ##---------------------------------------------------------------- ## functions for B+ tree database ##---------------------------------------------------------------- void * bdb_new() PREINIT: TCBDB *bdb; CODE: bdb = tcbdbnew(); tcbdbsetmutex(bdb); RETVAL = bdb; OUTPUT: RETVAL void bdb_del(bdb) void * bdb PREINIT: SV *cmp; CODE: cmp = tcbdbcmpop(bdb); if(cmp) SvREFCNT_dec(cmp); tcbdbdel(bdb); const char * bdb_errmsg(ecode) int ecode CODE: RETVAL = tcbdberrmsg(ecode); OUTPUT: RETVAL int bdb_ecode(bdb) void * bdb CODE: RETVAL = tcbdbecode(bdb); OUTPUT: RETVAL int bdb_setcmpfunc(bdb, num) void * bdb int num PREINIT: SV *ocmp; CODE: ocmp = tcbdbcmpop(bdb); if(ocmp) SvREFCNT_dec(ocmp); switch(num){ case 1: RETVAL = tcbdbsetcmpfunc(bdb, tccmpdecimal, NULL); break; case 2: RETVAL = tcbdbsetcmpfunc(bdb, tccmpint32, NULL); break; case 3: RETVAL = tcbdbsetcmpfunc(bdb, tccmpint64, NULL); break; default: RETVAL = tcbdbsetcmpfunc(bdb, tccmplexical, NULL); break; } OUTPUT: RETVAL int bdb_setcmpfuncex(bdb, cmp) void * bdb SV * cmp PREINIT: SV *ocmp; CODE: ocmp = tcbdbcmpop(bdb); if(ocmp) SvREFCNT_dec(ocmp); RETVAL = tcbdbsetcmpfunc(bdb, (TCCMP)bdb_cmp, newSVsv(cmp)); OUTPUT: RETVAL int bdb_tune(bdb, lmemb, nmemb, bnum, apow, fpow, opts) void * bdb int lmemb int nmemb double bnum int apow int fpow int opts CODE: RETVAL = tcbdbtune(bdb, lmemb, nmemb, bnum, apow, fpow, opts); OUTPUT: RETVAL int bdb_setcache(bdb, lcnum, ncnum) void * bdb int lcnum int ncnum CODE: RETVAL = tcbdbsetcache(bdb, lcnum, ncnum); OUTPUT: RETVAL int bdb_setxmsiz(bdb, xmsiz) void * bdb double xmsiz CODE: RETVAL = tcbdbsetxmsiz(bdb, xmsiz); OUTPUT: RETVAL int bdb_setdfunit(bdb, dfunit) void * bdb int dfunit CODE: RETVAL = tcbdbsetdfunit(bdb, dfunit); OUTPUT: RETVAL int bdb_open(bdb, path, omode) void * bdb char * path int omode CODE: RETVAL = tcbdbopen(bdb, path, omode); OUTPUT: RETVAL int bdb_close(bdb) void * bdb CODE: RETVAL = tcbdbclose(bdb); OUTPUT: RETVAL int bdb_put(bdb, key, val) void * bdb SV * key SV * val PREINIT: const char *kbuf, *vbuf; STRLEN ksiz, vsiz; CODE: kbuf = SvPV(key, ksiz); vbuf = SvPV(val, vsiz); RETVAL = tcbdbput(bdb, kbuf, (int)ksiz, vbuf, (int)vsiz); OUTPUT: RETVAL int bdb_putkeep(bdb, key, val) void * bdb SV * key SV * val PREINIT: const char *kbuf, *vbuf; STRLEN ksiz, vsiz; CODE: kbuf = SvPV(key, ksiz); vbuf = SvPV(val, vsiz); RETVAL = tcbdbputkeep(bdb, kbuf, (int)ksiz, vbuf, (int)vsiz); OUTPUT: RETVAL int bdb_putcat(bdb, key, val) void * bdb SV * key SV * val PREINIT: const char *kbuf, *vbuf; STRLEN ksiz, vsiz; CODE: kbuf = SvPV(key, ksiz); vbuf = SvPV(val, vsiz); RETVAL = tcbdbputcat(bdb, kbuf, (int)ksiz, vbuf, (int)vsiz); OUTPUT: RETVAL int bdb_putdup(bdb, key, val) void * bdb SV * key SV * val PREINIT: const char *kbuf, *vbuf; STRLEN ksiz, vsiz; CODE: kbuf = SvPV(key, ksiz); vbuf = SvPV(val, vsiz); RETVAL = tcbdbputdup(bdb, kbuf, (int)ksiz, vbuf, (int)vsiz); OUTPUT: RETVAL int bdb_putlist(bdb, key, vals) void * bdb SV * key AV * vals PREINIT: SV *val; TCLIST *tvals; const char *kbuf, *vbuf; STRLEN ksiz, vsiz; int i, num; CODE: kbuf = SvPV(key, ksiz); tvals = tclistnew(); num = av_len(vals) + 1; for(i = 0; i < num; i++){ val = *av_fetch(vals, i, 0); vbuf = SvPV(val, vsiz); tclistpush(tvals, vbuf, (int)vsiz); } RETVAL = tcbdbputdup3(bdb, kbuf, (int)ksiz, tvals); tclistdel(tvals); OUTPUT: RETVAL int bdb_out(bdb, key) void * bdb SV * key PREINIT: const char *kbuf; STRLEN ksiz; CODE: kbuf = SvPV(key, ksiz); RETVAL = tcbdbout(bdb, kbuf, (int)ksiz); OUTPUT: RETVAL int bdb_outlist(bdb, key) void * bdb SV * key PREINIT: const char *kbuf; STRLEN ksiz; CODE: kbuf = SvPV(key, ksiz); RETVAL = tcbdbout3(bdb, kbuf, (int)ksiz); OUTPUT: RETVAL void bdb_get(bdb, key) void * bdb SV * key PREINIT: const char *kbuf; STRLEN ksiz; char *vbuf; int vsiz; PPCODE: kbuf = SvPV(key, ksiz); vbuf = tcbdbget(bdb, kbuf, (int)ksiz, &vsiz); if(vbuf){ XPUSHs(sv_2mortal(newSVpvn(vbuf, vsiz))); tcfree(vbuf); } else { XPUSHs((SV *)&PL_sv_undef); } XSRETURN(1); void bdb_getlist(bdb, key) void * bdb SV * key PREINIT: AV *av; TCLIST *vals; const char *kbuf, *vbuf; STRLEN ksiz; int i, vsiz; PPCODE: kbuf = SvPV(key, ksiz); vals = tcbdbget4(bdb, kbuf, (int)ksiz); if(vals){ av = newAV(); for(i = 0; i < tclistnum(vals); i++){ vbuf = tclistval(vals, i, &vsiz); av_push(av, newSVpvn(vbuf, vsiz)); } tclistdel(vals); XPUSHs(sv_2mortal(newRV_noinc((SV *)av))); } else { XPUSHs((SV *)&PL_sv_undef); } XSRETURN(1); int bdb_vnum(bdb, key) void * bdb SV * key PREINIT: const char *kbuf; STRLEN ksiz; CODE: kbuf = SvPV(key, ksiz); RETVAL = tcbdbvnum(bdb, kbuf, (int)ksiz); OUTPUT: RETVAL int bdb_vsiz(bdb, key) void * bdb SV * key PREINIT: const char *kbuf; STRLEN ksiz; CODE: kbuf = SvPV(key, ksiz); RETVAL = tcbdbvsiz(bdb, kbuf, (int)ksiz); OUTPUT: RETVAL void bdb_range(bdb, bkey, binc, ekey, einc, max) void * bdb SV * bkey int binc SV * ekey int einc int max PREINIT: AV *av; TCLIST *keys; const char *bkbuf, *ekbuf, *kbuf; STRLEN bksiz, eksiz; int i, ksiz; PPCODE: if(bkey){ bkbuf = SvPV(bkey, bksiz); } else { bkbuf = NULL; bksiz = -1; } if(ekey){ ekbuf = SvPV(ekey, eksiz); } else { ekbuf = NULL; eksiz = -1; } keys = tcbdbrange(bdb, bkbuf, (int)bksiz, binc, ekbuf, (int)eksiz, einc, max); av = newAV(); for(i = 0; i < tclistnum(keys); i++){ kbuf = tclistval(keys, i, &ksiz); av_push(av, newSVpvn(kbuf, ksiz)); } tclistdel(keys); XPUSHs(sv_2mortal(newRV_noinc((SV *)av))); XSRETURN(1); void bdb_fwmkeys(bdb, prefix, max) void * bdb SV * prefix int max PREINIT: AV *av; STRLEN psiz; TCLIST *keys; const char *pbuf, *kbuf; int i, ksiz; PPCODE: pbuf = SvPV(prefix, psiz); keys = tcbdbfwmkeys(bdb, pbuf, (int)psiz, max); av = newAV(); for(i = 0; i < tclistnum(keys); i++){ kbuf = tclistval(keys, i, &ksiz); av_push(av, newSVpvn(kbuf, ksiz)); } tclistdel(keys); XPUSHs(sv_2mortal(newRV_noinc((SV *)av))); XSRETURN(1); void bdb_addint(bdb, key, num) void * bdb SV * key int num PREINIT: const char *kbuf; STRLEN ksiz; PPCODE: kbuf = SvPV(key, ksiz); num = tcbdbaddint(bdb, kbuf, (int)ksiz, num); if(num == INT_MIN){ XPUSHs((SV *)&PL_sv_undef); } else { XPUSHs(sv_2mortal(newSViv(num))); } XSRETURN(1); void bdb_adddouble(bdb, key, num) void * bdb SV * key double num PREINIT: const char *kbuf; STRLEN ksiz; PPCODE: kbuf = SvPV(key, ksiz); num = tcbdbadddouble(bdb, kbuf, (int)ksiz, num); if(isnan(num)){ XPUSHs((SV *)&PL_sv_undef); } else { XPUSHs(sv_2mortal(newSVnv(num))); } XSRETURN(1); int bdb_sync(bdb) void * bdb CODE: RETVAL = tcbdbsync(bdb); OUTPUT: RETVAL int bdb_optimize(bdb, lmemb, nmemb, bnum, apow, fpow, opts) void * bdb int lmemb int nmemb double bnum int apow int fpow int opts CODE: RETVAL = tcbdboptimize(bdb, lmemb, nmemb, bnum, apow, fpow, opts); OUTPUT: RETVAL int bdb_vanish(bdb) void * bdb CODE: RETVAL = tcbdbvanish(bdb); OUTPUT: RETVAL int bdb_copy(bdb, path) void * bdb char * path CODE: RETVAL = tcbdbcopy(bdb, path); OUTPUT: RETVAL int bdb_tranbegin(bdb) void * bdb CODE: RETVAL = tcbdbtranbegin(bdb); OUTPUT: RETVAL int bdb_trancommit(bdb) void * bdb CODE: RETVAL = tcbdbtrancommit(bdb); OUTPUT: RETVAL int bdb_tranabort(bdb) void * bdb CODE: RETVAL = tcbdbtranabort(bdb); OUTPUT: RETVAL void bdb_path(bdb) void * bdb PREINIT: const char *path; PPCODE: path = tcbdbpath(bdb); if(path){ XPUSHs(sv_2mortal(newSVpv(path, 0))); } else { XPUSHs((SV *)&PL_sv_undef); } XSRETURN(1); double bdb_rnum(bdb) void * bdb CODE: RETVAL = tcbdbrnum(bdb); OUTPUT: RETVAL double bdb_fsiz(bdb) void * bdb CODE: RETVAL = tcbdbfsiz(bdb); OUTPUT: RETVAL void * bdbcur_new(bdb) void * bdb CODE: RETVAL = tcbdbcurnew(bdb); OUTPUT: RETVAL void bdbcur_del(cur) void * cur CODE: tcbdbcurdel(cur); int bdbcur_first(cur) void * cur CODE: RETVAL = tcbdbcurfirst(cur); OUTPUT: RETVAL int bdbcur_last(cur) void * cur CODE: RETVAL = tcbdbcurlast(cur); OUTPUT: RETVAL int bdbcur_jump(cur, key) void * cur SV * key PREINIT: const char *kbuf; STRLEN ksiz; CODE: kbuf = SvPV(key, ksiz); RETVAL = tcbdbcurjump(cur, kbuf, (int)ksiz); OUTPUT: RETVAL int bdbcur_prev(cur) void * cur CODE: RETVAL = tcbdbcurprev(cur); OUTPUT: RETVAL int bdbcur_next(cur) void * cur CODE: RETVAL = tcbdbcurnext(cur); OUTPUT: RETVAL int bdbcur_put(cur, val, cpmode) void * cur SV * val int cpmode PREINIT: const char *vbuf; STRLEN vsiz; CODE: vbuf = SvPV(val, vsiz); RETVAL = tcbdbcurput(cur, vbuf, (int)vsiz, cpmode); OUTPUT: RETVAL int bdbcur_out(cur) void * cur CODE: RETVAL = tcbdbcurout(cur); OUTPUT: RETVAL void bdbcur_key(cur) void * cur PREINIT: char *kbuf; int ksiz; PPCODE: kbuf = tcbdbcurkey(cur, &ksiz); if(kbuf){ XPUSHs(sv_2mortal(newSVpvn(kbuf, ksiz))); tcfree(kbuf); } else { XPUSHs((SV *)&PL_sv_undef); } XSRETURN(1); void bdbcur_val(cur) void * cur PREINIT: char *vbuf; int vsiz; PPCODE: vbuf = tcbdbcurval(cur, &vsiz); if(vbuf){ XPUSHs(sv_2mortal(newSVpvn(vbuf, vsiz))); tcfree(vbuf); } else { XPUSHs((SV *)&PL_sv_undef); } XSRETURN(1); ##---------------------------------------------------------------- ## the fixed-length database API ##---------------------------------------------------------------- void * fdb_new() PREINIT: TCFDB *fdb; CODE: fdb = tcfdbnew(); tcfdbsetmutex(fdb); RETVAL = fdb; OUTPUT: RETVAL void fdb_del(fdb) void * fdb CODE: tcfdbdel(fdb); const char * fdb_errmsg(ecode) int ecode CODE: RETVAL = tcfdberrmsg(ecode); OUTPUT: RETVAL int fdb_ecode(fdb) void * fdb CODE: RETVAL = tcfdbecode(fdb); OUTPUT: RETVAL int fdb_tune(fdb, width, limsiz) void * fdb int width double limsiz CODE: RETVAL = tcfdbtune(fdb, width, limsiz); OUTPUT: RETVAL int fdb_open(fdb, path, omode) void * fdb char * path int omode CODE: RETVAL = tcfdbopen(fdb, path, omode); OUTPUT: RETVAL int fdb_close(fdb) void * fdb CODE: RETVAL = tcfdbclose(fdb); OUTPUT: RETVAL int fdb_put(fdb, key, val) void * fdb SV * key SV * val PREINIT: const char *kbuf, *vbuf; STRLEN ksiz, vsiz; CODE: kbuf = SvPV(key, ksiz); vbuf = SvPV(val, vsiz); RETVAL = tcfdbput2(fdb, kbuf, (int)ksiz, vbuf, (int)vsiz); OUTPUT: RETVAL int fdb_putkeep(fdb, key, val) void * fdb SV * key SV * val PREINIT: const char *kbuf, *vbuf; STRLEN ksiz, vsiz; CODE: kbuf = SvPV(key, ksiz); vbuf = SvPV(val, vsiz); RETVAL = tcfdbputkeep2(fdb, kbuf, (int)ksiz, vbuf, (int)vsiz); OUTPUT: RETVAL int fdb_putcat(fdb, key, val) void * fdb SV * key SV * val PREINIT: const char *kbuf, *vbuf; STRLEN ksiz, vsiz; CODE: kbuf = SvPV(key, ksiz); vbuf = SvPV(val, vsiz); RETVAL = tcfdbputcat2(fdb, kbuf, (int)ksiz, vbuf, (int)vsiz); OUTPUT: RETVAL int fdb_out(fdb, key) void * fdb SV * key PREINIT: const char *kbuf; STRLEN ksiz; CODE: kbuf = SvPV(key, ksiz); RETVAL = tcfdbout2(fdb, kbuf, (int)ksiz); OUTPUT: RETVAL void fdb_get(fdb, key) void * fdb SV * key PREINIT: const char *kbuf; STRLEN ksiz; char *vbuf; int vsiz; PPCODE: kbuf = SvPV(key, ksiz); vbuf = tcfdbget2(fdb, kbuf, (int)ksiz, &vsiz); if(vbuf){ XPUSHs(sv_2mortal(newSVpvn(vbuf, vsiz))); tcfree(vbuf); } else { XPUSHs((SV *)&PL_sv_undef); } XSRETURN(1); int fdb_vsiz(fdb, key) void * fdb SV * key PREINIT: const char *kbuf; STRLEN ksiz; CODE: kbuf = SvPV(key, ksiz); RETVAL = tcfdbvsiz2(fdb, kbuf, (int)ksiz); OUTPUT: RETVAL int fdb_iterinit(fdb) void * fdb CODE: RETVAL = tcfdbiterinit(fdb); OUTPUT: RETVAL void fdb_iternext(fdb) void * fdb PREINIT: char *vbuf; int vsiz; PPCODE: vbuf = tcfdbiternext2(fdb, &vsiz); if(vbuf){ XPUSHs(sv_2mortal(newSVpvn(vbuf, vsiz))); tcfree(vbuf); } else { XPUSHs((SV *)&PL_sv_undef); } XSRETURN(1); void fdb_range(fdb, interval, max) void * fdb SV * interval int max PREINIT: AV *av; STRLEN isiz; TCLIST *keys; const char *ibuf, *kbuf; int i, ksiz; PPCODE: ibuf = SvPV(interval, isiz); keys = tcfdbrange4(fdb, ibuf, (int)isiz, max); av = newAV(); for(i = 0; i < tclistnum(keys); i++){ kbuf = tclistval(keys, i, &ksiz); av_push(av, newSVpvn(kbuf, ksiz)); } tclistdel(keys); XPUSHs(sv_2mortal(newRV_noinc((SV *)av))); XSRETURN(1); void fdb_addint(fdb, key, num) void * fdb SV * key int num PREINIT: const char *kbuf; STRLEN ksiz; PPCODE: kbuf = SvPV(key, ksiz); num = tcfdbaddint(fdb, tcfdbkeytoid(kbuf, (int)ksiz), num); if(num == INT_MIN){ XPUSHs((SV *)&PL_sv_undef); } else { XPUSHs(sv_2mortal(newSViv(num))); } XSRETURN(1); void fdb_adddouble(fdb, key, num) void * fdb SV * key double num PREINIT: const char *kbuf; STRLEN ksiz; PPCODE: kbuf = SvPV(key, ksiz); num = tcfdbadddouble(fdb, tcfdbkeytoid(kbuf, (int)ksiz), num); if(isnan(num)){ XPUSHs((SV *)&PL_sv_undef); } else { XPUSHs(sv_2mortal(newSVnv(num))); } XSRETURN(1); int fdb_sync(fdb) void * fdb CODE: RETVAL = tcfdbsync(fdb); OUTPUT: RETVAL int fdb_optimize(fdb, width, limsiz) void * fdb int width double limsiz CODE: RETVAL = tcfdboptimize(fdb, width, limsiz); OUTPUT: RETVAL int fdb_vanish(fdb) void * fdb CODE: RETVAL = tcfdbvanish(fdb); OUTPUT: RETVAL int fdb_copy(fdb, path) void * fdb char * path CODE: RETVAL = tcfdbcopy(fdb, path); OUTPUT: RETVAL int fdb_tranbegin(fdb) void * fdb CODE: RETVAL = tcfdbtranbegin(fdb); OUTPUT: RETVAL int fdb_trancommit(fdb) void * fdb CODE: RETVAL = tcfdbtrancommit(fdb); OUTPUT: RETVAL int fdb_tranabort(fdb) void * fdb CODE: RETVAL = tcfdbtranabort(fdb); OUTPUT: RETVAL void fdb_path(fdb) void * fdb PREINIT: const char *path; PPCODE: path = tcfdbpath(fdb); if(path){ XPUSHs(sv_2mortal(newSVpv(path, 0))); } else { XPUSHs((SV *)&PL_sv_undef); } XSRETURN(1); double fdb_rnum(fdb) void * fdb CODE: RETVAL = tcfdbrnum(fdb); OUTPUT: RETVAL double fdb_fsiz(fdb) void * fdb CODE: RETVAL = tcfdbfsiz(fdb); OUTPUT: RETVAL ##---------------------------------------------------------------- ## the table database API ##---------------------------------------------------------------- void * tdb_new() PREINIT: TCTDB *tdb; CODE: tdb = tctdbnew(); tctdbsetmutex(tdb); RETVAL = tdb; OUTPUT: RETVAL void tdb_del(tdb) void * tdb CODE: tctdbdel(tdb); const char * tdb_errmsg(ecode) int ecode CODE: RETVAL = tctdberrmsg(ecode); OUTPUT: RETVAL int tdb_ecode(tdb) void * tdb CODE: RETVAL = tctdbecode(tdb); OUTPUT: RETVAL int tdb_tune(tdb, bnum, apow, fpow, opts) void * tdb double bnum int apow int fpow int opts CODE: RETVAL = tctdbtune(tdb, bnum, apow, fpow, opts); OUTPUT: RETVAL int tdb_setcache(tdb, rcnum, lcnum, ncnum) void * tdb int rcnum int lcnum int ncnum CODE: RETVAL = tctdbsetcache(tdb, rcnum, lcnum, ncnum); OUTPUT: RETVAL int tdb_setxmsiz(tdb, xmsiz) void * tdb double xmsiz CODE: RETVAL = tctdbsetxmsiz(tdb, xmsiz); OUTPUT: RETVAL int tdb_setdfunit(tdb, dfunit) void * tdb int dfunit CODE: RETVAL = tctdbsetdfunit(tdb, dfunit); OUTPUT: RETVAL int tdb_open(tdb, path, omode) void * tdb char * path int omode CODE: RETVAL = tctdbopen(tdb, path, omode); OUTPUT: RETVAL int tdb_close(tdb) void * tdb CODE: RETVAL = tctdbclose(tdb); OUTPUT: RETVAL int tdb_put(tdb, pkey, cols) void * tdb SV * pkey HV * cols PREINIT: SV *sv; const char *pkbuf; char *kbuf, *vbuf; STRLEN pksiz, vsiz; I32 ksiz; TCMAP *tcols; CODE: pkbuf = SvPV(pkey, pksiz); tcols = tcmapnew2(31); hv_iterinit(cols); while((sv = hv_iternextsv(cols, &kbuf, &ksiz)) != NULL){ vbuf = SvPV(sv, vsiz); tcmapput(tcols, kbuf, ksiz, vbuf, vsiz); } RETVAL = tctdbput(tdb, pkbuf, pksiz, tcols); tcmapdel(tcols); OUTPUT: RETVAL int tdb_putkeep(tdb, pkey, cols) void * tdb SV * pkey HV * cols PREINIT: SV *sv; const char *pkbuf; char *kbuf, *vbuf; STRLEN pksiz, vsiz; I32 ksiz; TCMAP *tcols; CODE: pkbuf = SvPV(pkey, pksiz); tcols = tcmapnew2(31); hv_iterinit(cols); while((sv = hv_iternextsv(cols, &kbuf, &ksiz)) != NULL){ vbuf = SvPV(sv, vsiz); tcmapput(tcols, kbuf, ksiz, vbuf, vsiz); } RETVAL = tctdbputkeep(tdb, pkbuf, pksiz, tcols); tcmapdel(tcols); OUTPUT: RETVAL int tdb_putcat(tdb, pkey, cols) void * tdb SV * pkey HV * cols PREINIT: SV *sv; const char *pkbuf; char *kbuf, *vbuf; STRLEN pksiz, vsiz; I32 ksiz; TCMAP *tcols; CODE: pkbuf = SvPV(pkey, pksiz); tcols = tcmapnew2(31); hv_iterinit(cols); while((sv = hv_iternextsv(cols, &kbuf, &ksiz)) != NULL){ vbuf = SvPV(sv, vsiz); tcmapput(tcols, kbuf, ksiz, vbuf, vsiz); } RETVAL = tctdbputcat(tdb, pkbuf, pksiz, tcols); tcmapdel(tcols); OUTPUT: RETVAL int tdb_out(tdb, pkey) void * tdb SV * pkey PREINIT: const char *pkbuf; STRLEN pksiz; CODE: pkbuf = SvPV(pkey, pksiz); RETVAL = tctdbout(tdb, pkbuf, (int)pksiz); OUTPUT: RETVAL void tdb_get(tdb, pkey) void * tdb SV * pkey PREINIT: const char *pkbuf, *kbuf, *vbuf; STRLEN pksiz; int ksiz, vsiz; TCMAP *tcols; HV *cols; PPCODE: pkbuf = SvPV(pkey, pksiz); tcols = tctdbget(tdb, pkbuf, (int)pksiz); if(tcols){ cols = newHV(); tcmapiterinit(tcols); while((kbuf = tcmapiternext(tcols, &ksiz)) != NULL){ vbuf = tcmapiterval(kbuf, &vsiz); hv_store(cols, kbuf, ksiz, newSVpvn(vbuf, vsiz), 0); } tcmapdel(tcols); XPUSHs(sv_2mortal(newRV_noinc((SV *)cols))); } else { XPUSHs((SV *)&PL_sv_undef); } XSRETURN(1); int tdb_vsiz(tdb, pkey) void * tdb SV * pkey PREINIT: const char *pkbuf; STRLEN pksiz; CODE: pkbuf = SvPV(pkey, pksiz); RETVAL = tctdbvsiz(tdb, pkbuf, (int)pksiz); OUTPUT: RETVAL int tdb_iterinit(tdb) void * tdb CODE: RETVAL = tctdbiterinit(tdb); OUTPUT: RETVAL void tdb_iternext(tdb) void * tdb PREINIT: char *vbuf; int vsiz; PPCODE: vbuf = tctdbiternext(tdb, &vsiz); if(vbuf){ XPUSHs(sv_2mortal(newSVpvn(vbuf, vsiz))); tcfree(vbuf); } else { XPUSHs((SV *)&PL_sv_undef); } XSRETURN(1); void tdb_fwmkeys(tdb, prefix, max) void * tdb SV * prefix int max PREINIT: AV *av; STRLEN psiz; TCLIST *pkeys; const char *pbuf, *pkbuf; int i, pksiz; PPCODE: pbuf = SvPV(prefix, psiz); pkeys = tctdbfwmkeys(tdb, pbuf, (int)psiz, max); av = newAV(); for(i = 0; i < tclistnum(pkeys); i++){ pkbuf = tclistval(pkeys, i, &pksiz); av_push(av, newSVpvn(pkbuf, pksiz)); } tclistdel(pkeys); XPUSHs(sv_2mortal(newRV_noinc((SV *)av))); XSRETURN(1); void tdb_addint(tdb, pkey, num) void * tdb SV * pkey int num PREINIT: const char *pkbuf; STRLEN pksiz; PPCODE: pkbuf = SvPV(pkey, pksiz); num = tctdbaddint(tdb, pkbuf, (int)pksiz, num); if(num == INT_MIN){ XPUSHs((SV *)&PL_sv_undef); } else { XPUSHs(sv_2mortal(newSViv(num))); } XSRETURN(1); void tdb_adddouble(tdb, pkey, num) void * tdb SV * pkey double num PREINIT: const char *pkbuf; STRLEN pksiz; PPCODE: pkbuf = SvPV(pkey, pksiz); num = tctdbadddouble(tdb, pkbuf, (int)pksiz, num); if(isnan(num)){ XPUSHs((SV *)&PL_sv_undef); } else { XPUSHs(sv_2mortal(newSVnv(num))); } XSRETURN(1); int tdb_sync(tdb) void * tdb CODE: RETVAL = tctdbsync(tdb); OUTPUT: RETVAL int tdb_optimize(tdb, bnum, apow, fpow, opts) void * tdb double bnum int apow int fpow int opts CODE: RETVAL = tctdboptimize(tdb, bnum, apow, fpow, opts); OUTPUT: RETVAL int tdb_vanish(tdb) void * tdb CODE: RETVAL = tctdbvanish(tdb); OUTPUT: RETVAL int tdb_copy(tdb, path) void * tdb char * path CODE: RETVAL = tctdbcopy(tdb, path); OUTPUT: RETVAL int tdb_tranbegin(tdb) void * tdb CODE: RETVAL = tctdbtranbegin(tdb); OUTPUT: RETVAL int tdb_trancommit(tdb) void * tdb CODE: RETVAL = tctdbtrancommit(tdb); OUTPUT: RETVAL int tdb_tranabort(tdb) void * tdb CODE: RETVAL = tctdbtranabort(tdb); OUTPUT: RETVAL void tdb_path(tdb) void * tdb PREINIT: const char *path; PPCODE: path = tctdbpath(tdb); if(path){ XPUSHs(sv_2mortal(newSVpv(path, 0))); } else { XPUSHs((SV *)&PL_sv_undef); } XSRETURN(1); double tdb_rnum(tdb) void * tdb CODE: RETVAL = tctdbrnum(tdb); OUTPUT: RETVAL double tdb_fsiz(tdb) void * tdb CODE: RETVAL = tctdbfsiz(tdb); OUTPUT: RETVAL int tdb_setindex(tdb, name, type) void * tdb char * name int type CODE: RETVAL = tctdbsetindex(tdb, name, type); OUTPUT: RETVAL double tdb_genuid(tdb) void * tdb CODE: RETVAL = tctdbgenuid(tdb); OUTPUT: RETVAL void * tdbqry_new(tdb) void * tdb CODE: RETVAL = tctdbqrynew(tdb); OUTPUT: RETVAL void tdbqry_del(qry) void * qry CODE: tctdbqrydel(qry); void tdbqry_addcond(qry, name, op, expr) void * qry char * name int op char * expr CODE: tctdbqryaddcond(qry, name, op, expr); void tdbqry_setorder(qry, name, type) void * qry char * name int type CODE: tctdbqrysetorder(qry, name, type); void tdbqry_setlimit(qry, max, skip) void * qry int max int skip CODE: tctdbqrysetlimit(qry, max, skip); AV * tdbqry_search(qry) void * qry PREINIT: AV *av; TCLIST *pkeys; const char *pkbuf; int i, pksiz; CODE: pkeys = tctdbqrysearch(qry); av = newAV(); for(i = 0; i < tclistnum(pkeys); i++){ pkbuf = tclistval(pkeys, i, &pksiz); av_push(av, newSVpvn(pkbuf, pksiz)); } tclistdel(pkeys); RETVAL = (AV *)sv_2mortal((SV *)av); OUTPUT: RETVAL int tdbqry_searchout(qry) void * qry CODE: RETVAL = tctdbqrysearchout(qry); OUTPUT: RETVAL int tdbqry_proc(qry, proc) void * qry SV * proc CODE: RETVAL = tctdbqryproc(qry, (TDBQRYPROC)tdbqry_proc, proc); OUTPUT: RETVAL char * tdbqry_hint(qry) void * qry PREINIT: const char *hint; CODE: RETVAL = (char *)tctdbqryhint(qry); OUTPUT: RETVAL AV * tdbqry_metasearch(qry, others, type) void * qry AV * others int type PREINIT: SV *rqry; AV *av; TDBQRY **qrys, *tqry; TCLIST *pkeys; const char *pkbuf; int i, num, qnum, pksiz; CODE: num = av_len(others) + 1; qrys = tcmalloc(sizeof(*qrys) * (num + 1)); qnum = 0; qrys[qnum++] = qry; for(i = 0; i < num; i++){ rqry = *av_fetch(others, i, 0); if(sv_isobject(rqry) && sv_isa(rqry, "TokyoCabinet::TDBQRY")){ qrys[qnum++] = (TDBQRY *)SvIV(*av_fetch((AV *)SvRV(rqry), 0, 0)); } } pkeys = tctdbmetasearch(qrys, qnum, type); tcfree(qrys); av = newAV(); for(i = 0; i < tclistnum(pkeys); i++){ pkbuf = tclistval(pkeys, i, &pksiz); av_push(av, newSVpvn(pkbuf, pksiz)); } tclistdel(pkeys); RETVAL = (AV *)sv_2mortal((SV *)av); OUTPUT: RETVAL AV * tdbqry_kwic(qry, cols, name, width, opts) void * qry HV * cols char * name int width int opts PREINIT: SV *sv, **svp; AV *av; char *kbuf, *vbuf; const char *tbuf; STRLEN pksiz, vsiz; I32 ksiz; int i, tsiz; TCMAP *tcols; TCLIST *texts; CODE: tcols = tcmapnew2(31); if(!strcmp(name, "[[undef]]")){ hv_iterinit(cols); while((sv = hv_iternextsv(cols, &kbuf, &ksiz)) != NULL){ vbuf = SvPV(sv, vsiz); tcmapput(tcols, kbuf, ksiz, vbuf, vsiz); } name = NULL; } else { svp = hv_fetch(cols, name, strlen(name), 0); if(svp){ vbuf = SvPV(*svp, vsiz); tcmapput(tcols, name, strlen(name), vbuf, vsiz); } } texts = tctdbqrykwic(qry, tcols, name, width, opts); av = newAV(); for(i = 0; i < tclistnum(texts); i++){ tbuf = tclistval(texts, i, &tsiz); av_push(av, newSVpvn(tbuf, tsiz)); } tclistdel(texts); tcmapdel(tcols); RETVAL = (AV *)sv_2mortal((SV *)av); OUTPUT: RETVAL ##---------------------------------------------------------------- ## the abstract database API ##---------------------------------------------------------------- void * adb_new() PREINIT: TCADB *adb; CODE: adb = tcadbnew(); RETVAL = adb; OUTPUT: RETVAL void adb_del(adb) void * adb CODE: tcadbdel(adb); int adb_open(adb, name) void * adb char * name CODE: RETVAL = tcadbopen(adb, name); OUTPUT: RETVAL int adb_close(adb) void * adb CODE: RETVAL = tcadbclose(adb); OUTPUT: RETVAL int adb_put(adb, key, val) void * adb SV * key SV * val PREINIT: const char *kbuf, *vbuf; STRLEN ksiz, vsiz; CODE: kbuf = SvPV(key, ksiz); vbuf = SvPV(val, vsiz); RETVAL = tcadbput(adb, kbuf, (int)ksiz, vbuf, (int)vsiz); OUTPUT: RETVAL int adb_putkeep(adb, key, val) void * adb SV * key SV * val PREINIT: const char *kbuf, *vbuf; STRLEN ksiz, vsiz; CODE: kbuf = SvPV(key, ksiz); vbuf = SvPV(val, vsiz); RETVAL = tcadbputkeep(adb, kbuf, (int)ksiz, vbuf, (int)vsiz); OUTPUT: RETVAL int adb_putcat(adb, key, val) void * adb SV * key SV * val PREINIT: const char *kbuf, *vbuf; STRLEN ksiz, vsiz; CODE: kbuf = SvPV(key, ksiz); vbuf = SvPV(val, vsiz); RETVAL = tcadbputcat(adb, kbuf, (int)ksiz, vbuf, (int)vsiz); OUTPUT: RETVAL int adb_out(adb, key) void * adb SV * key PREINIT: const char *kbuf; STRLEN ksiz; CODE: kbuf = SvPV(key, ksiz); RETVAL = tcadbout(adb, kbuf, (int)ksiz); OUTPUT: RETVAL void adb_get(adb, key) void * adb SV * key PREINIT: const char *kbuf; STRLEN ksiz; char *vbuf; int vsiz; PPCODE: kbuf = SvPV(key, ksiz); vbuf = tcadbget(adb, kbuf, (int)ksiz, &vsiz); if(vbuf){ XPUSHs(sv_2mortal(newSVpvn(vbuf, vsiz))); tcfree(vbuf); } else { XPUSHs((SV *)&PL_sv_undef); } XSRETURN(1); int adb_vsiz(adb, key) void * adb SV * key PREINIT: const char *kbuf; STRLEN ksiz; CODE: kbuf = SvPV(key, ksiz); RETVAL = tcadbvsiz(adb, kbuf, (int)ksiz); OUTPUT: RETVAL int adb_iterinit(adb) void * adb CODE: RETVAL = tcadbiterinit(adb); OUTPUT: RETVAL void adb_iternext(adb) void * adb PREINIT: char *vbuf; int vsiz; PPCODE: vbuf = tcadbiternext(adb, &vsiz); if(vbuf){ XPUSHs(sv_2mortal(newSVpvn(vbuf, vsiz))); tcfree(vbuf); } else { XPUSHs((SV *)&PL_sv_undef); } XSRETURN(1); void adb_fwmkeys(adb, prefix, max) void * adb SV * prefix int max PREINIT: AV *av; STRLEN psiz; TCLIST *keys; const char *pbuf, *kbuf; int i, ksiz; PPCODE: pbuf = SvPV(prefix, psiz); keys = tcadbfwmkeys(adb, pbuf, (int)psiz, max); av = newAV(); for(i = 0; i < tclistnum(keys); i++){ kbuf = tclistval(keys, i, &ksiz); av_push(av, newSVpvn(kbuf, ksiz)); } tclistdel(keys); XPUSHs(sv_2mortal(newRV_noinc((SV *)av))); XSRETURN(1); void adb_addint(adb, key, num) void * adb SV * key int num PREINIT: const char *kbuf; STRLEN ksiz; PPCODE: kbuf = SvPV(key, ksiz); num = tcadbaddint(adb, kbuf, (int)ksiz, num); if(num == INT_MIN){ XPUSHs((SV *)&PL_sv_undef); } else { XPUSHs(sv_2mortal(newSViv(num))); } XSRETURN(1); void adb_adddouble(adb, key, num) void * adb SV * key double num PREINIT: const char *kbuf; STRLEN ksiz; PPCODE: kbuf = SvPV(key, ksiz); num = tcadbadddouble(adb, kbuf, (int)ksiz, num); if(isnan(num)){ XPUSHs((SV *)&PL_sv_undef); } else { XPUSHs(sv_2mortal(newSVnv(num))); } XSRETURN(1); int adb_sync(adb) void * adb CODE: RETVAL = tcadbsync(adb); OUTPUT: RETVAL int adb_optimize(adb, params) void * adb char * params CODE: RETVAL = tcadboptimize(adb, params); OUTPUT: RETVAL int adb_vanish(adb) void * adb CODE: RETVAL = tcadbvanish(adb); OUTPUT: RETVAL int adb_copy(adb, path) void * adb char * path CODE: RETVAL = tcadbcopy(adb, path); OUTPUT: RETVAL int adb_tranbegin(adb) void * adb CODE: RETVAL = tcadbtranbegin(adb); OUTPUT: RETVAL int adb_trancommit(adb) void * adb CODE: RETVAL = tcadbtrancommit(adb); OUTPUT: RETVAL int adb_tranabort(adb) void * adb CODE: RETVAL = tcadbtranabort(adb); OUTPUT: RETVAL void adb_path(adb) void * adb PREINIT: const char *path; PPCODE: path = tcadbpath(adb); if(path){ XPUSHs(sv_2mortal(newSVpv(path, 0))); } else { XPUSHs((SV *)&PL_sv_undef); } XSRETURN(1); double adb_rnum(adb) void * adb CODE: RETVAL = tcadbrnum(adb); OUTPUT: RETVAL double adb_size(adb) void * adb CODE: RETVAL = tcadbsize(adb); OUTPUT: RETVAL void adb_misc(adb, name, args) void * adb char * name AV * args PREINIT: SV *arg; AV *av; TCLIST *targs, *res; const char *abuf, *rbuf; STRLEN asiz; int i, num, rsiz; PPCODE: targs = tclistnew(); num = av_len(args) + 1; for(i = 0; i < num; i++){ arg = *av_fetch(args, i, 0); abuf = SvPV(arg, asiz); tclistpush(targs, abuf, (int)asiz); } res = tcadbmisc(adb, name, targs); tclistdel(targs); if(res){ av = newAV(); for(i = 0; i < tclistnum(res); i++){ rbuf = tclistval(res, i, &rsiz); av_push(av, newSVpvn(rbuf, rsiz)); } tclistdel(res); XPUSHs(sv_2mortal(newRV_noinc((SV *)av))); } else { XPUSHs((SV *)&PL_sv_undef); } XSRETURN(1); ## END OF FILE tokyocabinet-perl-1.34/Makefile.PL0000644000175000017500000000171711043315057016055 0ustar mikiomikio#================================================================================================= # Script for MakeMaker #================================================================================================= use ExtUtils::MakeMaker; use strict; use warnings; # check configuration my $home = $ENV{"HOME"}; $ENV{"PATH"} = $ENV{"PATH"} . ":/usr/local/bin:$home/bin:.:..:../.."; my $inc = `tcucodec conf -i 2>/dev/null`; chomp($inc); if(length($inc) < 2){ $inc = "-I/usr/local/include -I$home/include -I."; } my $libs = `tcucodec conf -l 2>/dev/null`; chomp($libs); if(length($libs) < 2){ $libs = "-L/usr/local/lib -L$home/lib -L. -ltokyocabinet -lz -lbz2 -lpthread -lm -lc"; } # Create Makefile WriteMakefile( 'NAME' => 'TokyoCabinet', 'VERSION_FROM' => 'TokyoCabinet.pm', 'INC' => $inc, 'LIBS' => $libs, 'clean' => { FILES => "casket* *~ hoge moge" }, ); # END OF FILE tokyocabinet-perl-1.34/META.yml0000644000175000017500000000045710720050566015356 0ustar mikiomikio# http://module-build.sourceforge.net/META-spec.html #XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX# name: TokyoCabinet version: 1.3 version_from: TokyoCabinet.pm installdirs: site requires: distribution_type: module generated_by: ExtUtils::MakeMaker version 6.17 tokyocabinet-perl-1.34/doc/0000755000175000017500000000000011445514314014645 5ustar mikiomikiotokyocabinet-perl-1.34/doc/index.html0000644000175000017500000036656411445514315016667 0ustar mikiomikio Tokyo Cabinet

      NAME

      TokyoCabinet - Perl Binding of Tokyo Cabinet

      SYNOPSYS

       use TokyoCabinet;

      INTRODUCTION

      Tokyo Cabinet is a library of routines for managing a database. The database is a simple data file containing records, each is a pair of a key and a value. Every key and value is serial bytes with variable length. Both binary data and character string can be used as a key and a value. There is neither concept of data tables nor data types. Records are organized in hash table, B+ tree, or fixed-length array.

      As for database of hash table, each key must be unique within a database, so it is impossible to store two or more records with a key overlaps. The following access methods are provided to the database: storing a record with a key and a value, deleting a record by a key, retrieving a record by a key. Moreover, traversal access to every key are provided, although the order is arbitrary. These access methods are similar to ones of DBM (or its followers: NDBM and GDBM) library defined in the UNIX standard. Tokyo Cabinet is an alternative for DBM because of its higher performance.

      As for database of B+ tree, records whose keys are duplicated can be stored. Access methods of storing, deleting, and retrieving are provided as with the database of hash table. Records are stored in order by a comparison function assigned by a user. It is possible to access each record with the cursor in ascending or descending order. According to this mechanism, forward matching search for strings and range search for integers are realized.

      As for database of fixed-length array, records are stored with unique natural numbers. It is impossible to store two or more records with a key overlaps. Moreover, the length of each record is limited by the specified length. Provided operations are the same as ones of hash database.

      Table database is also provided as a variant of hash database. Each record is identified by the primary key and has a set of named columns. Although there is no concept of data schema, it is possible to search for records with complex conditions efficiently by using indices of arbitrary columns.

      Setting

      Install the latest version of Tokyo Cabinet beforehand and get the package of the Perl binding of Tokyo Cabinet.

      Enter the directory of the extracted package then perform installation.

       perl Makefile.PL
 make
 make test
 su
 make install

      The package `TokyoCabinet' should be loaded in each source file of application programs.

       use TokyoCabinet;

      If you want to enable runtime assertion, set the variable `$TokyoCabinet::DEBUG' to be true.

       $TokyoCabinet::DEBUG = 1;

      EXAMPLE

      The following code is an example to use a hash database.

       use TokyoCabinet;
 use strict;
 use warnings;
 
 # create the object
 my $hdb = TokyoCabinet::HDB->new();
 
 # open the database
 if(!$hdb->open("casket.tch", $hdb->OWRITER | $hdb->OCREAT)){
     my $ecode = $hdb->ecode();
     printf STDERR ("open error: %s\n", $hdb->errmsg($ecode));
 }
 
 # store records
 if(!$hdb->put("foo", "hop") ||
    !$hdb->put("bar", "step") ||
    !$hdb->put("baz", "jump")){
     my $ecode = $hdb->ecode();
     printf STDERR ("put error: %s\n", $hdb->errmsg($ecode));
 }
 
 # retrieve records
 my $value = $hdb->get("foo");
 if(defined($value)){
     printf("%s\n", $value);
 } else {
     my $ecode = $hdb->ecode();
     printf STDERR ("get error: %s\n", $hdb->errmsg($ecode));
 }
 
 # traverse records
 $hdb->iterinit();
 while(defined(my $key = $hdb->iternext())){
     my $value = $hdb->get($key);
     if(defined($value)){
         printf("%s:%s\n", $key, $value);
     }
 }
 
 # close the database
 if(!$hdb->close()){
     my $ecode = $hdb->ecode();
     printf STDERR ("close error: %s\n", $hdb->errmsg($ecode));
 }
 
 # tying usage
 my %hash;
 if(!tie(%hash, "TokyoCabinet::HDB", "casket.tch", TokyoCabinet::HDB::OWRITER)){
     printf STDERR ("tie error\n");
 }
 $hash{"quux"} = "touchdown";
 printf("%s\n", $hash{"quux"});
 while(my ($key, $value) = each(%hash)){
     printf("%s:%s\n", $key, $value);
 }
 untie(%hash);

      The following code is an example to use a B+ tree database.

       use TokyoCabinet;
 use strict;
 use warnings;
 
 # create the object
 my $bdb = TokyoCabinet::BDB->new();
 
 # open the database
 if(!$bdb->open("casket.tcb", $bdb->OWRITER | $bdb->OCREAT)){
     my $ecode = $bdb->ecode();
     printf STDERR ("open error: %s\n", $bdb->errmsg($ecode));
 }
 
 # store records
 if(!$bdb->put("foo", "hop") ||
    !$bdb->put("bar", "step") ||
    !$bdb->put("baz", "jump")){
     my $ecode = $bdb->ecode();
     printf STDERR ("put error: %s\n", $bdb->errmsg($ecode));
 }
 
 # retrieve records
 my $value = $bdb->get("foo");
 if(defined($value)){
     printf("%s\n", $value);
 } else {
     my $ecode = $bdb->ecode();
     printf STDERR ("get error: %s\n", $bdb->errmsg($ecode));
 }
 
 # traverse records
 my $cur = TokyoCabinet::BDBCUR->new($bdb);
 $cur->first();
 while(defined(my $key = $cur->key())){
     my $value = $cur->val();
     if(defined($value)){
         printf("%s:%s\n", $key, $value);
     }
     $cur->next();
 }
 
 # close the database
 if(!$bdb->close()){
     my $ecode = $bdb->ecode();
     printf STDERR ("close error: %s\n", $bdb->errmsg($ecode));
 }
 
 # tying usage
 my %hash;
 if(!tie(%hash, "TokyoCabinet::BDB", "casket.tcb", TokyoCabinet::BDB::OWRITER)){
     printf STDERR ("tie error\n");
 }
 $hash{"quux"} = "touchdown";
 printf("%s\n", $hash{"quux"});
 while(my ($key, $value) = each(%hash)){
     printf("%s:%s\n", $key, $value);
 }
 untie(%hash);

      The following code is an example to use a fixed-length database.

       use TokyoCabinet;
 use strict;
 use warnings;
 
 # create the object
 my $fdb = TokyoCabinet::FDB->new();
 
 # open the database
 if(!$fdb->open("casket.tcf", $fdb->OWRITER | $fdb->OCREAT)){
     my $ecode = $fdb->ecode();
     printf STDERR ("open error: %s\n", $fdb->errmsg($ecode));
 }
 
 # store records
 if(!$fdb->put(1, "one") ||
    !$fdb->put(12, "twelve") ||
    !$fdb->put(144, "one forty four")){
     my $ecode = $fdb->ecode();
     printf STDERR ("put error: %s\n", $fdb->errmsg($ecode));
 }
 
 # retrieve records
 my $value = $fdb->get(1);
 if(defined($value)){
     printf("%s\n", $value);
 } else {
     my $ecode = $fdb->ecode();
     printf STDERR ("get error: %s\n", $fdb->errmsg($ecode));
 }
 
 # traverse records
 $fdb->iterinit();
 while(defined(my $key = $fdb->iternext())){
     my $value = $fdb->get($key);
     if(defined($value)){
         printf("%s:%s\n", $key, $value);
     }
 }
 
 # close the database
 if(!$fdb->close()){
     my $ecode = $fdb->ecode();
     printf STDERR ("close error: %s\n", $fdb->errmsg($ecode));
 }
 
 # tying usage
 my %hash;
 if(!tie(%hash, "TokyoCabinet::FDB", "casket.tcf", TokyoCabinet::FDB::OWRITER)){
     printf STDERR ("tie error\n");
 }
 $hash{1728} = "seventeen twenty eight";
 printf("%s\n", $hash{1728});
 while(my ($key, $value) = each(%hash)){
     printf("%s:%s\n", $key, $value);
 }
 untie(%hash);

      The following code is an example to use a table database.

       use TokyoCabinet;
 use strict;
 use warnings;
 
 # create the object
 my $tdb = TokyoCabinet::TDB->new();
 
 # open the database
 if(!$tdb->open("casket.tct", $tdb->OWRITER | $tdb->OCREAT)){
     my $ecode = $tdb->ecode();
     printf STDERR ("open error: %s\n", $tdb->errmsg($ecode));
 }
 
 # store a record
 my $pkey = $tdb->genuid();
 my $cols = { "name" => "mikio", "age" => "30", "lang" => "ja,en,c" };
 if(!$tdb->put($pkey, $cols)){
     my $ecode = $tdb->ecode();
     printf STDERR ("put error: %s\n", $tdb->errmsg($ecode));
 }
 
 # store another record
 $cols = { "name" => "falcon", "age" => "31", "lang" => "ja", "skill" => "cook,blog" };
 if(!$tdb->put("x12345", $cols)){
     my $ecode = $tdb->ecode();
     printf STDERR ("put error: %s\n", $tdb->errmsg($ecode));
 }
 
 # search for records
 my $qry = TokyoCabinet::TDBQRY->new($tdb);
 $qry->addcond("age", $qry->QCNUMGE, "20");
 $qry->addcond("lang", $qry->QCSTROR, "ja,en");
 $qry->setorder("name", $qry->QOSTRASC);
 $qry->setlimit(10);
 my $res = $qry->search();
 foreach my $rkey (@$res){
     my $rcols = $tdb->get($rkey);
     printf("name:%s\n", $rcols->{name});
 }
 
 # close the database
 if(!$tdb->close()){
     my $ecode = $tdb->ecode();
     printf STDERR ("close error: %s\n", $tdb->errmsg($ecode));
 }
 
 # tying usage
 my %hash;
 if(!tie(%hash, "TokyoCabinet::TDB", "casket.tct", TokyoCabinet::TDB::OWRITER)){
     printf STDERR ("tie error\n");
 }
 $hash{"joker"} = { "name" => "ozma", "lang" => "en", "skill" => "song,dance" };
 printf("%s\n", $hash{joker}->{name});
 while(my ($key, $value) = each(%hash)){
     printf("%s:%s\n", $key, $value->{name});
 }
 untie(%hash);

      The following code is an example to use an abstract database.

       use TokyoCabinet;
 use strict;
 use warnings;
 
 # create the object
 my $adb = TokyoCabinet::ADB->new();
 
 # open the database
 if(!$adb->open("casket.tch")){
     printf STDERR ("open error\n");
 }
 
 # store records
 if(!$adb->put("foo", "hop") ||
    !$adb->put("bar", "step") ||
    !$adb->put("baz", "jump")){
     printf STDERR ("put error\n");
 }
 
 # retrieve records
 my $value = $adb->get("foo");
 if(defined($value)){
     printf("%s\n", $value);
 } else {
     printf STDERR ("get error\n");
 }
 
 # traverse records
 $adb->iterinit();
 while(defined(my $key = $adb->iternext())){
     my $value = $adb->get($key);
     if(defined($value)){
         printf("%s:%s\n", $key, $value);
     }
 }
 
 # close the database
 if(!$adb->close()){
     printf STDERR ("close error\n");
 }
 
 # tying usage
 my %hash;
 if(!tie(%hash, "TokyoCabinet::ADB", "casket.tch")){
     printf STDERR ("tie error\n");
 }
 $hash{"quux"} = "touchdown";
 printf("%s\n", $hash{"quux"});
 while(my ($key, $value) = each(%hash)){
     printf("%s:%s\n", $key, $value);
 }
 untie(%hash);

      DESCRIPTION

      Class TokyoCabinet

      The following functions are utilities to handle records by applications.

      TokyoCabinet::VERSION()

      Get the version information of Tokyo Cabinet.
      The return value is the version information.

      TokyoCabinet::atoi(str)

      Convert a string to an integer.
      The return value is the integer value.

      TokyoCabinet::atof(str)

      Convert a string to a real number.
      The return value is the real number value.

      TokyoCabinet::bercompress(aryref)

      Serialize an array of nonnegative integers with BER encoding.
      `aryref' specifies the reference to an array of nonnegative integers.
      The return value is the reference to the serialized scalar.

      TokyoCabinet::beruncompress(selref)

      Deserialize a BER encoded scalar to an array.
      `selref' specifies the reference to the BER encoded scalar.
      The return value is the reference to the array of nonnegative integers.

      TokyoCabinet::diffcompress(aryref)

      Serialize an array of sorted nonnegative integers with difference BER encoding.
      `aryref' specifies the reference to an array of sorted nonnegative integers.
      The return value is the reference to the serialized scalar.

      TokyoCabinet::diffuncompress(selref)

      Deserialize a difference BER encoded scalar to an array.
      `selref' specifies the reference to the BER encoded scalar.
      The return value is the reference to the array of sorted nonnegative integers.

      TokyoCabinet::strdistance(aref, bref, isutf)

      Calculate the edit distance of two strings.
      `aref' specifies the reference to a string.
      `bref' specifies the reference to the other string.
      `isutf' specifies whether the cost is calculated by Unicode character of UTF-8 strings.
      The return value is the edit distance which is known as the Levenshtein distance.

      Class TokyoCabinet::HDB

      Hash database is a file containing a hash table and is handled with the hash database API. Before operations to store or retrieve records, it is necessary to open a database file and connect the hash database object to it. The method `open' is used to open a database file and the method `close' is used to close the database file. To avoid data missing or corruption, it is important to close every database file when it is no longer in use. It is forbidden for multible database objects in a process to open the same database at the same time.

      $hdb = TokyoCabinet::HDB->new()

      Create a hash database object.
      The return value is the new hash database object.

      $hdb->errmsg(ecode)

      Get the message string corresponding to an error code.
      `ecode' specifies the error code. If it is not defined or negative, the last happened error code is specified.
      The return value is the message string of the error code.

      $hdb->ecode()

      Get the last happened error code.
      The return value is the last happened error code.
      The following error codes are defined: `$hdb->ESUCCESS' for success, `$hdb->ETHREAD' for threading error, `$hdb->EINVALID' for invalid operation, `$hdb->ENOFILE' for file not found, `$hdb->ENOPERM' for no permission, `$hdb->EMETA' for invalid meta data, `$hdb->ERHEAD' for invalid record header, `$hdb->EOPEN' for open error, `$hdb->ECLOSE' for close error, `$hdb->ETRUNC' for trunc error, `$hdb->ESYNC' for sync error, `$hdb->ESTAT' for stat error, `$hdb->ESEEK' for seek error, `$hdb->EREAD' for read error, `$hdb->EWRITE' for write error, `$hdb->EMMAP' for mmap error, `$hdb->ELOCK' for lock error, `$hdb->EUNLINK' for unlink error, `$hdb->ERENAME' for rename error, `$hdb->EMKDIR' for mkdir error, `$hdb->ERMDIR' for rmdir error, `$hdb->EKEEP' for existing record, `$hdb->ENOREC' for no record found, and `$hdb->EMISC' for miscellaneous error.

      $hdb->tune(bnum, apow, fpow, opts)

      Set the tuning parameters.
      `bnum' specifies the number of elements of the bucket array. If it is not defined or not more than 0, the default value is specified. The default value is 131071. Suggested size of the bucket array is about from 0.5 to 4 times of the number of all records to be stored.
      `apow' specifies the size of record alignment by power of 2. If it is not defined or negative, the default value is specified. The default value is 4 standing for 2^4=16.
      `fpow' specifies the maximum number of elements of the free block pool by power of 2. If it is not defined or negative, the default value is specified. The default value is 10 standing for 2^10=1024.
      `opts' specifies options by bitwise-or: `$hdb->TLARGE' specifies that the size of the database can be larger than 2GB by using 64-bit bucket array, `$hdb->TDEFLATE' specifies that each record is compressed with Deflate encoding, `$hdb->TBZIP' specifies that each record is compressed with BZIP2 encoding, `$hdb->TTCBS' specifies that each record is compressed with TCBS encoding. If it is not defined, no option is specified.
      If successful, the return value is true, else, it is false. Note that the tuning parameters of the database should be set before the database is opened.

      $hdb->setcache(rcnum)

      Set the caching parameters.
      `rcnum' specifies the maximum number of records to be cached. If it is not defined or not more than 0, the record cache is disabled. It is disabled by default.
      If successful, the return value is true, else, it is false.
      Note that the caching parameters of the database should be set before the database is opened.

      $hdb->setxmsiz(xmsiz)

      Set the size of the extra mapped memory.
      `xmsiz' specifies the size of the extra mapped memory. If it is not defined or not more than 0, the extra mapped memory is disabled. The default size is 67108864.
      If successful, the return value is true, else, it is false.
      Note that the mapping parameters should be set before the database is opened.

      $hdb->setdfunit(dfunit)

      Set the unit step number of auto defragmentation.
      `dfunit' specifie the unit step number. If it is not more than 0, the auto defragmentation is disabled. It is disabled by default.
      If successful, the return value is true, else, it is false.
      Note that the defragmentation parameters should be set before the database is opened.

      $hdb->open(path, omode)

      Open a database file.
      `path' specifies the path of the database file.
      `omode' specifies the connection mode: `$hdb->OWRITER' as a writer, `$hdb->OREADER' as a reader. If the mode is `$hdb->OWRITER', the following may be added by bitwise-or: `$hdb->OCREAT', which means it creates a new database if not exist, `$hdb->OTRUNC', which means it creates a new database regardless if one exists, `$hdb->OTSYNC', which means every transaction synchronizes updated contents with the device. Both of `$hdb->OREADER' and `$hdb->OWRITER' can be added to by bitwise-or: `$hdb->ONOLCK', which means it opens the database file without file locking, or `$hdb->OLCKNB', which means locking is performed without blocking. If it is not defined, `$hdb->OREADER' is specified.
      If successful, the return value is true, else, it is false.

      $hdb->close()

      Close the database file.
      If successful, the return value is true, else, it is false.
      Update of a database is assured to be written when the database is closed. If a writer opens a database but does not close it appropriately, the database will be broken.

      $hdb->put(key, value)

      Store a record.
      `key' specifies the key.
      `value' specifies the value.
      If successful, the return value is true, else, it is false.
      If a record with the same key exists in the database, it is overwritten.

      $hdb->putkeep(key, value)

      Store a new record.
      `key' specifies the key.
      `value' specifies the value.
      If successful, the return value is true, else, it is false.
      If a record with the same key exists in the database, this method has no effect.

      $hdb->putcat(key, value)

      Concatenate a value at the end of the existing record.
      `key' specifies the key.
      `value' specifies the value.
      If successful, the return value is true, else, it is false.
      If there is no corresponding record, a new record is created.

      $hdb->putasync(key, value)

      Store a record in asynchronous fashion.
      `key' specifies the key.
      `value' specifies the value.
      If successful, the return value is true, else, it is false.
      If a record with the same key exists in the database, it is overwritten. Records passed to this method are accumulated into the inner buffer and wrote into the file at a blast.

      $hdb->out(key)

      Remove a record.
      `key' specifies the key.
      If successful, the return value is true, else, it is false.

      $hdb->get(key)

      Retrieve a record.
      `key' specifies the key.
      If successful, the return value is the value of the corresponding record. `undef' is returned if no record corresponds.

      $hdb->vsiz(key)

      Get the size of the value of a record.
      `key' specifies the key.
      If successful, the return value is the size of the value of the corresponding record, else, it is -1.

      $hdb->iterinit()

      Initialize the iterator.
      If successful, the return value is true, else, it is false.
      The iterator is used in order to access the key of every record stored in a database.

      $hdb->iternext()

      Get the next key of the iterator.
      If successful, the return value is the next key, else, it is `undef'. `undef' is returned when no record is to be get out of the iterator.
      It is possible to access every record by iteration of calling this method. It is allowed to update or remove records whose keys are fetched while the iteration. However, it is not assured if updating the database is occurred while the iteration. Besides, the order of this traversal access method is arbitrary, so it is not assured that the order of storing matches the one of the traversal access.

      $hdb->fwmkeys(prefix, max)

      Get forward matching keys.
      `prefix' specifies the prefix of the corresponding keys.
      `max' specifies the maximum number of keys to be fetched. If it is not defined or negative, no limit is specified.
      The return value is the reference to an array of the keys of the corresponding records. This method does never fail. It returns an empty array even if no record corresponds.
      Note that this method may be very slow because every key in the database is scanned.

      $hdb->addint(key, num)

      Add an integer to a record.
      `key' specifies the key.
      `num' specifies the additional value.
      If successful, the return value is the summation value, else, it is `undef'.
      If the corresponding record exists, the value is treated as an integer and is added to. If no record corresponds, a new record of the additional value is stored. Because records are stored in binary format, they should be processed with the `unpack' function with the `i' operator after retrieval.

      $hdb->adddouble(key, num)

      Add a real number to a record.
      `key' specifies the key.
      `num' specifies the additional value.
      If successful, the return value is the summation value, else, it is `undef'.
      If the corresponding record exists, the value is treated as a real number and is added to. If no record corresponds, a new record of the additional value is stored. Because records are stored in binary format, they should be processed with the `unpack' function with the `d' operator after retrieval.

      $hdb->sync()

      Synchronize updated contents with the file and the device.
      If successful, the return value is true, else, it is false.
      This method is useful when another process connects the same database file.

      $hdb->optimize(bnum, apow, fpow, opts)

      Optimize the database file.
      `bnum' specifies the number of elements of the bucket array. If it is not defined or not more than 0, the default value is specified. The default value is two times of the number of records.
      `apow' specifies the size of record alignment by power of 2. If it is not defined or negative, the current setting is not changed.
      `fpow' specifies the maximum number of elements of the free block pool by power of 2. If it is not defined or negative, the current setting is not changed.
      `opts' specifies options by bitwise-or: `$hdb->TLARGE' specifies that the size of the database can be larger than 2GB by using 64-bit bucket array, `$hdb->TDEFLATE' specifies that each record is compressed with Deflate encoding, `$hdb->TBZIP' specifies that each record is compressed with BZIP2 encoding, `$hdb->TTCBS' specifies that each record is compressed with TCBS encoding. If it is not defined or 0xff, the current setting is not changed.
      If successful, the return value is true, else, it is false.
      This method is useful to reduce the size of the database file with data fragmentation by successive updating.

      $hdb->vanish()

      Remove all records.
      If successful, the return value is true, else, it is false.

      $hdb->copy(path)

      Copy the database file.
      `path' specifies the path of the destination file. If it begins with `@', the trailing substring is executed as a command line.
      If successful, the return value is true, else, it is false. False is returned if the executed command returns non-zero code.
      The database file is assured to be kept synchronized and not modified while the copying or executing operation is in progress. So, this method is useful to create a backup file of the database file.

      $hdb->tranbegin()

      Begin the transaction.
      If successful, the return value is true, else, it is false.
      The database is locked by the thread while the transaction so that only one transaction can be activated with a database object at the same time. Thus, the serializable isolation level is assumed if every database operation is performed in the transaction. All updated regions are kept track of by write ahead logging while the transaction. If the database is closed during transaction, the transaction is aborted implicitly.

      $hdb->trancommit()

      Commit the transaction.
      If successful, the return value is true, else, it is false.
      Update in the transaction is fixed when it is committed successfully.

      $hdb->tranabort()

      Abort the transaction.
      If successful, the return value is true, else, it is false.
      Update in the transaction is discarded when it is aborted. The state of the database is rollbacked to before transaction.

      $hdb->path()

      Get the path of the database file.
      The return value is the path of the database file or `undef' if the object does not connect to any database file.

      $hdb->rnum()

      Get the number of records.
      The return value is the number of records or 0 if the object does not connect to any database file.

      $hdb->fsiz()

      Get the size of the database file.
      The return value is the size of the database file or 0 if the object does not connect to any database file.

      Tying functions of TokyoCabinet::HDB

      tie(%hash, "TokyoCabinet::HDB", path, omode, bnum, apow, fpow, opts, rcnum)

      Tie a hash variable to a hash database file.
      `path' specifies the path of the database file.
      `omode' specifies the connection mode: `TokyoCabinet::HDB::OWRITER' as a writer, `TokyoCabinet::HDB::OREADER' as a reader. If the mode is `TokyoCabinet::HDB::OWRITER', the following may be added by bitwise-or: `TokyoCabinet::HDB::OCREAT', which means it creates a new database if not exist, `TokyoCabinet::HDB::OTRUNC', which means it creates a new database regardless if one exists, `TokyoCabinet::HDB::OTSYNC', which means every transaction synchronizes updated contents with the device. Both of `TokyoCabinet::HDB::OREADER' and `TokyoCabinet::HDB::OWRITER' can be added to by bitwise-or: `TokyoCabinet::HDB::ONOLCK', which means it opens the database file without file locking, or `TokyoCabinet::HDB::OLCKNB', which means locking is performed without blocking. If it is not defined, `TokyoCabinet::HDB::OREADER' is specified.
      `bnum' specifies the number of elements of the bucket array. If it is not defined or not more than 0, the default value is specified. The default value is 131071. Suggested size of the bucket array is about from 0.5 to 4 times of the number of all records to be stored.
      `apow' specifies the size of record alignment by power of 2. If it is not defined or negative, the default value is specified. The default value is 4 standing for 2^4=16.
      `fpow' specifies the maximum number of elements of the free block pool by power of 2. If it is not defined or negative, the default value is specified. The default value is 10 standing for 2^10=1024.
      `opts' specifies options by bitwise-or: `TokyoCabinet::HDB::TLARGE' specifies that the size of the database can be larger than 2GB by using 64-bit bucket array, `TokyoCabinet::HDB::TDEFLATE' specifies that each record is compressed with Deflate encoding, `TokyoCabinet::HDB::TBZIP' specifies that each record is compressed with BZIP2 encoding, `TokyoCabinet::HDB::TTCBS' specifies that each record is compressed with TCBS encoding. If it is not defined, no option is specified.
      `rcnum' specifies the maximum number of records to be cached. If it is not defined or not more than 0, the record cache is disabled. It is disabled by default.
      If successful, the return value is true, else, it is false.

      untie(%hash)

      Untie a hash variable from the database file.
      The return value is always true.

      $hash{key} = value

      Store a record.
      `key' specifies the key.
      `value' specifies the value.
      If successful, the return value is true, else, it is false.
      If a record with the same key exists in the database, it is overwritten.

      delete($hash{key})

      Remove a record.
      `key' specifies the key.
      If successful, the return value is true, else, it is false.

      $hash{key}

      Retrieve a record.
      `key' specifies the key.
      If successful, the return value is the value of the corresponding record. `undef' is returned if no record corresponds.

      exists($hash{key})

      Check whether a record corrsponding a key exists.
      `key' specifies the key.
      The return value is true if the record exists, else it is false.

      $hash = ()

      Remove all records.
      The return value is always `undef'.

      (the iterator)

      The inner methods `FIRSTKEY' and `NEXTKEY' are also implemented so that you can use the tying functions `each', `keys', and so on.

      Class TokyoCabinet::BDB

      B+ tree database is a file containing a B+ tree and is handled with the B+ tree database API. Before operations to store or retrieve records, it is necessary to open a database file and connect the B+ tree database object to it. The method `open' is used to open a database file and the method `close' is used to close the database file. To avoid data missing or corruption, it is important to close every database file when it is no longer in use. It is forbidden for multible database objects in a process to open the same database at the same time.

      $bdb = TokyoCabinet::BDB->new()

      Create a B+ tree database object.
      The return value is the new B+ tree database object.

      $bdb->errmsg(ecode)

      Get the message string corresponding to an error code.
      `ecode' specifies the error code. If it is not defined or negative, the last happened error code is specified.
      The return value is the message string of the error code.

      $bdb->ecode()

      Get the last happened error code.
      The return value is the last happened error code.
      The following error codes are defined: `$bdb->ESUCCESS' for success, `$bdb->ETHREAD' for threading error, `$bdb->EINVALID' for invalid operation, `$bdb->ENOFILE' for file not found, `$bdb->ENOPERM' for no permission, `$bdb->EMETA' for invalid meta data, `$bdb->ERHEAD' for invalid record header, `$bdb->EOPEN' for open error, `$bdb->ECLOSE' for close error, `$bdb->ETRUNC' for trunc error, `$bdb->ESYNC' for sync error, `$bdb->ESTAT' for stat error, `$bdb->ESEEK' for seek error, `$bdb->EREAD' for read error, `$bdb->EWRITE' for write error, `$bdb->EMMAP' for mmap error, `$bdb->ELOCK' for lock error, `$bdb->EUNLINK' for unlink error, `$bdb->ERENAME' for rename error, `$bdb->EMKDIR' for mkdir error, `$bdb->ERMDIR' for rmdir error, `$bdb->EKEEP' for existing record, `$bdb->ENOREC' for no record found, and `$bdb->EMISC' for miscellaneous error.

      $bdb->setcmpfunc(cmp)

      Set the custom comparison function.
      `cmp' specifies the custom comparison function. It can be either the reference of a block or the name of a function.
      If successful, the return value is true, else, it is false.
      The default comparison function compares keys of two records by lexical order. The constants `$bdb->CMPLEXICAL' (dafault), `$bdb->CMPDECIMAL', `$bdb->CMPINT32', and `$bdb->CMPINT64' are built-in. Note that the comparison function should be set before the database is opened. Moreover, user-defined comparison functions should be set every time the database is being opened.

      $bdb->tune(lmemb, nmemb, bnum, apow, fpow, opts)

      Set the tuning parameters.
      `lmemb' specifies the number of members in each leaf page. If it is not defined or not more than 0, the default value is specified. The default value is 128.
      `nmemb' specifies the number of members in each non-leaf page. If it is not defined or not more than 0, the default value is specified. The default value is 256.
      `bnum' specifies the number of elements of the bucket array. If it is not defined or not more than 0, the default value is specified. The default value is 32749. Suggested size of the bucket array is about from 1 to 4 times of the number of all pages to be stored.
      `apow' specifies the size of record alignment by power of 2. If it is not defined or negative, the default value is specified. The default value is 4 standing for 2^8=256.
      `fpow' specifies the maximum number of elements of the free block pool by power of 2. If it is not defined or negative, the default value is specified. The default value is 10 standing for 2^10=1024.
      `opts' specifies options by bitwise-or: `$bdb->TLARGE' specifies that the size of the database can be larger than 2GB by using 64-bit bucket array, `$bdb->TDEFLATE' specifies that each record is compressed with Deflate encoding, `$bdb->TBZIP' specifies that each record is compressed with BZIP2 encoding, `$bdb->TTCBS' specifies that each record is compressed with TCBS encoding. If it is not defined, no option is specified.
      If successful, the return value is true, else, it is false. Note that the tuning parameters of the database should be set before the database is opened.

      $bdb->setcache(lcnum, ncnum)

      Set the caching parameters.
      `lcnum' specifies the maximum number of leaf nodes to be cached. If it is not defined or not more than 0, the default value is specified. The default value is 1024.
      `ncnum' specifies the maximum number of non-leaf nodes to be cached. If it is not defined or not more than 0, the default value is specified. The default value is 512.
      If successful, the return value is true, else, it is false.
      Note that the caching parameters of the database should be set before the database is opened.

      $bdb->setxmsiz(xmsiz)

      Set the size of the extra mapped memory.
      `xmsiz' specifies the size of the extra mapped memory. If it is not defined or not more than 0, the extra mapped memory is disabled. It is disabled by default.
      If successful, the return value is true, else, it is false.
      Note that the mapping parameters should be set before the database is opened.

      $bdb->setdfunit(dfunit)

      Set the unit step number of auto defragmentation.
      `dfunit' specifie the unit step number. If it is not more than 0, the auto defragmentation is disabled. It is disabled by default.
      If successful, the return value is true, else, it is false.
      Note that the defragmentation parameters should be set before the database is opened.

      $bdb->open(path, omode)

      Open a database file.
      `path' specifies the path of the database file.
      `omode' specifies the connection mode: `$bdb->OWRITER' as a writer, `$bdb->OREADER' as a reader. If the mode is `$bdb->OWRITER', the following may be added by bitwise-or: `$bdb->OCREAT', which means it creates a new database if not exist, `$bdb->OTRUNC', which means it creates a new database regardless if one exists, `$bdb->OTSYNC', which means every transaction synchronizes updated contents with the device. Both of `$bdb->OREADER' and `$bdb->OWRITER' can be added to by bitwise-or: `$bdb->ONOLCK', which means it opens the database file without file locking, or `$bdb->OLCKNB', which means locking is performed without blocking. If it is not defined, `$bdb->OREADER' is specified.
      If successful, the return value is true, else, it is false.

      $bdb->close()

      Close the database file.
      If successful, the return value is true, else, it is false.
      Update of a database is assured to be written when the database is closed. If a writer opens a database but does not close it appropriately, the database will be broken.

      $bdb->put(key, value)

      Store a record.
      `key' specifies the key.
      `value' specifies the value.
      If successful, the return value is true, else, it is false.
      If a record with the same key exists in the database, it is overwritten.

      $bdb->putkeep(key, value)

      Store a new record.
      `key' specifies the key.
      `value' specifies the value.
      If successful, the return value is true, else, it is false.
      If a record with the same key exists in the database, this method has no effect.

      $bdb->putcat(key, value)

      Concatenate a value at the end of the existing record.
      `key' specifies the key.
      `value' specifies the value.
      If successful, the return value is true, else, it is false.
      If there is no corresponding record, a new record is created.

      $bdb->putdup(key, value)

      Store a record with allowing duplication of keys.
      `key' specifies the key.
      `value' specifies the value.
      If successful, the return value is true, else, it is false.
      If a record with the same key exists in the database, the new record is placed after the existing one.

      $bdb->putlist(key, values)

      Store records with allowing duplication of keys.
      `key' specifies the key.
      `values' specifies the reference to an array of the values.
      If successful, the return value is true, else, it is false.
      If a record with the same key exists in the database, the new records are placed after the existing one.

      $bdb->out(key)

      Remove a record.
      `key' specifies the key.
      If successful, the return value is true, else, it is false.
      If the key of duplicated records is specified, the first one is selected.

      $bdb->outlist(key)

      Remove records.
      `key' specifies the key.
      If successful, the return value is true, else, it is false.
      If the key of duplicated records is specified, all of them are removed.

      $bdb->get(key)

      Retrieve a record.
      `key' specifies the key.
      If successful, the return value is the value of the corresponding record. `undef' is returned if no record corresponds.
      If the key of duplicated records is specified, the first one is selected.

      $bdb->getlist(key)

      Retrieve records.
      `key' specifies the key.
      If successful, the return value is the reference to an array of the values of the corresponding records. `undef' is returned if no record corresponds.

      $bdb->vnum(key)

      Get the number of records corresponding a key.
      `key' specifies the key.
      If successful, the return value is the number of the corresponding records, else, it is 0.

      $bdb->vsiz(key)

      Get the size of the value of a record.
      `key' specifies the key.
      If successful, the return value is the size of the value of the corresponding record, else, it is -1.
      If the key of duplicated records is specified, the first one is selected.

      $bdb->range(bkey, binc, ekey, einc, max)

      Get keys of ranged records.
      `bkey' specifies the key of the beginning border. If it is not defined, the first record is specified.
      `binc' specifies whether the beginning border is inclusive or not. If it is not defined, false is specified.
      `ekey' specifies the key of the ending border. If it is not defined, the last record is specified.
      `einc' specifies whether the ending border is inclusive or not. If it is not defined, false is specified.
      `max' specifies the maximum number of keys to be fetched. If it is not defined or negative, no limit is specified.
      The return value is the reference to an array of the keys of the corresponding records. This method does never fail. It returns an empty array even if no record corresponds.

      $bdb->fwmkeys(prefix, max)

      Get forward matching keys.
      `prefix' specifies the prefix of the corresponding keys.
      `max' specifies the maximum number of keys to be fetched. If it is not defined or negative, no limit is specified.
      The return value is the reference to an array of the keys of the corresponding records. This method does never fail. It returns an empty array even if no record corresponds.

      $bdb->addint(key, num)

      Add an integer to a record.
      `key' specifies the key.
      `num' specifies the additional value.
      If successful, the return value is the summation value, else, it is `undef'.
      If the corresponding record exists, the value is treated as an integer and is added to. If no record corresponds, a new record of the additional value is stored. Because records are stored in binary format, they should be processed with the `unpack' function with the `i' operator after retrieval.

      $bdb->adddouble(key, num)

      Add a real number to a record.
      `key' specifies the key.
      `num' specifies the additional value.
      If successful, the return value is the summation value, else, it is `undef'.
      If the corresponding record exists, the value is treated as a real number and is added to. If no record corresponds, a new record of the additional value is stored. Because records are stored in binary format, they should be processed with the `unpack' function with the `d' operator after retrieval.

      $bdb->sync()

      Synchronize updated contents with the file and the device.
      If successful, the return value is true, else, it is false.
      This method is useful when another process connects the same database file.

      $bdb->optimize(lmemb, nmemb, bnum, apow, fpow, opts)

      Optimize the database file.
      `lmemb' specifies the number of members in each leaf page. If it is not defined or not more than 0, the current setting is not changed.
      `nmemb' specifies the number of members in each non-leaf page. If it is not defined or not more than 0, the current setting is not changed.
      `bnum' specifies the number of elements of the bucket array. If it is not defined or not more than 0, the default value is specified. The default value is two times of the number of pages.
      `apow' specifies the size of record alignment by power of 2. If it is not defined or negative, the current setting is not changed.
      `fpow' specifies the maximum number of elements of the free block pool by power of 2. If it is not defined or negative, the current setting is not changed.
      `opts' specifies options by bitwise-or: `$bdb->TLARGE' specifies that the size of the database can be larger than 2GB by using 64-bit bucket array, `$bdb->TDEFLATE' specifies that each record is compressed with Deflate encoding, `$bdb->TBZIP' specifies that each record is compressed with BZIP2 encoding, `$bdb->TTCBS' specifies that each record is compressed with TCBS encoding. If it is not defined or 0xff, the current setting is not changed.
      If successful, the return value is true, else, it is false.
      This method is useful to reduce the size of the database file with data fragmentation by successive updating.

      $bdb->vanish()

      Remove all records.
      If successful, the return value is true, else, it is false.

      $bdb->copy(path)

      Copy the database file.
      `path' specifies the path of the destination file. If it begins with `@', the trailing substring is executed as a command line.
      If successful, the return value is true, else, it is false. False is returned if the executed command returns non-zero code.
      The database file is assured to be kept synchronized and not modified while the copying or executing operation is in progress. So, this method is useful to create a backup file of the database file.

      $bdb->tranbegin()

      Begin the transaction.
      If successful, the return value is true, else, it is false.
      The database is locked by the thread while the transaction so that only one transaction can be activated with a database object at the same time. Thus, the serializable isolation level is assumed if every database operation is performed in the transaction. Because all pages are cached on memory while the transaction, the amount of referred records is limited by the memory capacity. If the database is closed during transaction, the transaction is aborted implicitly.

      $bdb->trancommit()

      Commit the transaction.
      If successful, the return value is true, else, it is false.
      Update in the transaction is fixed when it is committed successfully.

      $bdb->tranabort()

      Abort the transaction.
      If successful, the return value is true, else, it is false.
      Update in the transaction is discarded when it is aborted. The state of the database is rollbacked to before transaction.

      $bdb->path()

      Get the path of the database file.
      The return value is the path of the database file or `undef' if the object does not connect to any database file.

      $bdb->rnum()

      Get the number of records.
      The return value is the number of records or 0 if the object does not connect to any database file.

      $bdb->fsiz()

      Get the size of the database file.
      The return value is the size of the database file or 0 if the object does not connect to any database file.

      Class TokyoCabinet::BDBCUR

      $cur = TokyoCabinet::BDBCUR->new(bdb)

      Create a cursor object.
      `bdb' specifies the B+ tree database object.
      The return value is the new cursor object.
      Note that the cursor is available only after initialization with the `first' or the `jump' methods and so on. Moreover, the position of the cursor will be indefinite when the database is updated after the initialization of the cursor.

      $cur->first()

      Move the cursor to the first record.
      If successful, the return value is true, else, it is false. False is returned if there is no record in the database.

      $cur->last()

      Move the cursor to the last record.
      If successful, the return value is true, else, it is false. False is returned if there is no record in the database.

      $cur->jump(key)

      Move the cursor to the front of records corresponding a key.
      `key' specifies the key.
      If successful, the return value is true, else, it is false. False is returned if there is no record corresponding the condition.
      The cursor is set to the first record corresponding the key or the next substitute if completely matching record does not exist.

      $cur->prev()

      Move the cursor to the previous record.
      If successful, the return value is true, else, it is false. False is returned if there is no previous record.

      $cur->next()

      Move the cursor to the next record.
      If successful, the return value is true, else, it is false. False is returned if there is no next record.

      $cur->put(value, cpmode)

      Insert a record around the cursor.
      `value' specifies the value.
      `cpmode' specifies detail adjustment: `$cur->CPCURRENT', which means that the value of the current record is overwritten, `$cur->CPBEFORE', which means that the new record is inserted before the current record, `$cur->CPAFTER', which means that the new record is inserted after the current record.
      If successful, the return value is true, else, it is false. False is returned when the cursor is at invalid position.
      After insertion, the cursor is moved to the inserted record.

      $cur->out()

      Remove the record where the cursor is.
      If successful, the return value is true, else, it is false. False is returned when the cursor is at invalid position.
      After deletion, the cursor is moved to the next record if possible.

      $cur->key()

      Get the key of the record where the cursor is.
      If successful, the return value is the key, else, it is `undef'. 'undef' is returned when the cursor is at invalid position.

      $cur->val()

      Get the value of the record where the cursor is.
      If successful, the return value is the value, else, it is `undef'. 'undef' is returned when the cursor is at invalid position.

      Tying functions of TokyoCabinet::BDB

      tie(%hash, "TokyoCabinet::BDB", path, omode, lmemb, nmemb, bnum, apow, fpow, opts, lcnum, ncnum)

      Tie a hash variable to a B+ tree database file.
      `path' specifies the path of the database file.
      `omode' specifies the connection mode: `TokyoCabinet::BDB::OWRITER' as a writer, `TokyoCabinet::BDB::OREADER' as a reader. If the mode is `TokyoCabinet::BDB::OWRITER', the following may be added by bitwise-or: `TokyoCabinet::BDB::OCREAT', which means it creates a new database if not exist, `TokyoCabinet::BDB::OTRUNC', which means it creates a new database regardless if one exists, `TokyoCabinet::BDB::OTSYNC', which means every transaction synchronizes updated contents with the device. Both of `TokyoCabinet::BDB::OREADER' and `TokyoCabinet::BDB::OWRITER' can be added to by bitwise-or: `TokyoCabinet::BDB::ONOLCK', which means it opens the database file without file locking, or `TokyoCabinet::BDB::OLCKNB', which means locking is performed without blocking. If it is not defined, `TokyoCabinet::BDB::OREADER' is specified.
      `lmemb' specifies the number of members in each leaf page. If it is not defined or not more than 0, the default value is specified. The default value is 128.
      `nmemb' specifies the number of members in each non-leaf page. If it is not defined or not more than 0, the default value is specified. The default value is 256.
      `bnum' specifies the number of elements of the bucket array. If it is not defined or not more than 0, the default value is specified. The default value is 32749.
      `apow' specifies the size of record alignment by power of 2. If it is not defined or negative, the default value is specified. The default value is 4 standing for 2^8=256.
      `fpow' specifies the maximum number of elements of the free block pool by power of 2. If it is not defined or negative, the default value is specified. The default value is 10 standing for 2^10=1024.
      `opts' specifies options by bitwise-or: `TokyoCabinet::BDB::TLARGE' specifies that the size of the database can be larger than 2GB by using 64-bit bucket array, `TokyoCabinet::BDB::TDEFLATE' specifies that each record is compressed with Deflate encoding, `TokyoCabinet::BDB::TBZIP' specifies that each record is compressed with BZIP2 encoding, `TokyoCabinet::BDB::TTCBS' specifies that each record is compressed with TCBS encoding. If it is not defined, no option is specified.
      `lcnum' specifies the maximum number of leaf nodes to be cached. If it is not defined or not more than 0, the default value is specified.
      `ncnum' specifies the maximum number of non-leaf nodes to be cached. If it is not defined or not more than 0, the default value is specified.
      If successful, the return value is true, else, it is false.

      untie(%hash)

      Untie a hash variable from the database file.
      The return value is always true.

      $hash{key} = value

      Store a record.
      `key' specifies the key.
      `value' specifies the value.
      If successful, the return value is true, else, it is false.
      If a record with the same key exists in the database, it is overwritten.

      delete($hash{key})

      Remove a record.
      `key' specifies the key.
      If successful, the return value is true, else, it is false.

      $hash{key}

      Retrieve a record.
      `key' specifies the key.
      If successful, the return value is the value of the corresponding record. `undef' is returned if no record corresponds.

      exists($hash{key})

      Check whether a record corrsponding a key exists.
      `key' specifies the key.
      The return value is true if the record exists, else it is false.

      $hash = ()

      Remove all records.
      The return value is always `undef'.

      (the iterator)

      The inner methods `FIRSTKEY' and `NEXTKEY' are also implemented so that you can use the tying functions `each', `keys', and so on.

      Class TokyoCabinet::FDB

      Fixed-length database is a file containing an array of fixed-length elements and is handled with the fixed-length database API. Before operations to store or retrieve records, it is necessary to open a database file and connect the fixed-length database object to it. The method `open' is used to open a database file and the method `close' is used to close the database file. To avoid data missing or corruption, it is important to close every database file when it is no longer in use. It is forbidden for multible database objects in a process to open the same database at the same time.

      $fdb = TokyoCabinet::FDB->new()

      Create a fixed-length database object.
      The return value is the new fixed-length database object.

      $fdb->errmsg(ecode)

      Get the message string corresponding to an error code.
      `ecode' specifies the error code. If it is not defined or negative, the last happened error code is specified.
      The return value is the message string of the error code.

      $fdb->ecode()

      Get the last happened error code.
      The return value is the last happened error code.
      The following error codes are defined: `$fdb->ESUCCESS' for success, `$fdb->ETHREAD' for threading error, `$fdb->EINVALID' for invalid operation, `$fdb->ENOFILE' for file not found, `$fdb->ENOPERM' for no permission, `$fdb->EMETA' for invalid meta data, `$fdb->ERHEAD' for invalid record header, `$fdb->EOPEN' for open error, `$fdb->ECLOSE' for close error, `$fdb->ETRUNC' for trunc error, `$fdb->ESYNC' for sync error, `$fdb->ESTAT' for stat error, `$fdb->ESEEK' for seek error, `$fdb->EREAD' for read error, `$fdb->EWRITE' for write error, `$fdb->EMMAP' for mmap error, `$fdb->ELOCK' for lock error, `$fdb->EUNLINK' for unlink error, `$fdb->ERENAME' for rename error, `$fdb->EMKDIR' for mkdir error, `$fdb->ERMDIR' for rmdir error, `$fdb->EKEEP' for existing record, `$fdb->ENOREC' for no record found, and `$fdb->EMISC' for miscellaneous error.

      $fdb->tune(width, limsiz);

      Set the tuning parameters.
      `width' specifies the width of the value of each record. If it is not defined or not more than 0, the default value is specified. The default value is 255.
      `limsiz' specifies the limit size of the database file. If it is not defined or not more than 0, the default value is specified. The default value is 268435456.
      If successful, the return value is true, else, it is false. Note that the tuning parameters of the database should be set before the database is opened.

      $fdb->open(path, omode)

      Open a database file.
      `path' specifies the path of the database file.
      `omode' specifies the connection mode: `$fdb->OWRITER' as a writer, `$fdb->OREADER' as a reader. If the mode is `$fdb->OWRITER', the following may be added by bitwise-or: `$fdb->OCREAT', which means it creates a new database if not exist, `$fdb->OTRUNC', which means it creates a new database regardless if one exists. Both of `$fdb->OREADER' and `$fdb->OWRITER' can be added to by bitwise-or: `$fdb->ONOLCK', which means it opens the database file without file locking, or `$fdb->OLCKNB', which means locking is performed without blocking. If it is not defined, `$fdb->OREADER' is specified.
      If successful, the return value is true, else, it is false.

      $fdb->close()

      Close the database file.
      If successful, the return value is true, else, it is false.
      Update of a database is assured to be written when the database is closed. If a writer opens a database but does not close it appropriately, the database will be broken.

      $fdb->put(key, value)

      Store a record.
      `key' specifies the key. It should be more than 0. If it is "min", the minimum ID number of existing records is specified. If it is "prev", the number less by one than the minimum ID number of existing records is specified. If it is "max", the maximum ID number of existing records is specified. If it is "next", the number greater by one than the maximum ID number of existing records is specified.
      `value' specifies the value.
      If successful, the return value is true, else, it is false.
      If a record with the same key exists in the database, it is overwritten.

      $fdb->putkeep(key, value)

      Store a new record.
      `key' specifies the key. It should be more than 0. If it is "min", the minimum ID number of existing records is specified. If it is "prev", the number less by one than the minimum ID number of existing records is specified. If it is "max", the maximum ID number of existing records is specified. If it is "next", the number greater by one than the maximum ID number of existing records is specified.
      `value' specifies the value.
      If successful, the return value is true, else, it is false.
      If a record with the same key exists in the database, this method has no effect.

      $fdb->putcat(key, value)

      Concatenate a value at the end of the existing record.
      `key' specifies the key. It should be more than 0. If it is "min", the minimum ID number of existing records is specified. If it is "prev", the number less by one than the minimum ID number of existing records is specified. If it is "max", the maximum ID number of existing records is specified. If it is "next", the number greater by one than the maximum ID number of existing records is specified.
      `value' specifies the value.
      If successful, the return value is true, else, it is false.
      If there is no corresponding record, a new record is created.

      $fdb->out(key)

      Remove a record.
      `key' specifies the key. It should be more than 0. If it is "min", the minimum ID number of existing records is specified. If it is "max", the maximum ID number of existing records is specified.
      If successful, the return value is true, else, it is false.

      $fdb->get(key)

      Retrieve a record.
      `key' specifies the key. It should be more than 0. If it is "min", the minimum ID number of existing records is specified. If it is "max", the maximum ID number of existing records is specified.
      If successful, the return value is the value of the corresponding record. `undef' is returned if no record corresponds.

      $fdb->vsiz(key)

      Get the size of the value of a record.
      `key' specifies the key. It should be more than 0. If it is "min", the minimum ID number of existing records is specified. If it is "max", the maximum ID number of existing records is specified.
      If successful, the return value is the size of the value of the corresponding record, else, it is -1.

      $fdb->iterinit()

      Initialize the iterator.
      If successful, the return value is true, else, it is false.
      The iterator is used in order to access the key of every record stored in a database.

      $fdb->iternext()

      Get the next key of the iterator.
      If successful, the return value is the next key, else, it is `undef'. `undef' is returned when no record is to be get out of the iterator.
      It is possible to access every record by iteration of calling this method. It is allowed to update or remove records whose keys are fetched while the iteration. The order of this traversal access method is ascending of the ID number.

      $fdb->range(interval, max)

      Get keys with an interval notation.
      `interval' specifies the interval notation.
      `max' specifies the maximum number of keys to be fetched. If it is not defined or negative, no limit is specified.
      The return value is the reference to an array of the keys of the corresponding records. This method does never fail. It returns an empty array even if no record corresponds.

      $fdb->addint(key, num)

      Add an integer to a record.
      `key' specifies the key. It should be more than 0. If it is "min", the minimum ID number of existing records is specified. If it is "prev", the number less by one than the minimum ID number of existing records is specified. If it is "max", the maximum ID number of existing records is specified. If it is "next", the number greater by one than the maximum ID number of existing records is specified.
      `num' specifies the additional value.
      If successful, the return value is the summation value, else, it is `undef'.
      If the corresponding record exists, the value is treated as an integer and is added to. If no record corresponds, a new record of the additional value is stored. Because records are stored in binary format, they should be processed with the `unpack' function with the `i' operator after retrieval.

      $fdb->adddouble(key, num)

      Add a real number to a record.
      `key' specifies the key. It should be more than 0. If it is "min", the minimum ID number of existing records is specified. If it is "prev", the number less by one than the minimum ID number of existing records is specified. If it is "max", the maximum ID number of existing records is specified. If it is "next", the number greater by one than the maximum ID number of existing records is specified.
      `num' specifies the additional value.
      If successful, the return value is the summation value, else, it is `undef'.
      If the corresponding record exists, the value is treated as a real number and is added to. If no record corresponds, a new record of the additional value is stored. Because records are stored in binary format, they should be processed with the `unpack' function with the `d' operator after retrieval.

      $fdb->sync()

      Synchronize updated contents with the file and the device.
      If successful, the return value is true, else, it is false.
      This method is useful when another process connects the same database file.

      $fdb->optimize(width, limsiz)

      Optimize the database file.
      `width' specifies the width of the value of each record. If it is not defined or not more than 0, the current setting is not changed.
      `limsiz' specifies the limit size of the database file. If it is not defined or not more than 0, the current setting is not changed.
      If successful, the return value is true, else, it is false.

      $fdb->vanish()

      Remove all records.
      If successful, the return value is true, else, it is false.

      $fdb->copy(path)

      Copy the database file.
      `path' specifies the path of the destination file. If it begins with `@', the trailing substring is executed as a command line.
      If successful, the return value is true, else, it is false. False is returned if the executed command returns non-zero code.
      The database file is assured to be kept synchronized and not modified while the copying or executing operation is in progress. So, this method is useful to create a backup file of the database file.

      $fdb->tranbegin()

      Begin the transaction.
      If successful, the return value is true, else, it is false.
      The database is locked by the thread while the transaction so that only one transaction can be activated with a database object at the same time. Thus, the serializable isolation level is assumed if every database operation is performed in the transaction. All updated regions are kept track of by write ahead logging while the transaction. If the database is closed during transaction, the transaction is aborted implicitly.

      $fdb->trancommit()

      Commit the transaction.
      If successful, the return value is true, else, it is false.
      Update in the transaction is fixed when it is committed successfully.

      $fdb->tranabort()

      Abort the transaction.
      If successful, the return value is true, else, it is false.
      Update in the transaction is discarded when it is aborted. The state of the database is rollbacked to before transaction.

      $fdb->path()

      Get the path of the database file.
      The return value is the path of the database file or `undef' if the object does not connect to any database file.

      $fdb->rnum()

      Get the number of records.
      The return value is the number of records or 0 if the object does not connect to any database file.

      $fdb->fsiz()

      Get the size of the database file.
      The return value is the size of the database file or 0 if the object does not connect to any database file.

      Tying functions of TokyoCabinet::FDB

      tie(%hash, "TokyoCabinet::FDB", path, omode, width, limsiz)

      Tie a hash variable to a hash database file.
      `path' specifies the path of the database file.
      `omode' specifies the connection mode: `TokyoCabinet::FDB::OWRITER' as a writer, `TokyoCabinet::FDB::OREADER' as a reader. If the mode is `TokyoCabinet::FDB::OWRITER', the following may be added by bitwise-or: `TokyoCabinet::FDB::OCREAT', which means it creates a new database if not exist, `TokyoCabinet::FDB::OTRUNC', which means it creates a new database regardless if one exists. Both of `TokyoCabinet::FDB::OREADER' and `TokyoCabinet::FDB::OWRITER' can be added to by bitwise-or: `TokyoCabinet::FDB::ONOLCK', which means it opens the database file without file locking, or `TokyoCabinet::FDB::OLCKNB', which means locking is performed without blocking. If it is not defined, `TokyoCabinet::FDB::OREADER' is specified.
      `width' specifies the width of the value of each record. If it is not defined or not more than 0, the default value is specified. The default value is 255.
      `limsiz' specifies the limit size of the database file. If it is not defined or not more than 0, the default value is specified. The default value is 268435456.
      If successful, the return value is true, else, it is false.

      untie(%hash)

      Untie a hash variable from the database file.
      The return value is always true.

      $hash{key} = value

      Store a record.
      `key' specifies the key. It should be more than 0. If it is "min", the minimum ID number of existing records is specified. If it is "prev", the number less by one than the minimum ID number of existing records is specified. If it is "max", the maximum ID number of existing records is specified. If it is "next", the number greater by one than the maximum ID number of existing records is specified.
      `value' specifies the value.
      If successful, the return value is true, else, it is false.
      If a record with the same key exists in the database, it is overwritten.

      delete($hash{key})

      Remove a record.
      `key' specifies the key. It should be more than 0. If it is "min", the minimum ID number of existing records is specified. If it is "max", the maximum ID number of existing records is specified.
      If successful, the return value is true, else, it is false.

      $hash{key}

      Retrieve a record.
      `key' specifies the key. It should be more than 0. If it is "min", the minimum ID number of existing records is specified. If it is "max", the maximum ID number of existing records is specified.
      If successful, the return value is the value of the corresponding record. `undef' is returned if no record corresponds.

      exists($hash{key})

      Check whether a record corrsponding a key exists.
      `key' specifies the key. It should be more than 0. If it is "min", the minimum ID number of existing records is specified. If it is "max", the maximum ID number of existing records is specified.
      The return value is true if the record exists, else it is false.

      $hash = ()

      Remove all records.
      The return value is always `undef'.

      (the iterator)

      The inner methods `FIRSTKEY' and `NEXTKEY' are also implemented so that you can use the tying functions `each', `keys', and so on.

      Class TokyoCabinet::TDB

      Table database is a file containing records composed of the primary keys and arbitrary columns and is handled with the table database API. Before operations to store or retrieve records, it is necessary to open a database file and connect the table database object to it. The method `open' is used to open a database file and the method `close' is used to close the database file. To avoid data missing or corruption, it is important to close every database file when it is no longer in use. It is forbidden for multible database objects in a process to open the same database at the same time.

      $tdb = TokyoCabinet::TDB->new()

      Create a table database object.
      The return value is the new table database object.

      $tdb->errmsg(ecode)

      Get the message string corresponding to an error code.
      `ecode' specifies the error code. If it is not defined or negative, the last happened error code is specified.
      The return value is the message string of the error code.

      $tdb->ecode()

      Get the last happened error code.
      The return value is the last happened error code.
      The following error codes are defined: `$tdb->ESUCCESS' for success, `$tdb->ETHREAD' for threading error, `$tdb->EINVALID' for invalid operation, `$tdb->ENOFILE' for file not found, `$tdb->ENOPERM' for no permission, `$tdb->EMETA' for invalid meta data, `$tdb->ERHEAD' for invalid record header, `$tdb->EOPEN' for open error, `$tdb->ECLOSE' for close error, `$tdb->ETRUNC' for trunc error, `$tdb->ESYNC' for sync error, `$tdb->ESTAT' for stat error, `$tdb->ESEEK' for seek error, `$tdb->EREAD' for read error, `$tdb->EWRITE' for write error, `$tdb->EMMAP' for mmap error, `$tdb->ELOCK' for lock error, `$tdb->EUNLINK' for unlink error, `$tdb->ERENAME' for rename error, `$tdb->EMKDIR' for mkdir error, `$tdb->ERMDIR' for rmdir error, `$tdb->EKEEP' for existing record, `$tdb->ENOREC' for no record found, and `$tdb->EMISC' for miscellaneous error.

      $tdb->tune(bnum, apow, fpow, opts)

      Set the tuning parameters.
      `bnum' specifies the number of elements of the bucket array. If it is not defined or not more than 0, the default value is specified. The default value is 131071. Suggested size of the bucket array is about from 0.5 to 4 times of the number of all records to be stored.
      `apow' specifies the size of record alignment by power of 2. If it is not defined or negative, the default value is specified. The default value is 4 standing for 2^4=16.
      `fpow' specifies the maximum number of elements of the free block pool by power of 2. If it is not defined or negative, the default value is specified. The default value is 10 standing for 2^10=1024.
      `opts' specifies options by bitwise-or: `$tdb->TLARGE' specifies that the size of the database can be larger than 2GB by using 64-bit bucket array, `$tdb->TDEFLATE' specifies that each record is compressed with Deflate encoding, `$tdb->TBZIP' specifies that each record is compressed with BZIP2 encoding, `$tdb->TTCBS' specifies that each record is compressed with TCBS encoding. If it is not defined, no option is specified.
      If successful, the return value is true, else, it is false. Note that the tuning parameters of the database should be set before the database is opened.

      $tdb->setcache(rcnum, lcnum, ncnum)

      Set the caching parameters.
      `rcnum' specifies the maximum number of records to be cached. If it is not defined or not more than 0, the record cache is disabled. It is disabled by default.
      `lcnum' specifies the maximum number of leaf nodes to be cached. If it is not defined or not more than 0, the default value is specified. The default value is 4096.
      `ncnum' specifies the maximum number of non-leaf nodes to be cached. If it is not defined or not more than 0, the default value is specified. The default value is 512.
      If successful, the return value is true, else, it is false.
      Note that the caching parameters of the database should be set before the database is opened.

      $tdb->setxmsiz(xmsiz)

      Set the size of the extra mapped memory.
      `xmsiz' specifies the size of the extra mapped memory. If it is not defined or not more than 0, the extra mapped memory is disabled. The default size is 67108864.
      If successful, the return value is true, else, it is false.
      Note that the mapping parameters should be set before the database is opened.

      $tdb->setdfunit(dfunit)

      Set the unit step number of auto defragmentation.
      `dfunit' specifie the unit step number. If it is not more than 0, the auto defragmentation is disabled. It is disabled by default.
      If successful, the return value is true, else, it is false.
      Note that the defragmentation parameters should be set before the database is opened.

      $tdb->open(path, omode)

      Open a database file.
      `path' specifies the path of the database file.
      `omode' specifies the connection mode: `$tdb->OWRITER' as a writer, `$tdb->OREADER' as a reader. If the mode is `$tdb->OWRITER', the following may be added by bitwise-or: `$tdb->OCREAT', which means it creates a new database if not exist, `$tdb->OTRUNC', which means it creates a new database regardless if one exists, `$tdb->OTSYNC', which means every transaction synchronizes updated contents with the device. Both of `$tdb->OREADER' and `$tdb->OWRITER' can be added to by bitwise-or: `$tdb->ONOLCK', which means it opens the database file without file locking, or `$tdb->OLCKNB', which means locking is performed without blocking. If it is not defined, `$tdb->OREADER' is specified.
      If successful, the return value is true, else, it is false.

      $tdb->close()

      Close the database file.
      If successful, the return value is true, else, it is false.
      Update of a database is assured to be written when the database is closed. If a writer opens a database but does not close it appropriately, the database will be broken.

      $tdb->put(pkey, cols)

      Store a record.
      `pkey' specifies the primary key.
      `cols' specifies the reference to a hash containing columns.
      If successful, the return value is true, else, it is false.
      If a record with the same key exists in the database, it is overwritten.

      $tdb->putkeep(pkey, cols)

      Store a new record.
      `pkey' specifies the primary key.
      `cols' specifies the reference to a hash containing columns.
      If successful, the return value is true, else, it is false.
      If a record with the same key exists in the database, this method has no effect.

      $tdb->putcat(pkey, cols)

      Concatenate columns of the existing record.
      `pkey' specifies the primary key.
      `cols' specifies the reference to a hash containing columns.
      If successful, the return value is true, else, it is false.
      If there is no corresponding record, a new record is created.

      $tdb->out(pkey)

      Remove a record.
      `pkey' specifies the primary key.
      If successful, the return value is true, else, it is false.

      $tdb->get(pkey)

      Retrieve a record.
      `pkey' specifies the primary key.
      If successful, the return value is the reference to a hash of the columns of the corresponding record. `undef' is returned if no record corresponds.

      $tdb->vsiz(pkey)

      Get the size of the value of a record.
      `pkey' specifies the primary key.
      If successful, the return value is the size of the value of the corresponding record, else, it is -1.

      $tdb->iterinit()

      Initialize the iterator.
      If successful, the return value is true, else, it is false.
      The iterator is used in order to access the primary key of every record stored in a database.

      $tdb->iternext()

      Get the next primary key of the iterator.
      If successful, the return value is the next primary key, else, it is `undef'. `undef' is returned when no record is to be get out of the iterator.
      It is possible to access every record by iteration of calling this method. It is allowed to update or remove records whose keys are fetched while the iteration. However, it is not assured if updating the database is occurred while the iteration. Besides, the order of this traversal access method is arbitrary, so it is not assured that the order of storing matches the one of the traversal access.

      $tdb->fwmkeys(prefix, max)

      Get forward matching primary keys.
      `prefix' specifies the prefix of the corresponding keys.
      `max' specifies the maximum number of keys to be fetched. If it is not defined or negative, no limit is specified.
      The return value is the reference to an array of the keys of the corresponding records. This method does never fail. It returns an empty array even if no record corresponds.
      Note that this method may be very slow because every key in the database is scanned.

      $tdb->addint(pkey, num)

      Add an integer to a record.
      `pkey' specifies primary key.
      `num' specifies the additional value.
      If successful, the return value is the summation value, else, it is `undef'.
      The additional value is stored as a decimal string value of a column whose name is "_num". If no record corresponds, a new record with the additional value is stored.

      $tdb->adddouble(pkey, num)

      Add a real number to a record.
      `pkey' specifies primary key.
      `num' specifies the additional value.
      If successful, the return value is the summation value, else, it is `undef'.
      The additional value is stored as a decimal string value of a column whose name is "_num". If no record corresponds, a new record with the additional value is stored.

      $tdb->sync()

      Synchronize updated contents with the file and the device.
      If successful, the return value is true, else, it is false.
      This method is useful when another process connects the same database file.

      $tdb->optimize(bnum, apow, fpow, opts)

      Optimize the database file.
      `bnum' specifies the number of elements of the bucket array. If it is not defined or not more than 0, the default value is specified. The default value is two times of the number of records.
      `apow' specifies the size of record alignment by power of 2. If it is not defined or negative, the current setting is not changed.
      `fpow' specifies the maximum number of elements of the free block pool by power of 2. If it is not defined or negative, the current setting is not changed.
      `opts' specifies options by bitwise-or: `$tdb->TLARGE' specifies that the size of the database can be larger than 2GB by using 64-bit bucket array, `$tdb->TDEFLATE' specifies that each record is compressed with Deflate encoding, `$tdb->TBZIP' specifies that each record is compressed with BZIP2 encoding, `$tdb->TTCBS' specifies that each record is compressed with TCBS encoding. If it is not defined or 0xff, the current setting is not changed.
      If successful, the return value is true, else, it is false.
      This method is useful to reduce the size of the database file with data fragmentation by successive updating.

      $tdb->vanish()

      Remove all records.
      If successful, the return value is true, else, it is false.

      $tdb->copy(path)

      Copy the database file.
      `path' specifies the path of the destination file. If it begins with `@', the trailing substring is executed as a command line.
      If successful, the return value is true, else, it is false. False is returned if the executed command returns non-zero code.
      The database file is assured to be kept synchronized and not modified while the copying or executing operation is in progress. So, this method is useful to create a backup file of the database file.

      $tdb->tranbegin()

      Begin the transaction.
      If successful, the return value is true, else, it is false.
      The database is locked by the thread while the transaction so that only one transaction can be activated with a database object at the same time. Thus, the serializable isolation level is assumed if every database operation is performed in the transaction. All updated regions are kept track of by write ahead logging while the transaction. If the database is closed during transaction, the transaction is aborted implicitly.

      $tdb->trancommit()

      Commit the transaction.
      If successful, the return value is true, else, it is false.
      Update in the transaction is fixed when it is committed successfully.

      $tdb->tranabort()

      Abort the transaction.
      If successful, the return value is true, else, it is false.
      Update in the transaction is discarded when it is aborted. The state of the database is rollbacked to before transaction.

      $tdb->path()

      Get the path of the database file.
      The return value is the path of the database file or `undef' if the object does not connect to any database file.

      $tdb->rnum()

      Get the number of records.
      The return value is the number of records or 0 if the object does not connect to any database file.

      $tdb->fsiz()

      Get the size of the database file.
      The return value is the size of the database file or 0 if the object does not connect to any database file.

      $tdb->setindex(name, type)

      Set a column index.
      `name' specifies the name of a column. If the name of an existing index is specified, the index is rebuilt. An empty string means the primary key.
      `type' specifies the index type: `$tdb->ITLEXICAL' for lexical string, `$tdb->ITDECIMAL' for decimal string, `$tdb->ITTOKEN' for token inverted index, `$tdb->ITQGRAM' for q-gram inverted index. If it is `$tdb->ITOPT', the index is optimized. If it is `$tdb->ITVOID', the index is removed. If `$tdb->ITKEEP' is added by bitwise-or and the index exists, this method merely returns failure.
      If successful, the return value is true, else, it is false.

      $tdb->genuid()

      Generate a unique ID number.
      The return value is the new unique ID number or -1 on failure.

      Class TokyoCabinet::TDBQRY

      $qry = TokyoCabinet::TDBQRY->new(tdb)

      Create a query object.
      `tdb' specifies the table database object.
      The return value is the new query object.

      $qry->addcond(name, op, expr)

      Add a narrowing condition.
      `name' specifies the name of a column. An empty string means the primary key.
      `op' specifies an operation type: `$qry->QCSTREQ' for string which is equal to the expression, `$qry->QCSTRINC' for string which is included in the expression, `$qry->QCSTRBW' for string which begins with the expression, `$qry->QCSTREW' for string which ends with the expression, `$qry->QCSTRAND' for string which includes all tokens in the expression, `$qry->QCSTROR' for string which includes at least one token in the expression, `$qry->QCSTROREQ' for string which is equal to at least one token in the expression, `$qry->QCSTRRX' for string which matches regular expressions of the expression, `$qry->QCNUMEQ' for number which is equal to the expression, `$qry->QCNUMGT' for number which is greater than the expression, `$qry->QCNUMGE' for number which is greater than or equal to the expression, `$qry->QCNUMLT' for number which is less than the expression, `$qry->QCNUMLE' for number which is less than or equal to the expression, `$qry->QCNUMBT' for number which is between two tokens of the expression, `$qry->QCNUMOREQ' for number which is equal to at least one token in the expression, `$qry->QCFTSPH' for full-text search with the phrase of the expression, `$qry->QCFTSAND' for full-text search with all tokens in the expression, `$qry->QCFTSOR' for full-text search with at least one token in the expression, `$qry->QCFTSEX' for full-text search with the compound expression. All operations can be flagged by bitwise-or: `$qry->QCNEGATE' for negation, `$qry->QCNOIDX' for using no index.
      `expr' specifies an operand exression.
      The return value is always `undef'.

      $qry->setorder(name, type)

      Set the order of the result.
      `name' specifies the name of a column. An empty string means the primary key.
      `type' specifies the order type: `$qry->QOSTRASC' for string ascending, `$qry->QOSTRDESC' for string descending, `$qry->QONUMASC' for number ascending, `$qry->QONUMDESC' for number descending. If it is not defined, `$qry->QOSTRASC' is specified.
      The return value is always `undef'.

      $qry->setlimit(max, skip)

      Set the maximum number of records of the result.
      `max' specifies the maximum number of records of the result. If it is not defined or negative, no limit is specified.
      `skip' specifies the number of skipped records of the result. If it is not defined or not more than 0, no record is skipped.
      The return value is always `undef'.

      $qry->search()

      Execute the search.
      The return value is the reference to an array of the primary keys of the corresponding records. This method does never fail. It returns an empty array even if no record corresponds.

      $qry->searchout()

      Remove each corresponding record.
      If successful, the return value is true, else, it is false.

      $qry->proc(proc)

      Process each corresponding record.
      `proc' specifies the iterator function called for each record. It can be either the reference of a block or the name of a function. The function receives two parameters. The first parameter is the primary key. The second parameter is the reference to a hash containing columns. It returns flags of the post treatment by bitwise-or: `$qry->QPPUT' to modify the record, `$qry->QPOUT' to remove the record, `$qry->QPSTOP' to stop the iteration.
      If successful, the return value is true, else, it is false.

      $qry->hint()

      Get the hint string.
      The return value is the hint string.

      $qry->metasearch(others, type)

      Retrieve records with multiple query objects and get the set of the result.
      `others' specifies the reference to an array of the query objects except for the self object.
      `type' specifies a set operation type: `$qry->MSUNION' for the union set, `$qry->MSISECT' for the intersection set, `$qry->MSDIFF' for the difference set. If it is not defined, `$qry->MSUNION' is specified.
      The return value is the reference to an array of the primary keys of the corresponding records. This method does never fail. It returns an empty array even if no record corresponds.
      If the first query object has the order setting, the result array is sorted by the order.

      $qry->kwic(cols, name, width, opts)

      Generate keyword-in-context strings.
      `cols' specifies the reference to a hash containing columns.
      `name' specifies the name of a column. If it is not defined, the first column of the query is specified.
      `width' specifies the width of strings picked up around each keyword. If it is not defined or negative, the whole text is picked up.
      `opts' specifies options by bitwise-or: `$qry->KWMUTAB' specifies that each keyword is marked up between two tab characters, `$qry->KWMUCTRL' specifies that each keyword is marked up by the STX (0x02) code and the ETX (0x03) code, `$qry->KWMUBRCT' specifies that each keyword is marked up by the two square brackets, `$qry->KWNOOVER' specifies that each context does not overlap, `$qry->KWPULEAD' specifies that the lead string is picked up forcibly. If it is not defined, no option is specified.
      The return value is the reference to an array of strings around keywords.

      Tying functions of TokyoCabinet::TDB

      tie(%hash, "TokyoCabinet::TDB", path, omode, bnum, apow, fpow, opts, rcnum, lcnum, ncnum)

      Tie a hash variable to a table database file.
      `path' specifies the path of the database file.
      `omode' specifies the connection mode: `TokyoCabinet::TDB::OWRITER' as a writer, `TokyoCabinet::TDB::OREADER' as a reader. If the mode is `TokyoCabinet::TDB::OWRITER', the following may be added by bitwise-or: `TokyoCabinet::TDB::OCREAT', which means it creates a new database if not exist, `TokyoCabinet::TDB::OTRUNC', which means it creates a new database regardless if one exists, `TokyoCabinet::TDB::OTSYNC', which means every transaction synchronizes updated contents with the device. Both of `TokyoCabinet::TDB::OREADER' and `TokyoCabinet::TDB::OWRITER' can be added to by bitwise-or: `TokyoCabinet::TDB::ONOLCK', which means it opens the database file without file locking, or `TokyoCabinet::TDB::OLCKNB', which means locking is performed without blocking. If it is not defined, `TokyoCabinet::TDB::OREADER' is specified.
      `bnum' specifies the number of elements of the bucket array. If it is not defined or not more than 0, the default value is specified. The default value is 131071. Suggested size of the bucket array is about from 0.5 to 4 times of the number of all records to be stored.
      `apow' specifies the size of record alignment by power of 2. If it is not defined or negative, the default value is specified. The default value is 4 standing for 2^4=16.
      `fpow' specifies the maximum number of elements of the free block pool by power of 2. If it is not defined or negative, the default value is specified. The default value is 10 standing for 2^10=1024.
      `opts' specifies options by bitwise-or: `TokyoCabinet::TDB::TLARGE' specifies that the size of the database can be larger than 2GB by using 64-bit bucket array, `TokyoCabinet::TDB::TDEFLATE' specifies that each record is compressed with Deflate encoding, `TokyoCabinet::TDB::TBZIP' specifies that each record is compressed with BZIP2 encoding, `TokyoCabinet::TDB::TTCBS' specifies that each record is compressed with TCBS encoding. If it is not defined, no option is specified.
      `rcnum' specifies the maximum number of records to be cached. If it is not defined or not more than 0, the record cache is disabled. It is disabled by default.
      `lcnum' specifies the maximum number of leaf nodes to be cached. If it is not defined or not more than 0, the default value is specified. The default value is 2048.
      `ncnum' specifies the maximum number of non-leaf nodes to be cached. If it is not defined or not more than 0, the default value is specified. The default value is 512.
      If successful, the return value is true, else, it is false.

      untie(%hash)

      Untie a hash variable from the database file.
      The return value is always true.

      $hash{pkey} = cols

      Store a record.
      `pkey' specifies primary key.
      `cols' specifies the reference to a hash containing columns.
      If successful, the return value is true, else, it is false.
      If a record with the same key exists in the database, it is overwritten.

      delete($hash{pkey})

      Remove a record.
      `pkey' specifies primary key.
      If successful, the return value is true, else, it is false.

      $hash{pkey}

      Retrieve a record.
      `pkey' specifies primary key.
      If successful, the return value is the reference to a hash of the columns of the corresponding record. `undef' is returned if no record corresponds.

      exists($hash{pkey})

      Check whether a record corrsponding a key exists.
      `pkey' specifies primary key.
      The return value is true if the record exists, else it is false.

      $hash = ()

      Remove all records.
      The return value is always `undef'.

      (the iterator)

      The inner methods `FIRSTKEY' and `NEXTKEY' are also implemented so that you can use the tying functions `each', `keys', and so on.

      Class TokyoCabinet::ADB

      Abstract database is a set of interfaces to use on-memory hash database, on-memory tree database, hash database, B+ tree database, fixed-length database, and table database with the same API. Before operations to store or retrieve records, it is necessary to connect the abstract database object to the concrete one. The method `open' is used to open a concrete database and the method `close' is used to close the database. To avoid data missing or corruption, it is important to close every database instance when it is no longer in use. It is forbidden for multible database objects in a process to open the same database at the same time.

      $adb = TokyoCabinet::ADB->new()

      Create an abstract database object.
      The return value is the new abstract database object.

      $adb->open(name)

      Open a database.
      `name' specifies the name of the database. If it is "*", the database will be an on-memory hash database. If it is "+", the database will be an on-memory tree database. If its suffix is ".tch", the database will be a hash database. If its suffix is ".tcb", the database will be a B+ tree database. If its suffix is ".tcf", the database will be a fixed-length database. If its suffix is ".tct", the database will be a table database. Otherwise, this method fails. Tuning parameters can trail the name, separated by "#". Each parameter is composed of the name and the value, separated by "=". On-memory hash database supports "bnum", "capnum", and "capsiz". On-memory tree database supports "capnum" and "capsiz". Hash database supports "mode", "bnum", "apow", "fpow", "opts", "rcnum", and "xmsiz". B+ tree database supports "mode", "lmemb", "nmemb", "bnum", "apow", "fpow", "opts", "lcnum", "ncnum", and "xmsiz". Fixed-length database supports "mode", "width", and "limsiz". Table database supports "mode", "bnum", "apow", "fpow", "opts", "rcnum", "lcnum", "ncnum", "xmsiz", and "idx".
      If successful, the return value is true, else, it is false.
      The tuning parameter "capnum" specifies the capacity number of records. "capsiz" specifies the capacity size of using memory. Records spilled the capacity are removed by the storing order. "mode" can contain "w" of writer, "r" of reader, "c" of creating, "t" of truncating, "e" of no locking, and "f" of non-blocking lock. The default mode is relevant to "wc". "opts" can contains "l" of large option, "d" of Deflate option, "b" of BZIP2 option, and "t" of TCBS option. "idx" specifies the column name of an index and its type separated by ":". For example, "casket.tch#bnum=1000000#opts=ld" means that the name of the database file is "casket.tch", and the bucket number is 1000000, and the options are large and Deflate.

      $adb->close()

      Close the database.
      If successful, the return value is true, else, it is false.
      Update of a database is assured to be written when the database is closed. If a writer opens a database but does not close it appropriately, the database will be broken.

      $adb->put(key, value)

      Store a record.
      `key' specifies the key.
      `value' specifies the value.
      If successful, the return value is true, else, it is false.
      If a record with the same key exists in the database, it is overwritten.

      $adb->putkeep(key, value)

      Store a new record.
      `key' specifies the key.
      `value' specifies the value.
      If successful, the return value is true, else, it is false.
      If a record with the same key exists in the database, this method has no effect.

      $adb->putcat(key, value)

      Concatenate a value at the end of the existing record.
      `key' specifies the key.
      `value' specifies the value.
      If successful, the return value is true, else, it is false.
      If there is no corresponding record, a new record is created.

      $adb->out(key)

      Remove a record.
      `key' specifies the key.
      If successful, the return value is true, else, it is false.

      $adb->get(key)

      Retrieve a record.
      `key' specifies the key.
      If successful, the return value is the value of the corresponding record. `undef' is returned if no record corresponds.

      $adb->vsiz(key)

      Get the size of the value of a record.
      `key' specifies the key.
      If successful, the return value is the size of the value of the corresponding record, else, it is -1.

      $adb->iterinit()

      Initialize the iterator.
      If successful, the return value is true, else, it is false.
      The iterator is used in order to access the key of every record stored in a database.

      $adb->iternext()

      Get the next key of the iterator.
      If successful, the return value is the next key, else, it is `undef'. `undef' is returned when no record is to be get out of the iterator.
      It is possible to access every record by iteration of calling this method. It is allowed to update or remove records whose keys are fetched while the iteration. However, it is not assured if updating the database is occurred while the iteration. Besides, the order of this traversal access method is arbitrary, so it is not assured that the order of storing matches the one of the traversal access.

      $adb->fwmkeys(prefix, max)

      Get forward matching keys.
      `prefix' specifies the prefix of the corresponding keys.
      `max' specifies the maximum number of keys to be fetched. If it is not defined or negative, no limit is specified.
      The return value is the reference to an array of the keys of the corresponding records. This method does never fail. It returns an empty array even if no record corresponds.
      Note that this method may be very slow because every key in the database is scanned.

      $adb->addint(key, num)

      Add an integer to a record.
      `key' specifies the key.
      `num' specifies the additional value.
      If successful, the return value is the summation value, else, it is `undef'.
      If the corresponding record exists, the value is treated as an integer and is added to. If no record corresponds, a new record of the additional value is stored. Because records are stored in binary format, they should be processed with the `unpack' function with the `i' operator after retrieval.

      $adb->adddouble(key, num)

      Add a real number to a record.
      `key' specifies the key.
      `num' specifies the additional value.
      If successful, the return value is the summation value, else, it is `undef'.
      If the corresponding record exists, the value is treated as a real number and is added to. If no record corresponds, a new record of the additional value is stored. Because records are stored in binary format, they should be processed with the `unpack' function with the `d' operator after retrieval.

      $adb->sync()

      Synchronize updated contents with the file and the device.
      If successful, the return value is true, else, it is false.

      $adb->optimize(params)

      Optimize the storage.
      `params' specifies the string of the tuning parameters, which works as with the tuning of parameters the method `open'. If it is not defined, it is not used.
      If successful, the return value is true, else, it is false.

      $adb->vanish()

      Remove all records.
      If successful, the return value is true, else, it is false.

      $adb->copy(path)

      Copy the database file.
      `path' specifies the path of the destination file. If it begins with `@', the trailing substring is executed as a command line.
      If successful, the return value is true, else, it is false. False is returned if the executed command returns non-zero code.
      The database file is assured to be kept synchronized and not modified while the copying or executing operation is in progress. So, this method is useful to create a backup file of the database file.

      $adb->tranbegin()

      Begin the transaction.
      If successful, the return value is true, else, it is false.
      The database is locked by the thread while the transaction so that only one transaction can be activated with a database object at the same time. Thus, the serializable isolation level is assumed if every database operation is performed in the transaction. All updated regions are kept track of by write ahead logging while the transaction. If the database is closed during transaction, the transaction is aborted implicitly.

      $adb->trancommit()

      Commit the transaction.
      If successful, the return value is true, else, it is false.
      Update in the transaction is fixed when it is committed successfully.

      $adb->tranabort()

      Abort the transaction.
      If successful, the return value is true, else, it is false.
      Update in the transaction is discarded when it is aborted. The state of the database is rollbacked to before transaction.

      $adb->path()

      Get the path of the database file.
      The return value is the path of the database file or `undef' if the object does not connect to any database instance. "*" stands for on-memory hash database. "+" stands for on-memory tree database.

      $adb->rnum()

      Get the number of records.
      The return value is the number of records or 0 if the object does not connect to any database instance.

      $adb->size()

      Get the size of the database.
      The return value is the size of the database file or 0 if the object does not connect to any database instance.

      $adb->misc(name, args)

      Call a versatile function for miscellaneous operations.
      `name' specifies the name of the function.
      `args' specifies the reference to an array of arguments. If it is not defined, no argument is specified.
      If successful, the return value is the reference to an array of the result. `undef' is returned on failure.

      Tying functions of TokyoCabinet::ADB

      tie(%hash, "TokyoCabinet::ADB", name)

      Tie a hash variable to an abstract database instance.
      `name' specifies the name of the database. If it is "*", the database will be an on-memory hash database. If it is "+", the database will be an on-memory tree database. If its suffix is ".tch", the database will be a hash database. If its suffix is ".tcb", the database will be a B+ tree database. If its suffix is ".tcf", the database will be a fixed-length database. If its suffix is ".tct", the database will be a table database. Otherwise, this method fails. Tuning parameters can trail the name, separated by "#". Each parameter is composed of the name and the value, separated by "=". On-memory hash database supports "bnum", "capnum", and "capsiz". On-memory tree database supports "capnum" and "capsiz". Hash database supports "mode", "bnum", "apow", "fpow", "opts", "rcnum", and "xmsiz". B+ tree database supports "mode", "lmemb", "nmemb", "bnum", "apow", "fpow", "opts", "lcnum", "ncnum", and "xmsiz". Fixed-length database supports "mode", "width", and "limsiz". Table database supports "mode", "bnum", "apow", "fpow", "opts", "rcnum", "lcnum", "ncnum", "xmsiz", and "idx".
      If successful, the return value is true, else, it is false.

      untie(%hash)

      Untie a hash variable from the database.
      The return value is always true.

      $hash{key} = value

      Store a record.
      `key' specifies the key.
      `value' specifies the value.
      If successful, the return value is true, else, it is false.
      If a record with the same key exists in the database, it is overwritten.

      delete($hash{key})

      Remove a record.
      `key' specifies the key.
      If successful, the return value is true, else, it is false.

      $hash{key}

      Retrieve a record.
      `key' specifies the key.
      If successful, the return value is the value of the corresponding record. `undef' is returned if no record corresponds.

      exists($hash{key})

      Check whether a record corrsponding a key exists.
      `key' specifies the key.
      The return value is true if the record exists, else it is false.

      $hash = ()

      Remove all records.
      The return value is always `undef'.

      (the iterator)

      The inner methods `FIRSTKEY' and `NEXTKEY' are also implemented so that you can use the tying functions `each', `keys', and so on.

      LICENSE

       Copyright (C) 2006-2010 FAL Labs
 All rights reserved.

      Tokyo Cabinet is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as published by the Free Software Foundation; either version 2.1 of the License or any later version. Tokyo Cabinet is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more details. You should have received a copy of the GNU Lesser General Public License along with Tokyo Cabinet; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA.

      tokyocabinet-perl-1.34/COPYING0000644000175000017500000006347611073160732015151 0ustar mikiomikio GNU LESSER GENERAL PUBLIC LICENSE Version 2.1, February 1999 Copyright (C) 1991, 1999 Free Software Foundation, Inc. 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. [This is the first released version of the Lesser GPL. It also counts as the successor of the GNU Library Public License, version 2, hence the version number 2.1.] Preamble The licenses for most software are designed to take away your freedom to share and change it. By contrast, the GNU General Public Licenses are intended to guarantee your freedom to share and change free software--to make sure the software is free for all its users. This license, the Lesser General Public License, applies to some specially designated software packages--typically libraries--of the Free Software Foundation and other authors who decide to use it. You can use it too, but we suggest you first think carefully about whether this license or the ordinary General Public License is the better strategy to use in any particular case, based on the explanations below. When we speak of free software, we are referring to freedom of use, not price. Our General Public Licenses are designed to make sure that you have the freedom to distribute copies of free software (and charge for this service if you wish); that you receive source code or can get it if you want it; that you can change the software and use pieces of it in new free programs; and that you are informed that you can do these things. To protect your rights, we need to make restrictions that forbid distributors to deny you these rights or to ask you to surrender these rights. These restrictions translate to certain responsibilities for you if you distribute copies of the library or if you modify it. For example, if you distribute copies of the library, whether gratis or for a fee, you must give the recipients all the rights that we gave you. You must make sure that they, too, receive or can get the source code. If you link other code with the library, you must provide complete object files to the recipients, so that they can relink them with the library after making changes to the library and recompiling it. And you must show them these terms so they know their rights. We protect your rights with a two-step method: (1) we copyright the library, and (2) we offer you this license, which gives you legal permission to copy, distribute and/or modify the library. To protect each distributor, we want to make it very clear that there is no warranty for the free library. Also, if the library is modified by someone else and passed on, the recipients should know that what they have is not the original version, so that the original author's reputation will not be affected by problems that might be introduced by others. Finally, software patents pose a constant threat to the existence of any free program. We wish to make sure that a company cannot effectively restrict the users of a free program by obtaining a restrictive license from a patent holder. Therefore, we insist that any patent license obtained for a version of the library must be consistent with the full freedom of use specified in this license. Most GNU software, including some libraries, is covered by the ordinary GNU General Public License. This license, the GNU Lesser General Public License, applies to certain designated libraries, and is quite different from the ordinary General Public License. We use this license for certain libraries in order to permit linking those libraries into non-free programs. When a program is linked with a library, whether statically or using a shared library, the combination of the two is legally speaking a combined work, a derivative of the original library. The ordinary General Public License therefore permits such linking only if the entire combination fits its criteria of freedom. The Lesser General Public License permits more lax criteria for linking other code with the library. We call this license the "Lesser" General Public License because it does Less to protect the user's freedom than the ordinary General Public License. It also provides other free software developers Less of an advantage over competing non-free programs. These disadvantages are the reason we use the ordinary General Public License for many libraries. However, the Lesser license provides advantages in certain special circumstances. For example, on rare occasions, there may be a special need to encourage the widest possible use of a certain library, so that it becomes a de-facto standard. To achieve this, non-free programs must be allowed to use the library. A more frequent case is that a free library does the same job as widely used non-free libraries. In this case, there is little to gain by limiting the free library to free software only, so we use the Lesser General Public License. In other cases, permission to use a particular library in non-free programs enables a greater number of people to use a large body of free software. For example, permission to use the GNU C Library in non-free programs enables many more people to use the whole GNU operating system, as well as its variant, the GNU/Linux operating system. Although the Lesser General Public License is Less protective of the users' freedom, it does ensure that the user of a program that is linked with the Library has the freedom and the wherewithal to run that program using a modified version of the Library. The precise terms and conditions for copying, distribution and modification follow. Pay close attention to the difference between a "work based on the library" and a "work that uses the library". The former contains code derived from the library, whereas the latter must be combined with the library in order to run. GNU LESSER GENERAL PUBLIC LICENSE TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 0. This License Agreement applies to any software library or other program which contains a notice placed by the copyright holder or other authorized party saying it may be distributed under the terms of this Lesser General Public License (also called "this License"). Each licensee is addressed as "you". A "library" means a collection of software functions and/or data prepared so as to be conveniently linked with application programs (which use some of those functions and data) to form executables. The "Library", below, refers to any such software library or work which has been distributed under these terms. A "work based on the Library" means either the Library or any derivative work under copyright law: that is to say, a work containing the Library or a portion of it, either verbatim or with modifications and/or translated straightforwardly into another language. (Hereinafter, translation is included without limitation in the term "modification".) "Source code" for a work means the preferred form of the work for making modifications to it. For a library, complete source code means all the source code for all modules it contains, plus any associated interface definition files, plus the scripts used to control compilation and installation of the library. Activities other than copying, distribution and modification are not covered by this License; they are outside its scope. The act of running a program using the Library is not restricted, and output from such a program is covered only if its contents constitute a work based on the Library (independent of the use of the Library in a tool for writing it). Whether that is true depends on what the Library does and what the program that uses the Library does. 1. You may copy and distribute verbatim copies of the Library's complete source code as you receive it, in any medium, provided that you conspicuously and appropriately publish on each copy an appropriate copyright notice and disclaimer of warranty; keep intact all the notices that refer to this License and to the absence of any warranty; and distribute a copy of this License along with the Library. You may charge a fee for the physical act of transferring a copy, and you may at your option offer warranty protection in exchange for a fee. 2. You may modify your copy or copies of the Library or any portion of it, thus forming a work based on the Library, and copy and distribute such modifications or work under the terms of Section 1 above, provided that you also meet all of these conditions: a) The modified work must itself be a software library. b) You must cause the files modified to carry prominent notices stating that you changed the files and the date of any change. c) You must cause the whole of the work to be licensed at no charge to all third parties under the terms of this License. d) If a facility in the modified Library refers to a function or a table of data to be supplied by an application program that uses the facility, other than as an argument passed when the facility is invoked, then you must make a good faith effort to ensure that, in the event an application does not supply such function or table, the facility still operates, and performs whatever part of its purpose remains meaningful. (For example, a function in a library to compute square roots has a purpose that is entirely well-defined independent of the application. Therefore, Subsection 2d requires that any application-supplied function or table used by this function must be optional: if the application does not supply it, the square root function must still compute square roots.) These requirements apply to the modified work as a whole. If identifiable sections of that work are not derived from the Library, and can be reasonably considered independent and separate works in themselves, then this License, and its terms, do not apply to those sections when you distribute them as separate works. But when you distribute the same sections as part of a whole which is a work based on the Library, the distribution of the whole must be on the terms of this License, whose permissions for other licensees extend to the entire whole, and thus to each and every part regardless of who wrote it. Thus, it is not the intent of this section to claim rights or contest your rights to work written entirely by you; rather, the intent is to exercise the right to control the distribution of derivative or collective works based on the Library. In addition, mere aggregation of another work not based on the Library with the Library (or with a work based on the Library) on a volume of a storage or distribution medium does not bring the other work under the scope of this License. 3. You may opt to apply the terms of the ordinary GNU General Public License instead of this License to a given copy of the Library. To do this, you must alter all the notices that refer to this License, so that they refer to the ordinary GNU General Public License, version 2, instead of to this License. (If a newer version than version 2 of the ordinary GNU General Public License has appeared, then you can specify that version instead if you wish.) Do not make any other change in these notices. Once this change is made in a given copy, it is irreversible for that copy, so the ordinary GNU General Public License applies to all subsequent copies and derivative works made from that copy. This option is useful when you wish to copy part of the code of the Library into a program that is not a library. 4. You may copy and distribute the Library (or a portion or derivative of it, under Section 2) in object code or executable form under the terms of Sections 1 and 2 above provided that you accompany it with the complete corresponding machine-readable source code, which must be distributed under the terms of Sections 1 and 2 above on a medium customarily used for software interchange. If distribution of object code is made by offering access to copy from a designated place, then offering equivalent access to copy the source code from the same place satisfies the requirement to distribute the source code, even though third parties are not compelled to copy the source along with the object code. 5. A program that contains no derivative of any portion of the Library, but is designed to work with the Library by being compiled or linked with it, is called a "work that uses the Library". Such a work, in isolation, is not a derivative work of the Library, and therefore falls outside the scope of this License. However, linking a "work that uses the Library" with the Library creates an executable that is a derivative of the Library (because it contains portions of the Library), rather than a "work that uses the library". The executable is therefore covered by this License. Section 6 states terms for distribution of such executables. When a "work that uses the Library" uses material from a header file that is part of the Library, the object code for the work may be a derivative work of the Library even though the source code is not. Whether this is true is especially significant if the work can be linked without the Library, or if the work is itself a library. The threshold for this to be true is not precisely defined by law. If such an object file uses only numerical parameters, data structure layouts and accessors, and small macros and small inline functions (ten lines or less in length), then the use of the object file is unrestricted, regardless of whether it is legally a derivative work. (Executables containing this object code plus portions of the Library will still fall under Section 6.) Otherwise, if the work is a derivative of the Library, you may distribute the object code for the work under the terms of Section 6. Any executables containing that work also fall under Section 6, whether or not they are linked directly with the Library itself. 6. As an exception to the Sections above, you may also combine or link a "work that uses the Library" with the Library to produce a work containing portions of the Library, and distribute that work under terms of your choice, provided that the terms permit modification of the work for the customer's own use and reverse engineering for debugging such modifications. You must give prominent notice with each copy of the work that the Library is used in it and that the Library and its use are covered by this License. You must supply a copy of this License. If the work during execution displays copyright notices, you must include the copyright notice for the Library among them, as well as a reference directing the user to the copy of this License. Also, you must do one of these things: a) Accompany the work with the complete corresponding machine-readable source code for the Library including whatever changes were used in the work (which must be distributed under Sections 1 and 2 above); and, if the work is an executable linked with the Library, with the complete machine-readable "work that uses the Library", as object code and/or source code, so that the user can modify the Library and then relink to produce a modified executable containing the modified Library. (It is understood that the user who changes the contents of definitions files in the Library will not necessarily be able to recompile the application to use the modified definitions.) b) Use a suitable shared library mechanism for linking with the Library. A suitable mechanism is one that (1) uses at run time a copy of the library already present on the user's computer system, rather than copying library functions into the executable, and (2) will operate properly with a modified version of the library, if the user installs one, as long as the modified version is interface-compatible with the version that the work was made with. c) Accompany the work with a written offer, valid for at least three years, to give the same user the materials specified in Subsection 6a, above, for a charge no more than the cost of performing this distribution. d) If distribution of the work is made by offering access to copy from a designated place, offer equivalent access to copy the above specified materials from the same place. e) Verify that the user has already received a copy of these materials or that you have already sent this user a copy. For an executable, the required form of the "work that uses the Library" must include any data and utility programs needed for reproducing the executable from it. However, as a special exception, the materials to be distributed need not include anything that is normally distributed (in either source or binary form) with the major components (compiler, kernel, and so on) of the operating system on which the executable runs, unless that component itself accompanies the executable. It may happen that this requirement contradicts the license restrictions of other proprietary libraries that do not normally accompany the operating system. Such a contradiction means you cannot use both them and the Library together in an executable that you distribute. 7. You may place library facilities that are a work based on the Library side-by-side in a single library together with other library facilities not covered by this License, and distribute such a combined library, provided that the separate distribution of the work based on the Library and of the other library facilities is otherwise permitted, and provided that you do these two things: a) Accompany the combined library with a copy of the same work based on the Library, uncombined with any other library facilities. This must be distributed under the terms of the Sections above. b) Give prominent notice with the combined library of the fact that part of it is a work based on the Library, and explaining where to find the accompanying uncombined form of the same work. 8. You may not copy, modify, sublicense, link with, or distribute the Library except as expressly provided under this License. Any attempt otherwise to copy, modify, sublicense, link with, or distribute the Library is void, and will automatically terminate your rights under this License. However, parties who have received copies, or rights, from you under this License will not have their licenses terminated so long as such parties remain in full compliance. 9. You are not required to accept this License, since you have not signed it. However, nothing else grants you permission to modify or distribute the Library or its derivative works. These actions are prohibited by law if you do not accept this License. Therefore, by modifying or distributing the Library (or any work based on the Library), you indicate your acceptance of this License to do so, and all its terms and conditions for copying, distributing or modifying the Library or works based on it. 10. Each time you redistribute the Library (or any work based on the Library), the recipient automatically receives a license from the original licensor to copy, distribute, link with or modify the Library subject to these terms and conditions. You may not impose any further restrictions on the recipients' exercise of the rights granted herein. You are not responsible for enforcing compliance by third parties with this License. 11. If, as a consequence of a court judgment or allegation of patent infringement or for any other reason (not limited to patent issues), conditions are imposed on you (whether by court order, agreement or otherwise) that contradict the conditions of this License, they do not excuse you from the conditions of this License. If you cannot distribute so as to satisfy simultaneously your obligations under this License and any other pertinent obligations, then as a consequence you may not distribute the Library at all. For example, if a patent license would not permit royalty-free redistribution of the Library by all those who receive copies directly or indirectly through you, then the only way you could satisfy both it and this License would be to refrain entirely from distribution of the Library. If any portion of this section is held invalid or unenforceable under any particular circumstance, the balance of the section is intended to apply, and the section as a whole is intended to apply in other circumstances. It is not the purpose of this section to induce you to infringe any patents or other property right claims or to contest validity of any such claims; this section has the sole purpose of protecting the integrity of the free software distribution system which is implemented by public license practices. Many people have made generous contributions to the wide range of software distributed through that system in reliance on consistent application of that system; it is up to the author/donor to decide if he or she is willing to distribute software through any other system and a licensee cannot impose that choice. This section is intended to make thoroughly clear what is believed to be a consequence of the rest of this License. 12. If the distribution and/or use of the Library is restricted in certain countries either by patents or by copyrighted interfaces, the original copyright holder who places the Library under this License may add an explicit geographical distribution limitation excluding those countries, so that distribution is permitted only in or among countries not thus excluded. In such case, this License incorporates the limitation as if written in the body of this License. 13. The Free Software Foundation may publish revised and/or new versions of the Lesser General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. Each version is given a distinguishing version number. If the Library specifies a version number of this License which applies to it and "any later version", you have the option of following the terms and conditions either of that version or of any later version published by the Free Software Foundation. If the Library does not specify a license version number, you may choose any version ever published by the Free Software Foundation. 14. If you wish to incorporate parts of the Library into other free programs whose distribution conditions are incompatible with these, write to the author to ask for permission. For software which is copyrighted by the Free Software Foundation, write to the Free Software Foundation; we sometimes make exceptions for this. Our decision will be guided by the two goals of preserving the free status of all derivatives of our free software and of promoting the sharing and reuse of software generally. NO WARRANTY 15. BECAUSE THE LIBRARY IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE LIBRARY, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE LIBRARY "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE LIBRARY IS WITH YOU. SHOULD THE LIBRARY PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 16. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE LIBRARY AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE LIBRARY (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE LIBRARY TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. END OF TERMS AND CONDITIONS How to Apply These Terms to Your New Libraries If you develop a new library, and you want it to be of the greatest possible use to the public, we recommend making it free software that everyone can redistribute and change. You can do so by permitting redistribution under these terms (or, alternatively, under the terms of the ordinary General Public License). To apply these terms, attach the following notices to the library. It is safest to attach them to the start of each source file to most effectively convey the exclusion of warranty; and each file should have at least the "copyright" line and a pointer to where the full notice is found. Copyright (C) This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as published by the Free Software Foundation; either version 2.1 of the License, or (at your option) any later version. This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more details. You should have received a copy of the GNU Lesser General Public License along with this library; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA Also add information on how to contact you by electronic and paper mail. You should also get your employer (if you work as a programmer) or your school, if any, to sign a "copyright disclaimer" for the library, if necessary. Here is a sample; alter the names: Yoyodyne, Inc., hereby disclaims all copyright interest in the library `Frob' (a library for tweaking knobs) written by James Random Hacker. , 1 April 1990 Ty Coon, President of Vice That's all there is to it! tokyocabinet-perl-1.34/TokyoCabinet.pm0000644000175000017500000017306511445514275017053 0ustar mikiomikio#------------------------------------------------------------------------------------------------- # Perl binding of Tokyo Cabinet # Copyright (C) 2006-2010 FAL Labs # This file is part of Tokyo Cabinet. # Tokyo Cabinet is free software; you can redistribute it and/or modify it under the terms of # the GNU Lesser General Public License as published by the Free Software Foundation; either # version 2.1 of the License or any later version. Tokyo Cabinet is distributed in the hope # that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public # License for more details. # You should have received a copy of the GNU Lesser General Public License along with Tokyo # Cabinet; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, # Boston, MA 02111-1307 USA. #------------------------------------------------------------------------------------------------- package TokyoCabinet; use strict; use warnings; use bytes; use Carp; require Exporter; require XSLoader; use base qw(Exporter); our $VERSION = '1.34'; our $DEBUG = 0; XSLoader::load('TokyoCabinet', $VERSION); #---------------------------------------------------------------- # utilities #---------------------------------------------------------------- sub VERSION { return TokyoCabinet::tc_version(); } sub atoi { my $str = shift; return 0 if(!defined($str)); return tc_atoi($str); } sub atof { my $str = shift; return 0 if(!defined($str)); return tc_atof($str); } sub bercompress { my $aryref = shift; if(scalar(@_) != 0 || !defined($aryref) || ref($aryref) ne "ARRAY"){ croak((caller(0))[3] . ": invalid parameter") if($TokyoCabinet::DEBUG); return undef; } return tc_bercompress($aryref); } sub beruncompress { my $selref = shift; if(scalar(@_) != 0 || !defined($selref) || ref($selref) ne "SCALAR"){ croak((caller(0))[3] . ": invalid parameter") if($TokyoCabinet::DEBUG); return undef; } return tc_beruncompress($selref); } sub diffcompress { my $aryref = shift; if(scalar(@_) != 0 || !defined($aryref) || ref($aryref) ne "ARRAY"){ croak((caller(0))[3] . ": invalid parameter") if($TokyoCabinet::DEBUG); return undef; } return tc_diffcompress($aryref); } sub diffuncompress { my $selref = shift; if(scalar(@_) != 0 || !defined($selref) || ref($selref) ne "SCALAR"){ croak((caller(0))[3] . ": invalid parameter") if($TokyoCabinet::DEBUG); return undef; } return tc_diffuncompress($selref); } sub strdistance { my $aref = shift; my $bref = shift; my $isutf = shift; if(scalar(@_) != 0 || !defined($aref) || ref($aref) ne "SCALAR" || !defined($bref) || ref($bref) ne "SCALAR"){ croak((caller(0))[3] . ": invalid parameter") if($TokyoCabinet::DEBUG); return undef; } $isutf = 0 if(!defined($isutf)); return tc_strdistance($aref, $bref, $isutf); } #---------------------------------------------------------------- # the hash database API #---------------------------------------------------------------- package TokyoCabinet::HDB; use strict; use warnings; use bytes; use Carp; use Encode; use constant { ESUCCESS => 0, ETHREAD => 1, EINVALID => 2, ENOFILE => 3, ENOPERM => 4, EMETA => 5, ERHEAD => 6, EOPEN => 7, ECLOSE => 8, ETRUNC => 9, ESYNC => 10, ESTAT => 11, ESEEK => 12, EREAD => 13, EWRITE => 14, EMMAP => 15, ELOCK => 16, EUNLINK => 17, ERENAME => 18, EMKDIR => 19, ERMDIR => 20, EKEEP => 21, ENOREC => 22, EMISC => 9999, }; use constant { TLARGE => 1 << 0, TDEFLATE => 1 << 1, TBZIP => 1 << 2, TTCBS => 1 << 3, }; use constant { OREADER => 1 << 0, OWRITER => 1 << 1, OCREAT => 1 << 2, OTRUNC => 1 << 3, ONOLCK => 1 << 4, OLCKNB => 1 << 5, OTSYNC => 1 << 6, }; sub new { my $class = shift; if(scalar(@_) != 0){ croak((caller(0))[3] . ": invalid parameter") if($TokyoCabinet::DEBUG); return undef; } my $self = [0]; $$self[0] = TokyoCabinet::hdb_new(); bless($self, $class); return $self; } sub DESTROY { my $self = shift; return undef unless($$self[0]); TokyoCabinet::hdb_del($$self[0]); return undef; } sub errmsg { my $self = shift; my $ecode = shift; if(scalar(@_) != 0){ croak((caller(0))[3] . ": invalid parameter") if($TokyoCabinet::DEBUG); return undef; } $ecode = $self->ecode() if(!defined($ecode) || $ecode < 0); return TokyoCabinet::hdb_errmsg($ecode); } sub ecode { my $self = shift; if(scalar(@_) != 0){ croak((caller(0))[3] . ": invalid parameter") if($TokyoCabinet::DEBUG); return undef; } return TokyoCabinet::hdb_ecode($$self[0]); } sub tune { my $self = shift; my $bnum = shift; my $apow = shift; my $fpow = shift; my $opts = shift; if(scalar(@_) != 0){ croak((caller(0))[3] . ": invalid parameter") if($TokyoCabinet::DEBUG); return undef; } $bnum = -1 if(!defined($bnum)); $apow = -1 if(!defined($apow)); $fpow = -1 if(!defined($fpow)); $opts = 0 if(!defined($opts)); return TokyoCabinet::hdb_tune($$self[0], $bnum, $apow, $fpow, $opts); } sub setcache { my $self = shift; my $rcnum = shift; if(scalar(@_) != 0){ croak((caller(0))[3] . ": invalid parameter") if($TokyoCabinet::DEBUG); return undef; } $rcnum = -1 if(!defined($rcnum)); return TokyoCabinet::hdb_setcache($$self[0], $rcnum); } sub setxmsiz { my $self = shift; my $xmsiz = shift; if(scalar(@_) != 0){ croak((caller(0))[3] . ": invalid parameter") if($TokyoCabinet::DEBUG); return undef; } $xmsiz = -1 if(!defined($xmsiz)); return TokyoCabinet::hdb_setxmsiz($$self[0], $xmsiz); } sub setdfunit { my $self = shift; my $dfunit = shift; if(scalar(@_) != 0){ croak((caller(0))[3] . ": invalid parameter") if($TokyoCabinet::DEBUG); return undef; } $dfunit = -1 if(!defined($dfunit)); return TokyoCabinet::hdb_setdfunit($$self[0], $dfunit); } sub open { my $self = shift; my $path = shift; my $omode = shift; if(scalar(@_) != 0 || !defined($path)){ croak((caller(0))[3] . ": invalid parameter") if($TokyoCabinet::DEBUG); return undef; } $omode = OREADER if(!defined($omode)); return TokyoCabinet::hdb_open($$self[0], $path, $omode); } sub close { my $self = shift; if(scalar(@_) != 0){ croak((caller(0))[3] . ": invalid parameter") if($TokyoCabinet::DEBUG); return undef; } return TokyoCabinet::hdb_close($$self[0]); } sub put { my $self = shift; my $key = shift; my $value = shift; if(scalar(@_) != 0 || !defined($key) || !defined($value)){ croak((caller(0))[3] . ": invalid parameter") if($TokyoCabinet::DEBUG); return undef; } return TokyoCabinet::hdb_put($$self[0], $key, $value); } sub putkeep { my $self = shift; my $key = shift; my $value = shift; if(scalar(@_) != 0 || !defined($key) || !defined($value)){ croak((caller(0))[3] . ": invalid parameter") if($TokyoCabinet::DEBUG); return undef; } return TokyoCabinet::hdb_putkeep($$self[0], $key, $value); } sub putcat { my $self = shift; my $key = shift; my $value = shift; if(scalar(@_) != 0 || !defined($key) || !defined($value)){ croak((caller(0))[3] . ": invalid parameter") if($TokyoCabinet::DEBUG); return undef; } return TokyoCabinet::hdb_putcat($$self[0], $key, $value); } sub putasync { my $self = shift; my $key = shift; my $value = shift; if(scalar(@_) != 0 || !defined($key) || !defined($value)){ croak((caller(0))[3] . ": invalid parameter") if($TokyoCabinet::DEBUG); return undef; } return TokyoCabinet::hdb_putasync($$self[0], $key, $value); } sub out { my $self = shift; my $key = shift; if(scalar(@_) != 0 || !defined($key)){ croak((caller(0))[3] . ": invalid parameter") if($TokyoCabinet::DEBUG); return undef; } return TokyoCabinet::hdb_out($$self[0], $key); } sub get { my $self = shift; my $key = shift; if(scalar(@_) != 0 || !defined($key)){ croak((caller(0))[3] . ": invalid parameter") if($TokyoCabinet::DEBUG); return undef; } return TokyoCabinet::hdb_get($$self[0], $key); } sub vsiz { my $self = shift; my $key = shift; if(scalar(@_) != 0 || !defined($key)){ croak((caller(0))[3] . ": invalid parameter") if($TokyoCabinet::DEBUG); return undef; } return TokyoCabinet::hdb_vsiz($$self[0], $key); } sub iterinit { my $self = shift; if(scalar(@_) != 0){ croak((caller(0))[3] . ": invalid parameter") if($TokyoCabinet::DEBUG); return undef; } return TokyoCabinet::hdb_iterinit($$self[0]); } sub iternext { my $self = shift; if(scalar(@_) != 0){ croak((caller(0))[3] . ": invalid parameter") if($TokyoCabinet::DEBUG); return undef; } return TokyoCabinet::hdb_iternext($$self[0]); } sub fwmkeys { my $self = shift; my $prefix = shift; my $max = shift; if(scalar(@_) != 0 || !defined($prefix)){ croak((caller(0))[3] . ": invalid parameter") if($TokyoCabinet::DEBUG); return undef; } $max = -1 if(!defined($max)); return TokyoCabinet::hdb_fwmkeys($$self[0], $prefix, $max); } sub addint { my $self = shift; my $key = shift; my $num = shift; if(scalar(@_) != 0 || !defined($key) || !defined($num)){ croak((caller(0))[3] . ": invalid parameter") if($TokyoCabinet::DEBUG); return undef; } return TokyoCabinet::hdb_addint($$self[0], $key, $num); } sub adddouble { my $self = shift; my $key = shift; my $num = shift; if(scalar(@_) != 0 || !defined($key) || !defined($num)){ croak((caller(0))[3] . ": invalid parameter") if($TokyoCabinet::DEBUG); return undef; } return TokyoCabinet::hdb_adddouble($$self[0], $key, $num); } sub sync { my $self = shift; if(scalar(@_) != 0){ croak((caller(0))[3] . ": invalid parameter") if($TokyoCabinet::DEBUG); return undef; } return TokyoCabinet::hdb_sync($$self[0]); } sub optimize { my $self = shift; my $bnum = shift; my $apow = shift; my $fpow = shift; my $opts = shift; if(scalar(@_) != 0){ croak((caller(0))[3] . ": invalid parameter") if($TokyoCabinet::DEBUG); return undef; } $bnum = -1 if(!defined($bnum)); $apow = -1 if(!defined($apow)); $fpow = -1 if(!defined($fpow)); $opts = 0xff if(!defined($opts)); return TokyoCabinet::hdb_optimize($$self[0], $bnum, $apow, $fpow, $opts); } sub vanish { my $self = shift; if(scalar(@_) != 0){ croak((caller(0))[3] . ": invalid parameter") if($TokyoCabinet::DEBUG); return undef; } return TokyoCabinet::hdb_vanish($$self[0]); } sub copy { my $self = shift; my $path = shift; if(scalar(@_) != 0 || !defined($path)){ croak((caller(0))[3] . ": invalid parameter") if($TokyoCabinet::DEBUG); return undef; } return TokyoCabinet::hdb_copy($$self[0], $path); } sub tranbegin { my $self = shift; if(scalar(@_) != 0){ croak((caller(0))[3] . ": invalid parameter") if($TokyoCabinet::DEBUG); return undef; } return TokyoCabinet::hdb_tranbegin($$self[0]); } sub trancommit { my $self = shift; if(scalar(@_) != 0){ croak((caller(0))[3] . ": invalid parameter") if($TokyoCabinet::DEBUG); return undef; } return TokyoCabinet::hdb_trancommit($$self[0]); } sub tranabort { my $self = shift; if(scalar(@_) != 0){ croak((caller(0))[3] . ": invalid parameter") if($TokyoCabinet::DEBUG); return undef; } return TokyoCabinet::hdb_tranabort($$self[0]); } sub path { my $self = shift; if(scalar(@_) != 0){ croak((caller(0))[3] . ": invalid parameter") if($TokyoCabinet::DEBUG); return undef; } return TokyoCabinet::hdb_path($$self[0]); } sub rnum { my $self = shift; if(scalar(@_) != 0){ croak((caller(0))[3] . ": invalid parameter") if($TokyoCabinet::DEBUG); return undef; } return TokyoCabinet::hdb_rnum($$self[0]); } sub fsiz { my $self = shift; if(scalar(@_) != 0){ croak((caller(0))[3] . ": invalid parameter") if($TokyoCabinet::DEBUG); return undef; } return TokyoCabinet::hdb_fsiz($$self[0]); } sub TIEHASH { my $class = shift; my $path = shift; my $omode = shift; my $bnum = shift; my $apow = shift; my $fpow = shift; my $opts = shift; my $rcnum = shift; my $hdb = $class->new(); $hdb->tune($bnum, $apow, $fpow, $opts); $hdb->setcache($rcnum); return undef if(!$hdb->open($path, $omode)); return $hdb; } sub UNTIE { my $self = shift; return $self->close(); } sub STORE { my $self = shift; my $key = shift; my $value = shift; return $self->put($key, $value); } sub DELETE { my $self = shift; my $key = shift; return $self->out($key); } sub FETCH { my $self = shift; my $key = shift; return $self->get($key); } sub EXISTS { my $self = shift; my $key = shift; return $self->vsiz($key) >= 0; } sub FIRSTKEY { my $self = shift; $self->iterinit(); return $self->iternext(); } sub NEXTKEY { my $self = shift; return $self->iternext(); } sub CLEAR { my $self = shift; return $self->vanish(); } #---------------------------------------------------------------- # the B+ tree database API #---------------------------------------------------------------- package TokyoCabinet::BDB; use strict; use warnings; use bytes; use Carp; use Encode; use constant { ESUCCESS => 0, ETHREAD => 1, EINVALID => 2, ENOFILE => 3, ENOPERM => 4, EMETA => 5, ERHEAD => 6, EOPEN => 7, ECLOSE => 8, ETRUNC => 9, ESYNC => 10, ESTAT => 11, ESEEK => 12, EREAD => 13, EWRITE => 14, EMMAP => 15, ELOCK => 16, EUNLINK => 17, ERENAME => 18, EMKDIR => 19, ERMDIR => 20, EKEEP => 21, ENOREC => 22, EMISC => 9999, }; use constant { CMPLEXICAL => "CMPLEXICAL", CMPDECIMAL => "CMPDECIMAL", CMPINT32 => "CMPINT32", CMPINT64 => "CMPINT64", }; use constant { TLARGE => 1 << 0, TDEFLATE => 1 << 1, TBZIP => 1 << 2, TTCBS => 1 << 3, }; use constant { OREADER => 1 << 0, OWRITER => 1 << 1, OCREAT => 1 << 2, OTRUNC => 1 << 3, ONOLCK => 1 << 4, OLCKNB => 1 << 5, OTSYNC => 1 << 6, }; sub new { my $class = shift; if(scalar(@_) != 0){ croak((caller(0))[3] . ": invalid parameter") if($TokyoCabinet::DEBUG); return undef; } my $self = [0, 0]; $$self[0] = TokyoCabinet::bdb_new(); bless($self, $class); return $self; } sub DESTROY { my $self = shift; return undef unless($$self[0]); TokyoCabinet::bdb_del($$self[0]); return undef; } sub errmsg { my $self = shift; my $ecode = shift; if(scalar(@_) != 0){ croak((caller(0))[3] . ": invalid parameter") if($TokyoCabinet::DEBUG); return undef; } $ecode = $self->ecode() if(!defined($ecode) || $ecode < 0); return TokyoCabinet::bdb_errmsg($ecode); } sub ecode { my $self = shift; if(scalar(@_) != 0){ croak((caller(0))[3] . ": invalid parameter") if($TokyoCabinet::DEBUG); return undef; } return TokyoCabinet::bdb_ecode($$self[0]); } sub setcmpfunc { my $self = shift; my $cmp = shift; if(scalar(@_) != 0 || !defined($cmp)){ croak((caller(0))[3] . ": invalid parameter") if($TokyoCabinet::DEBUG); return undef; } if($cmp eq CMPLEXICAL){ return TokyoCabinet::bdb_setcmpfunc($$self[0], 0); } elsif($cmp eq CMPDECIMAL){ return TokyoCabinet::bdb_setcmpfunc($$self[0], 1); } elsif($cmp eq CMPINT32){ return TokyoCabinet::bdb_setcmpfunc($$self[0], 2); } elsif($cmp eq CMPINT64){ return TokyoCabinet::bdb_setcmpfunc($$self[0], 3); } return TokyoCabinet::bdb_setcmpfuncex($$self[0], $cmp); } sub tune { my $self = shift; my $lmemb = shift; my $nmemb = shift; my $bnum = shift; my $apow = shift; my $fpow = shift; my $opts = shift; if(scalar(@_) != 0){ croak((caller(0))[3] . ": invalid parameter") if($TokyoCabinet::DEBUG); return undef; } $lmemb = -1 if(!defined($lmemb)); $nmemb = -1 if(!defined($nmemb)); $bnum = -1 if(!defined($bnum)); $apow = -1 if(!defined($apow)); $fpow = -1 if(!defined($fpow)); $opts = 0 if(!defined($opts)); return TokyoCabinet::bdb_tune($$self[0], $lmemb, $nmemb, $bnum, $apow, $fpow, $opts); } sub setcache { my $self = shift; my $lcnum = shift; my $ncnum = shift; if(scalar(@_) != 0){ croak((caller(0))[3] . ": invalid parameter") if($TokyoCabinet::DEBUG); return undef; } $lcnum = -1 if(!defined($lcnum)); $ncnum = -1 if(!defined($ncnum)); return TokyoCabinet::bdb_setcache($$self[0], $lcnum, $ncnum); } sub setxmsiz { my $self = shift; my $xmsiz = shift; if(scalar(@_) != 0){ croak((caller(0))[3] . ": invalid parameter") if($TokyoCabinet::DEBUG); return undef; } $xmsiz = -1 if(!defined($xmsiz)); return TokyoCabinet::bdb_setxmsiz($$self[0], $xmsiz); } sub setdfunit { my $self = shift; my $dfunit = shift; if(scalar(@_) != 0){ croak((caller(0))[3] . ": invalid parameter") if($TokyoCabinet::DEBUG); return undef; } $dfunit = -1 if(!defined($dfunit)); return TokyoCabinet::bdb_setdfunit($$self[0], $dfunit); } sub open { my $self = shift; my $path = shift; my $omode = shift; if(scalar(@_) != 0 || !defined($path)){ croak((caller(0))[3] . ": invalid parameter") if($TokyoCabinet::DEBUG); return undef; } $omode = OREADER if(!defined($omode)); return TokyoCabinet::bdb_open($$self[0], $path, $omode); } sub close { my $self = shift; if(scalar(@_) != 0){ croak((caller(0))[3] . ": invalid parameter") if($TokyoCabinet::DEBUG); return undef; } return TokyoCabinet::bdb_close($$self[0]); } sub put { my $self = shift; my $key = shift; my $value = shift; if(scalar(@_) != 0 || !defined($key) || !defined($value)){ croak((caller(0))[3] . ": invalid parameter") if($TokyoCabinet::DEBUG); return undef; } return TokyoCabinet::bdb_put($$self[0], $key, $value); } sub putkeep { my $self = shift; my $key = shift; my $value = shift; if(scalar(@_) != 0 || !defined($key) || !defined($value)){ croak((caller(0))[3] . ": invalid parameter") if($TokyoCabinet::DEBUG); return undef; } return TokyoCabinet::bdb_putkeep($$self[0], $key, $value); } sub putcat { my $self = shift; my $key = shift; my $value = shift; if(scalar(@_) != 0 || !defined($key) || !defined($value)){ croak((caller(0))[3] . ": invalid parameter") if($TokyoCabinet::DEBUG); return undef; } return TokyoCabinet::bdb_putcat($$self[0], $key, $value); } sub putdup { my $self = shift; my $key = shift; my $value = shift; if(scalar(@_) != 0 || !defined($key) || !defined($value)){ croak((caller(0))[3] . ": invalid parameter") if($TokyoCabinet::DEBUG); return undef; } return TokyoCabinet::bdb_putdup($$self[0], $key, $value); } sub putlist { my $self = shift; my $key = shift; my $values = shift; if(scalar(@_) != 0 || !defined($key) || !defined($values) || ref($values) ne "ARRAY"){ croak((caller(0))[3] . ": invalid parameter") if($TokyoCabinet::DEBUG); return undef; } return TokyoCabinet::bdb_putlist($$self[0], $key, $values); } sub out { my $self = shift; my $key = shift; if(scalar(@_) != 0 || !defined($key)){ croak((caller(0))[3] . ": invalid parameter") if($TokyoCabinet::DEBUG); return undef; } return TokyoCabinet::bdb_out($$self[0], $key); } sub outlist { my $self = shift; my $key = shift; if(scalar(@_) != 0 || !defined($key)){ croak((caller(0))[3] . ": invalid parameter") if($TokyoCabinet::DEBUG); return undef; } return TokyoCabinet::bdb_outlist($$self[0], $key); } sub get { my $self = shift; my $key = shift; if(scalar(@_) != 0 || !defined($key)){ croak((caller(0))[3] . ": invalid parameter") if($TokyoCabinet::DEBUG); return undef; } return TokyoCabinet::bdb_get($$self[0], $key); } sub getlist { my $self = shift; my $key = shift; if(scalar(@_) != 0 || !defined($key)){ croak((caller(0))[3] . ": invalid parameter") if($TokyoCabinet::DEBUG); return undef; } return TokyoCabinet::bdb_getlist($$self[0], $key); } sub vnum { my $self = shift; my $key = shift; if(scalar(@_) != 0 || !defined($key)){ croak((caller(0))[3] . ": invalid parameter") if($TokyoCabinet::DEBUG); return undef; } return TokyoCabinet::bdb_vnum($$self[0], $key); } sub vsiz { my $self = shift; my $key = shift; if(scalar(@_) != 0 || !defined($key)){ croak((caller(0))[3] . ": invalid parameter") if($TokyoCabinet::DEBUG); return undef; } return TokyoCabinet::bdb_vsiz($$self[0], $key); } sub range { my $self = shift; my $bkey = shift; my $binc = shift; my $ekey = shift; my $einc = shift; my $max = shift; if(scalar(@_) != 0){ croak((caller(0))[3] . ": invalid parameter") if($TokyoCabinet::DEBUG); return undef; } $binc = 0 if(!defined($binc)); $einc = 0 if(!defined($einc)); $max = -1 if(!defined($max)); return TokyoCabinet::bdb_range($$self[0], $bkey, $binc, $ekey, $einc, $max); } sub fwmkeys { my $self = shift; my $prefix = shift; my $max = shift; if(scalar(@_) != 0 || !defined($prefix)){ croak((caller(0))[3] . ": invalid parameter") if($TokyoCabinet::DEBUG); return undef; } $max = -1 if(!defined($max)); return TokyoCabinet::bdb_fwmkeys($$self[0], $prefix, $max); } sub addint { my $self = shift; my $key = shift; my $num = shift; if(scalar(@_) != 0 || !defined($key) || !defined($num)){ croak((caller(0))[3] . ": invalid parameter") if($TokyoCabinet::DEBUG); return undef; } return TokyoCabinet::bdb_addint($$self[0], $key, $num); } sub adddouble { my $self = shift; my $key = shift; my $num = shift; if(scalar(@_) != 0 || !defined($key) || !defined($num)){ croak((caller(0))[3] . ": invalid parameter") if($TokyoCabinet::DEBUG); return undef; } return TokyoCabinet::bdb_adddouble($$self[0], $key, $num); } sub sync { my $self = shift; if(scalar(@_) != 0){ croak((caller(0))[3] . ": invalid parameter") if($TokyoCabinet::DEBUG); return undef; } return TokyoCabinet::bdb_sync($$self[0]); } sub optimize { my $self = shift; my $lmemb = shift; my $nmemb = shift; my $bnum = shift; my $apow = shift; my $fpow = shift; my $opts = shift; if(scalar(@_) != 0){ croak((caller(0))[3] . ": invalid parameter") if($TokyoCabinet::DEBUG); return undef; } $lmemb = -1 if(!defined($lmemb)); $nmemb = -1 if(!defined($nmemb)); $bnum = -1 if(!defined($bnum)); $apow = -1 if(!defined($apow)); $fpow = -1 if(!defined($fpow)); $opts = 0xff if(!defined($opts)); return TokyoCabinet::bdb_optimize($$self[0], $lmemb, $nmemb, $bnum, $apow, $fpow, $opts); } sub vanish { my $self = shift; if(scalar(@_) != 0){ croak((caller(0))[3] . ": invalid parameter") if($TokyoCabinet::DEBUG); return undef; } return TokyoCabinet::bdb_vanish($$self[0]); } sub copy { my $self = shift; my $path = shift; if(scalar(@_) != 0 || !defined($path)){ croak((caller(0))[3] . ": invalid parameter") if($TokyoCabinet::DEBUG); return undef; } return TokyoCabinet::bdb_copy($$self[0], $path); } sub tranbegin { my $self = shift; if(scalar(@_) != 0){ croak((caller(0))[3] . ": invalid parameter") if($TokyoCabinet::DEBUG); return undef; } return TokyoCabinet::bdb_tranbegin($$self[0]); } sub trancommit { my $self = shift; if(scalar(@_) != 0){ croak((caller(0))[3] . ": invalid parameter") if($TokyoCabinet::DEBUG); return undef; } return TokyoCabinet::bdb_trancommit($$self[0]); } sub tranabort { my $self = shift; if(scalar(@_) != 0){ croak((caller(0))[3] . ": invalid parameter") if($TokyoCabinet::DEBUG); return undef; } return TokyoCabinet::bdb_tranabort($$self[0]); } sub path { my $self = shift; if(scalar(@_) != 0){ croak((caller(0))[3] . ": invalid parameter") if($TokyoCabinet::DEBUG); return undef; } return TokyoCabinet::bdb_path($$self[0]); } sub rnum { my $self = shift; if(scalar(@_) != 0){ croak((caller(0))[3] . ": invalid parameter") if($TokyoCabinet::DEBUG); return undef; } return TokyoCabinet::bdb_rnum($$self[0]); } sub fsiz { my $self = shift; if(scalar(@_) != 0){ croak((caller(0))[3] . ": invalid parameter") if($TokyoCabinet::DEBUG); return undef; } return TokyoCabinet::bdb_fsiz($$self[0]); } sub TIEHASH { my $class = shift; my $path = shift; my $omode = shift; my $lmemb = shift; my $nmemb = shift; my $bnum = shift; my $apow = shift; my $fpow = shift; my $opts = shift; my $lcnum = shift; my $ncnum = shift; my $bdb = $class->new(); $bdb->tune($lmemb, $nmemb, $bnum, $apow, $fpow, $opts); $bdb->setcache($lcnum, $ncnum); return undef if(!$bdb->open($path, $omode)); $$bdb[1] = TokyoCabinet::BDBCUR->new($bdb); return $bdb; } sub UNTIE { my $self = shift; return $self->close(); } sub STORE { my $self = shift; my $key = shift; my $value = shift; return $self->put($key, $value); } sub DELETE { my $self = shift; my $key = shift; return $self->out($key); } sub FETCH { my $self = shift; my $key = shift; return $self->get($key); } sub EXISTS { my $self = shift; my $key = shift; return $self->vsiz($key) >= 0; } sub FIRSTKEY { my $self = shift; my $cur = $$self[1]; $cur->first(); my $key = $cur->key(); $cur->next(); return $key; } sub NEXTKEY { my $self = shift; my $cur = $$self[1]; my $key = $cur->key(); $cur->next(); return $key; } sub CLEAR { my $self = shift; return $self->vanish(); } package TokyoCabinet::BDBCUR; use strict; use warnings; use bytes; use Carp; use Encode; use constant { CPCURRENT => 0, CPBEFORE => 1, CPAFTER => 2, }; sub new { my $class = shift; my $bdb = shift; if(scalar(@_) != 0 || !defined($bdb) || ref($bdb) ne "TokyoCabinet::BDB"){ croak((caller(0))[3] . ": invalid parameter") if($TokyoCabinet::DEBUG); return undef; } my $self = [0]; $$self[0] = TokyoCabinet::bdbcur_new($$bdb[0]); bless($self, $class); return $self; } sub DESTROY { my $self = shift; return undef unless($$self[0]); TokyoCabinet::bdbcur_del($$self[0]); return undef; } sub first { my $self = shift; if(scalar(@_) != 0){ croak((caller(0))[3] . ": invalid parameter") if($TokyoCabinet::DEBUG); return undef; } return TokyoCabinet::bdbcur_first($$self[0]); } sub last { my $self = shift; if(scalar(@_) != 0){ croak((caller(0))[3] . ": invalid parameter") if($TokyoCabinet::DEBUG); return undef; } return TokyoCabinet::bdbcur_last($$self[0]); } sub jump { my $self = shift; my $key = shift; if(scalar(@_) != 0 || !defined($key)){ croak((caller(0))[3] . ": invalid parameter") if($TokyoCabinet::DEBUG); return undef; } return TokyoCabinet::bdbcur_jump($$self[0], $key); } sub prev { my $self = shift; if(scalar(@_) != 0){ croak((caller(0))[3] . ": invalid parameter") if($TokyoCabinet::DEBUG); return undef; } return TokyoCabinet::bdbcur_prev($$self[0]); } sub next { my $self = shift; if(scalar(@_) != 0){ croak((caller(0))[3] . ": invalid parameter") if($TokyoCabinet::DEBUG); return undef; } return TokyoCabinet::bdbcur_next($$self[0]); } sub put { my $self = shift; my $value = shift; my $cpmode = shift; if(scalar(@_) != 0 || !defined($value)){ croak((caller(0))[3] . ": invalid parameter") if($TokyoCabinet::DEBUG); return undef; } $cpmode = CPCURRENT if(!defined($cpmode)); return TokyoCabinet::bdbcur_put($$self[0], $value, $cpmode); } sub out { my $self = shift; if(scalar(@_) != 0){ croak((caller(0))[3] . ": invalid parameter") if($TokyoCabinet::DEBUG); return undef; } return TokyoCabinet::bdbcur_out($$self[0]); } sub key { my $self = shift; if(scalar(@_) != 0){ croak((caller(0))[3] . ": invalid parameter") if($TokyoCabinet::DEBUG); return undef; } return TokyoCabinet::bdbcur_key($$self[0]); } sub val { my $self = shift; if(scalar(@_) != 0){ croak((caller(0))[3] . ": invalid parameter") if($TokyoCabinet::DEBUG); return undef; } return TokyoCabinet::bdbcur_val($$self[0]); } #---------------------------------------------------------------- # the fixed-length database API #---------------------------------------------------------------- package TokyoCabinet::FDB; use strict; use warnings; use bytes; use Carp; use Encode; use constant { ESUCCESS => 0, ETHREAD => 1, EINVALID => 2, ENOFILE => 3, ENOPERM => 4, EMETA => 5, ERHEAD => 6, EOPEN => 7, ECLOSE => 8, ETRUNC => 9, ESYNC => 10, ESTAT => 11, ESEEK => 12, EREAD => 13, EWRITE => 14, EMMAP => 15, ELOCK => 16, EUNLINK => 17, ERENAME => 18, EMKDIR => 19, ERMDIR => 20, EKEEP => 21, ENOREC => 22, EMISC => 9999, }; use constant { OREADER => 1 << 0, OWRITER => 1 << 1, OCREAT => 1 << 2, OTRUNC => 1 << 3, ONOLCK => 1 << 4, OLCKNB => 1 << 5, }; sub new { my $class = shift; if(scalar(@_) != 0){ croak((caller(0))[3] . ": invalid parameter") if($TokyoCabinet::DEBUG); return undef; } my $self = [0]; $$self[0] = TokyoCabinet::fdb_new(); bless($self, $class); return $self; } sub DESTROY { my $self = shift; return undef unless($$self[0]); TokyoCabinet::fdb_del($$self[0]); return undef; } sub errmsg { my $self = shift; my $ecode = shift; if(scalar(@_) != 0){ croak((caller(0))[3] . ": invalid parameter") if($TokyoCabinet::DEBUG); return undef; } $ecode = $self->ecode() if(!defined($ecode) || $ecode < 0); return TokyoCabinet::fdb_errmsg($ecode); } sub ecode { my $self = shift; if(scalar(@_) != 0){ croak((caller(0))[3] . ": invalid parameter") if($TokyoCabinet::DEBUG); return undef; } return TokyoCabinet::fdb_ecode($$self[0]); } sub tune { my $self = shift; my $width = shift; my $limsiz = shift; if(scalar(@_) != 0){ croak((caller(0))[3] . ": invalid parameter") if($TokyoCabinet::DEBUG); return undef; } $width = -1 if(!defined($width)); $limsiz = -1 if(!defined($limsiz)); return TokyoCabinet::fdb_tune($$self[0], $width, $limsiz); } sub open { my $self = shift; my $path = shift; my $omode = shift; if(scalar(@_) != 0 || !defined($path)){ croak((caller(0))[3] . ": invalid parameter") if($TokyoCabinet::DEBUG); return undef; } $omode = OREADER if(!defined($omode)); return TokyoCabinet::fdb_open($$self[0], $path, $omode); } sub close { my $self = shift; if(scalar(@_) != 0){ croak((caller(0))[3] . ": invalid parameter") if($TokyoCabinet::DEBUG); return undef; } return TokyoCabinet::fdb_close($$self[0]); } sub put { my $self = shift; my $key = shift; my $value = shift; if(scalar(@_) != 0 || !defined($key) || !defined($value)){ croak((caller(0))[3] . ": invalid parameter") if($TokyoCabinet::DEBUG); return undef; } return TokyoCabinet::fdb_put($$self[0], $key, $value); } sub putkeep { my $self = shift; my $key = shift; my $value = shift; if(scalar(@_) != 0 || !defined($key) || !defined($value)){ croak((caller(0))[3] . ": invalid parameter") if($TokyoCabinet::DEBUG); return undef; } return TokyoCabinet::fdb_putkeep($$self[0], $key, $value); } sub putcat { my $self = shift; my $key = shift; my $value = shift; if(scalar(@_) != 0 || !defined($key) || !defined($value)){ croak((caller(0))[3] . ": invalid parameter") if($TokyoCabinet::DEBUG); return undef; } return TokyoCabinet::fdb_putcat($$self[0], $key, $value); } sub out { my $self = shift; my $key = shift; if(scalar(@_) != 0 || !defined($key)){ croak((caller(0))[3] . ": invalid parameter") if($TokyoCabinet::DEBUG); return undef; } return TokyoCabinet::fdb_out($$self[0], $key); } sub get { my $self = shift; my $key = shift; if(scalar(@_) != 0 || !defined($key)){ croak((caller(0))[3] . ": invalid parameter") if($TokyoCabinet::DEBUG); return undef; } return TokyoCabinet::fdb_get($$self[0], $key); } sub vsiz { my $self = shift; my $key = shift; if(scalar(@_) != 0 || !defined($key)){ croak((caller(0))[3] . ": invalid parameter") if($TokyoCabinet::DEBUG); return undef; } return TokyoCabinet::fdb_vsiz($$self[0], $key); } sub iterinit { my $self = shift; if(scalar(@_) != 0){ croak((caller(0))[3] . ": invalid parameter") if($TokyoCabinet::DEBUG); return undef; } return TokyoCabinet::fdb_iterinit($$self[0]); } sub iternext { my $self = shift; if(scalar(@_) != 0){ croak((caller(0))[3] . ": invalid parameter") if($TokyoCabinet::DEBUG); return undef; } return TokyoCabinet::fdb_iternext($$self[0]); } sub range { my $self = shift; my $interval = shift; my $max = shift; if(scalar(@_) != 0 || !defined($interval)){ croak((caller(0))[3] . ": invalid parameter") if($TokyoCabinet::DEBUG); return undef; } $max = -1 if(!defined($max)); return TokyoCabinet::fdb_range($$self[0], $interval, $max); } sub addint { my $self = shift; my $key = shift; my $num = shift; if(scalar(@_) != 0 || !defined($key) || !defined($num)){ croak((caller(0))[3] . ": invalid parameter") if($TokyoCabinet::DEBUG); return undef; } return TokyoCabinet::fdb_addint($$self[0], $key, $num); } sub adddouble { my $self = shift; my $key = shift; my $num = shift; if(scalar(@_) != 0 || !defined($key) || !defined($num)){ croak((caller(0))[3] . ": invalid parameter") if($TokyoCabinet::DEBUG); return undef; } return TokyoCabinet::fdb_adddouble($$self[0], $key, $num); } sub sync { my $self = shift; if(scalar(@_) != 0){ croak((caller(0))[3] . ": invalid parameter") if($TokyoCabinet::DEBUG); return undef; } return TokyoCabinet::fdb_sync($$self[0]); } sub optimize { my $self = shift; my $width = shift; my $limsiz = shift; if(scalar(@_) != 0){ croak((caller(0))[3] . ": invalid parameter") if($TokyoCabinet::DEBUG); return undef; } $width = -1 if(!defined($width)); $limsiz = -1 if(!defined($limsiz)); return TokyoCabinet::fdb_optimize($$self[0], $width, $limsiz); } sub vanish { my $self = shift; if(scalar(@_) != 0){ croak((caller(0))[3] . ": invalid parameter") if($TokyoCabinet::DEBUG); return undef; } return TokyoCabinet::fdb_vanish($$self[0]); } sub copy { my $self = shift; my $path = shift; if(scalar(@_) != 0 || !defined($path)){ croak((caller(0))[3] . ": invalid parameter") if($TokyoCabinet::DEBUG); return undef; } return TokyoCabinet::fdb_copy($$self[0], $path); } sub tranbegin { my $self = shift; if(scalar(@_) != 0){ croak((caller(0))[3] . ": invalid parameter") if($TokyoCabinet::DEBUG); return undef; } return TokyoCabinet::fdb_tranbegin($$self[0]); } sub trancommit { my $self = shift; if(scalar(@_) != 0){ croak((caller(0))[3] . ": invalid parameter") if($TokyoCabinet::DEBUG); return undef; } return TokyoCabinet::fdb_trancommit($$self[0]); } sub tranabort { my $self = shift; if(scalar(@_) != 0){ croak((caller(0))[3] . ": invalid parameter") if($TokyoCabinet::DEBUG); return undef; } return TokyoCabinet::fdb_tranabort($$self[0]); } sub path { my $self = shift; if(scalar(@_) != 0){ croak((caller(0))[3] . ": invalid parameter") if($TokyoCabinet::DEBUG); return undef; } return TokyoCabinet::fdb_path($$self[0]); } sub rnum { my $self = shift; if(scalar(@_) != 0){ croak((caller(0))[3] . ": invalid parameter") if($TokyoCabinet::DEBUG); return undef; } return TokyoCabinet::fdb_rnum($$self[0]); } sub fsiz { my $self = shift; if(scalar(@_) != 0){ croak((caller(0))[3] . ": invalid parameter") if($TokyoCabinet::DEBUG); return undef; } return TokyoCabinet::fdb_fsiz($$self[0]); } sub TIEHASH { my $class = shift; my $path = shift; my $omode = shift; my $width = shift; my $limsiz = shift; my $fdb = $class->new(); $fdb->tune($width, $limsiz); return undef if(!$fdb->open($path, $omode)); return $fdb; } sub UNTIE { my $self = shift; return $self->close(); } sub STORE { my $self = shift; my $key = shift; my $value = shift; return $self->put($key, $value); } sub DELETE { my $self = shift; my $key = shift; return $self->out($key); } sub FETCH { my $self = shift; my $key = shift; return $self->get($key); } sub EXISTS { my $self = shift; my $key = shift; return $self->vsiz($key) >= 0; } sub FIRSTKEY { my $self = shift; $self->iterinit(); return $self->iternext(); } sub NEXTKEY { my $self = shift; return $self->iternext(); } sub CLEAR { my $self = shift; return $self->vanish(); } #---------------------------------------------------------------- # the table database API #---------------------------------------------------------------- package TokyoCabinet::TDB; use strict; use warnings; use bytes; use Carp; use Encode; use constant { ESUCCESS => 0, ETHREAD => 1, EINVALID => 2, ENOFILE => 3, ENOPERM => 4, EMETA => 5, ERHEAD => 6, EOPEN => 7, ECLOSE => 8, ETRUNC => 9, ESYNC => 10, ESTAT => 11, ESEEK => 12, EREAD => 13, EWRITE => 14, EMMAP => 15, ELOCK => 16, EUNLINK => 17, ERENAME => 18, EMKDIR => 19, ERMDIR => 20, EKEEP => 21, ENOREC => 22, EMISC => 9999, }; use constant { TLARGE => 1 << 0, TDEFLATE => 1 << 1, TBZIP => 1 << 2, TTCBS => 1 << 3, }; use constant { OREADER => 1 << 0, OWRITER => 1 << 1, OCREAT => 1 << 2, OTRUNC => 1 << 3, ONOLCK => 1 << 4, OLCKNB => 1 << 5, OTSYNC => 1 << 6, }; use constant { ITLEXICAL => 0, ITDECIMAL => 1, ITTOKEN => 2, ITQGRAM => 3, ITOPT => 9998, ITVOID => 9999, ITKEEP => 1 << 24, }; sub new { my $class = shift; if(scalar(@_) != 0){ croak((caller(0))[3] . ": invalid parameter") if($TokyoCabinet::DEBUG); return undef; } my $self = [0]; $$self[0] = TokyoCabinet::tdb_new(); bless($self, $class); return $self; } sub DESTROY { my $self = shift; return undef unless($$self[0]); TokyoCabinet::tdb_del($$self[0]); return undef; } sub errmsg { my $self = shift; my $ecode = shift; if(scalar(@_) != 0){ croak((caller(0))[3] . ": invalid parameter") if($TokyoCabinet::DEBUG); return undef; } $ecode = $self->ecode() if(!defined($ecode) || $ecode < 0); return TokyoCabinet::tdb_errmsg($ecode); } sub ecode { my $self = shift; if(scalar(@_) != 0){ croak((caller(0))[3] . ": invalid parameter") if($TokyoCabinet::DEBUG); return undef; } return TokyoCabinet::tdb_ecode($$self[0]); } sub tune { my $self = shift; my $bnum = shift; my $apow = shift; my $fpow = shift; my $opts = shift; if(scalar(@_) != 0){ croak((caller(0))[3] . ": invalid parameter") if($TokyoCabinet::DEBUG); return undef; } $bnum = -1 if(!defined($bnum)); $apow = -1 if(!defined($apow)); $fpow = -1 if(!defined($fpow)); $opts = 0 if(!defined($opts)); return TokyoCabinet::tdb_tune($$self[0], $bnum, $apow, $fpow, $opts); } sub setcache { my $self = shift; my $rcnum = shift; my $lcnum = shift; my $ncnum = shift; if(scalar(@_) != 0){ croak((caller(0))[3] . ": invalid parameter") if($TokyoCabinet::DEBUG); return undef; } $rcnum = -1 if(!defined($rcnum)); $lcnum = -1 if(!defined($lcnum)); $ncnum = -1 if(!defined($ncnum)); return TokyoCabinet::tdb_setcache($$self[0], $rcnum, $lcnum, $ncnum); } sub setxmsiz { my $self = shift; my $xmsiz = shift; if(scalar(@_) != 0){ croak((caller(0))[3] . ": invalid parameter") if($TokyoCabinet::DEBUG); return undef; } $xmsiz = -1 if(!defined($xmsiz)); return TokyoCabinet::tdb_setxmsiz($$self[0], $xmsiz); } sub setdfunit { my $self = shift; my $dfunit = shift; if(scalar(@_) != 0){ croak((caller(0))[3] . ": invalid parameter") if($TokyoCabinet::DEBUG); return undef; } $dfunit = -1 if(!defined($dfunit)); return TokyoCabinet::tdb_setdfunit($$self[0], $dfunit); } sub open { my $self = shift; my $path = shift; my $omode = shift; if(scalar(@_) != 0 || !defined($path)){ croak((caller(0))[3] . ": invalid parameter") if($TokyoCabinet::DEBUG); return undef; } $omode = OREADER if(!defined($omode)); return TokyoCabinet::tdb_open($$self[0], $path, $omode); } sub close { my $self = shift; if(scalar(@_) != 0){ croak((caller(0))[3] . ": invalid parameter") if($TokyoCabinet::DEBUG); return undef; } return TokyoCabinet::tdb_close($$self[0]); } sub put { my $self = shift; my $pkey = shift; my $cols = shift; if(scalar(@_) != 0 || !defined($pkey) || !defined($cols) || ref($cols) ne "HASH"){ croak((caller(0))[3] . ": invalid parameter") if($TokyoCabinet::DEBUG); return undef; } return TokyoCabinet::tdb_put($$self[0], $pkey, $cols); } sub putkeep { my $self = shift; my $pkey = shift; my $cols = shift; if(scalar(@_) != 0 || !defined($pkey) || !defined($cols) || ref($cols) ne "HASH"){ croak((caller(0))[3] . ": invalid parameter") if($TokyoCabinet::DEBUG); return undef; } return TokyoCabinet::tdb_putkeep($$self[0], $pkey, $cols); } sub putcat { my $self = shift; my $pkey = shift; my $cols = shift; if(scalar(@_) != 0 || !defined($pkey) || !defined($cols) || ref($cols) ne "HASH"){ croak((caller(0))[3] . ": invalid parameter") if($TokyoCabinet::DEBUG); return undef; } return TokyoCabinet::tdb_putcat($$self[0], $pkey, $cols); } sub out { my $self = shift; my $pkey = shift; if(scalar(@_) != 0 || !defined($pkey)){ croak((caller(0))[3] . ": invalid parameter") if($TokyoCabinet::DEBUG); return undef; } return TokyoCabinet::tdb_out($$self[0], $pkey); } sub get { my $self = shift; my $pkey = shift; if(scalar(@_) != 0 || !defined($pkey)){ croak((caller(0))[3] . ": invalid parameter") if($TokyoCabinet::DEBUG); return undef; } return TokyoCabinet::tdb_get($$self[0], $pkey); } sub vsiz { my $self = shift; my $pkey = shift; if(scalar(@_) != 0 || !defined($pkey)){ croak((caller(0))[3] . ": invalid parameter") if($TokyoCabinet::DEBUG); return undef; } return TokyoCabinet::tdb_vsiz($$self[0], $pkey); } sub iterinit { my $self = shift; if(scalar(@_) != 0){ croak((caller(0))[3] . ": invalid parameter") if($TokyoCabinet::DEBUG); return undef; } return TokyoCabinet::tdb_iterinit($$self[0]); } sub iternext { my $self = shift; if(scalar(@_) != 0){ croak((caller(0))[3] . ": invalid parameter") if($TokyoCabinet::DEBUG); return undef; } return TokyoCabinet::tdb_iternext($$self[0]); } sub fwmkeys { my $self = shift; my $prefix = shift; my $max = shift; if(scalar(@_) != 0 || !defined($prefix)){ croak((caller(0))[3] . ": invalid parameter") if($TokyoCabinet::DEBUG); return undef; } $max = -1 if(!defined($max)); return TokyoCabinet::tdb_fwmkeys($$self[0], $prefix, $max); } sub addint { my $self = shift; my $pkey = shift; my $num = shift; if(scalar(@_) != 0 || !defined($pkey) || !defined($num)){ croak((caller(0))[3] . ": invalid parameter") if($TokyoCabinet::DEBUG); return undef; } return TokyoCabinet::tdb_addint($$self[0], $pkey, $num); } sub adddouble { my $self = shift; my $pkey = shift; my $num = shift; if(scalar(@_) != 0 || !defined($pkey) || !defined($num)){ croak((caller(0))[3] . ": invalid parameter") if($TokyoCabinet::DEBUG); return undef; } return TokyoCabinet::tdb_adddouble($$self[0], $pkey, $num); } sub sync { my $self = shift; if(scalar(@_) != 0){ croak((caller(0))[3] . ": invalid parameter") if($TokyoCabinet::DEBUG); return undef; } return TokyoCabinet::tdb_sync($$self[0]); } sub optimize { my $self = shift; my $bnum = shift; my $apow = shift; my $fpow = shift; my $opts = shift; if(scalar(@_) != 0){ croak((caller(0))[3] . ": invalid parameter") if($TokyoCabinet::DEBUG); return undef; } $bnum = -1 if(!defined($bnum)); $apow = -1 if(!defined($apow)); $fpow = -1 if(!defined($fpow)); $opts = 0xff if(!defined($opts)); return TokyoCabinet::tdb_optimize($$self[0], $bnum, $apow, $fpow, $opts); } sub vanish { my $self = shift; if(scalar(@_) != 0){ croak((caller(0))[3] . ": invalid parameter") if($TokyoCabinet::DEBUG); return undef; } return TokyoCabinet::tdb_vanish($$self[0]); } sub copy { my $self = shift; my $path = shift; if(scalar(@_) != 0 || !defined($path)){ croak((caller(0))[3] . ": invalid parameter") if($TokyoCabinet::DEBUG); return undef; } return TokyoCabinet::tdb_copy($$self[0], $path); } sub tranbegin { my $self = shift; if(scalar(@_) != 0){ croak((caller(0))[3] . ": invalid parameter") if($TokyoCabinet::DEBUG); return undef; } return TokyoCabinet::tdb_tranbegin($$self[0]); } sub trancommit { my $self = shift; if(scalar(@_) != 0){ croak((caller(0))[3] . ": invalid parameter") if($TokyoCabinet::DEBUG); return undef; } return TokyoCabinet::tdb_trancommit($$self[0]); } sub tranabort { my $self = shift; if(scalar(@_) != 0){ croak((caller(0))[3] . ": invalid parameter") if($TokyoCabinet::DEBUG); return undef; } return TokyoCabinet::tdb_tranabort($$self[0]); } sub path { my $self = shift; if(scalar(@_) != 0){ croak((caller(0))[3] . ": invalid parameter") if($TokyoCabinet::DEBUG); return undef; } return TokyoCabinet::tdb_path($$self[0]); } sub rnum { my $self = shift; if(scalar(@_) != 0){ croak((caller(0))[3] . ": invalid parameter") if($TokyoCabinet::DEBUG); return undef; } return TokyoCabinet::tdb_rnum($$self[0]); } sub fsiz { my $self = shift; if(scalar(@_) != 0){ croak((caller(0))[3] . ": invalid parameter") if($TokyoCabinet::DEBUG); return undef; } return TokyoCabinet::tdb_fsiz($$self[0]); } sub setindex { my $self = shift; my $name = shift; my $type = shift; if(scalar(@_) != 0 || !defined($name) || !defined($type)){ croak((caller(0))[3] . ": invalid parameter") if($TokyoCabinet::DEBUG); return undef; } return TokyoCabinet::tdb_setindex($$self[0], $name, $type); } sub genuid { my $self = shift; if(scalar(@_) != 0){ croak((caller(0))[3] . ": invalid parameter") if($TokyoCabinet::DEBUG); return undef; } return TokyoCabinet::tdb_genuid($$self[0]); } sub TIEHASH { my $class = shift; my $path = shift; my $omode = shift; my $bnum = shift; my $apow = shift; my $fpow = shift; my $opts = shift; my $rcnum = shift; my $lcnum = shift; my $ncnum = shift; my $tdb = $class->new(); $tdb->tune($bnum, $apow, $fpow, $opts); $tdb->setcache($rcnum, $lcnum, $ncnum); return undef if(!$tdb->open($path, $omode)); return $tdb; } sub UNTIE { my $self = shift; return $self->close(); } sub STORE { my $self = shift; my $pkey = shift; my $value = shift; return $self->put($pkey, $value); } sub DELETE { my $self = shift; my $pkey = shift; return $self->out($pkey); } sub FETCH { my $self = shift; my $pkey = shift; return $self->get($pkey); } sub EXISTS { my $self = shift; my $pkey = shift; return $self->vsiz($pkey) >= 0; } sub FIRSTKEY { my $self = shift; $self->iterinit(); return $self->iternext(); } sub NEXTKEY { my $self = shift; return $self->iternext(); } sub CLEAR { my $self = shift; return $self->vanish(); } package TokyoCabinet::TDBQRY; use strict; use warnings; use bytes; use Carp; use Encode; use constant { QCSTREQ => 0, QCSTRINC => 1, QCSTRBW => 2, QCSTREW => 3, QCSTRAND => 4, QCSTROR => 5, QCSTROREQ => 6, QCSTRRX => 7, QCNUMEQ => 8, QCNUMGT => 9, QCNUMGE => 10, QCNUMLT => 11, QCNUMLE => 12, QCNUMBT => 13, QCNUMOREQ => 14, QCFTSPH => 15, QCFTSAND => 16, QCFTSOR => 17, QCFTSEX => 18, QCNEGATE => 1 << 24, QCNOIDX => 1 << 25, }; use constant { QOSTRASC => 0, QOSTRDESC => 1, QONUMASC => 2, QONUMDESC => 3, }; use constant { QPPUT => 1 << 0, QPOUT => 1 << 1, QPSTOP => 1 << 24, }; use constant { KWMUTAB => 1 << 0, KWMUCTRL => 1 << 1, KWMUBRCT => 1 << 2, KWNOOVER => 1 << 24, KWPULEAD => 1 << 25, }; use constant { MSUNION => 0, MSISECT => 1, MSDIFF => 2, }; sub new { my $class = shift; my $tdb = shift; if(scalar(@_) != 0 || !defined($tdb) || ref($tdb) ne "TokyoCabinet::TDB"){ croak((caller(0))[3] . ": invalid parameter") if($TokyoCabinet::DEBUG); return undef; } my $self = [0]; $$self[0] = TokyoCabinet::tdbqry_new($$tdb[0]); bless($self, $class); return $self; } sub DESTROY { my $self = shift; return undef unless($$self[0]); TokyoCabinet::tdbqry_del($$self[0]); return undef; } sub addcond { my $self = shift; my $name = shift; my $op = shift; my $expr = shift; if(scalar(@_) != 0 || !defined($name) || !defined($op) || !defined($expr)){ croak((caller(0))[3] . ": invalid parameter") if($TokyoCabinet::DEBUG); return undef; } TokyoCabinet::tdbqry_addcond($$self[0], $name, $op, $expr); return undef; } sub setorder { my $self = shift; my $name = shift; my $type = shift; if(scalar(@_) != 0 || !defined($name)){ croak((caller(0))[3] . ": invalid parameter") if($TokyoCabinet::DEBUG); return undef; } $type = $self->QOSTRASC if(!defined($type)); TokyoCabinet::tdbqry_setorder($$self[0], $name, $type); return undef; } sub setlimit { my $self = shift; my $max = shift; my $skip = shift; if(scalar(@_) != 0){ croak((caller(0))[3] . ": invalid parameter") if($TokyoCabinet::DEBUG); return undef; } $max = -1 if(!defined($max)); $skip = -1 if(!defined($skip)); TokyoCabinet::tdbqry_setlimit($$self[0], $max, $skip); return undef; } sub search { my $self = shift; if(scalar(@_) != 0){ croak((caller(0))[3] . ": invalid parameter") if($TokyoCabinet::DEBUG); return undef; } return TokyoCabinet::tdbqry_search($$self[0]); } sub searchout { my $self = shift; if(scalar(@_) != 0){ croak((caller(0))[3] . ": invalid parameter") if($TokyoCabinet::DEBUG); return undef; } return TokyoCabinet::tdbqry_searchout($$self[0]); } sub proc { my $self = shift; my $proc = shift; if(scalar(@_) != 0 || !defined($proc)){ croak((caller(0))[3] . ": invalid parameter") if($TokyoCabinet::DEBUG); return undef; } return TokyoCabinet::tdbqry_proc($$self[0], $proc); } sub hint { my $self = shift; if(scalar(@_) != 0){ croak((caller(0))[3] . ": invalid parameter") if($TokyoCabinet::DEBUG); return undef; } return TokyoCabinet::tdbqry_hint($$self[0]); } sub metasearch { my $self = shift; my $others = shift; my $type = shift; if(scalar(@_) != 0 || !defined($others) || ref($others) ne "ARRAY"){ croak((caller(0))[3] . ": invalid parameter") if($TokyoCabinet::DEBUG); return undef; } $type = $self->MSUNION if(!defined($type)); return TokyoCabinet::tdbqry_metasearch($$self[0], $others, $type); } sub kwic { my $self = shift; my $cols = shift; my $name = shift; my $width = shift; my $opts = shift; if(scalar(@_) != 0 || !defined($cols) || ref($cols) ne "HASH"){ croak((caller(0))[3] . ": invalid parameter") if($TokyoCabinet::DEBUG); return undef; } $name = "[[undef]]" if(!defined($name)); $opts = 0 if(!defined($opts)); if(!defined($width) || $width < 0){ $width = 1 << 30; $opts |= $self->KWNOOVER | $self->KWPULEAD; } return TokyoCabinet::tdbqry_kwic($$self[0], $cols, $name, $width, $opts); } sub setmax { return setlimit(@_); } #---------------------------------------------------------------- # the abstract database API #---------------------------------------------------------------- package TokyoCabinet::ADB; use strict; use warnings; use bytes; use Carp; use Encode; sub new { my $class = shift; if(scalar(@_) != 0){ croak((caller(0))[3] . ": invalid parameter") if($TokyoCabinet::DEBUG); return undef; } my $self = [0]; $$self[0] = TokyoCabinet::adb_new(); bless($self, $class); return $self; } sub DESTROY { my $self = shift; return undef unless($$self[0]); TokyoCabinet::adb_del($$self[0]); return undef; } sub open { my $self = shift; my $name = shift; if(scalar(@_) != 0 || !defined($name)){ croak((caller(0))[3] . ": invalid parameter") if($TokyoCabinet::DEBUG); return undef; } return TokyoCabinet::adb_open($$self[0], $name); } sub close { my $self = shift; if(scalar(@_) != 0){ croak((caller(0))[3] . ": invalid parameter") if($TokyoCabinet::DEBUG); return undef; } return TokyoCabinet::adb_close($$self[0]); } sub put { my $self = shift; my $key = shift; my $value = shift; if(scalar(@_) != 0 || !defined($key) || !defined($value)){ croak((caller(0))[3] . ": invalid parameter") if($TokyoCabinet::DEBUG); return undef; } return TokyoCabinet::adb_put($$self[0], $key, $value); } sub putkeep { my $self = shift; my $key = shift; my $value = shift; if(scalar(@_) != 0 || !defined($key) || !defined($value)){ croak((caller(0))[3] . ": invalid parameter") if($TokyoCabinet::DEBUG); return undef; } return TokyoCabinet::adb_putkeep($$self[0], $key, $value); } sub putcat { my $self = shift; my $key = shift; my $value = shift; if(scalar(@_) != 0 || !defined($key) || !defined($value)){ croak((caller(0))[3] . ": invalid parameter") if($TokyoCabinet::DEBUG); return undef; } return TokyoCabinet::adb_putcat($$self[0], $key, $value); } sub out { my $self = shift; my $key = shift; if(scalar(@_) != 0 || !defined($key)){ croak((caller(0))[3] . ": invalid parameter") if($TokyoCabinet::DEBUG); return undef; } return TokyoCabinet::adb_out($$self[0], $key); } sub get { my $self = shift; my $key = shift; if(scalar(@_) != 0 || !defined($key)){ croak((caller(0))[3] . ": invalid parameter") if($TokyoCabinet::DEBUG); return undef; } return TokyoCabinet::adb_get($$self[0], $key); } sub vsiz { my $self = shift; my $key = shift; if(scalar(@_) != 0 || !defined($key)){ croak((caller(0))[3] . ": invalid parameter") if($TokyoCabinet::DEBUG); return undef; } return TokyoCabinet::adb_vsiz($$self[0], $key); } sub iterinit { my $self = shift; if(scalar(@_) != 0){ croak((caller(0))[3] . ": invalid parameter") if($TokyoCabinet::DEBUG); return undef; } return TokyoCabinet::adb_iterinit($$self[0]); } sub iternext { my $self = shift; if(scalar(@_) != 0){ croak((caller(0))[3] . ": invalid parameter") if($TokyoCabinet::DEBUG); return undef; } return TokyoCabinet::adb_iternext($$self[0]); } sub fwmkeys { my $self = shift; my $prefix = shift; my $max = shift; if(scalar(@_) != 0 || !defined($prefix)){ croak((caller(0))[3] . ": invalid parameter") if($TokyoCabinet::DEBUG); return undef; } $max = -1 if(!defined($max)); return TokyoCabinet::adb_fwmkeys($$self[0], $prefix, $max); } sub addint { my $self = shift; my $key = shift; my $num = shift; if(scalar(@_) != 0 || !defined($key) || !defined($num)){ croak((caller(0))[3] . ": invalid parameter") if($TokyoCabinet::DEBUG); return undef; } return TokyoCabinet::adb_addint($$self[0], $key, $num); } sub adddouble { my $self = shift; my $key = shift; my $num = shift; if(scalar(@_) != 0 || !defined($key) || !defined($num)){ croak((caller(0))[3] . ": invalid parameter") if($TokyoCabinet::DEBUG); return undef; } return TokyoCabinet::adb_adddouble($$self[0], $key, $num); } sub sync { my $self = shift; if(scalar(@_) != 0){ croak((caller(0))[3] . ": invalid parameter") if($TokyoCabinet::DEBUG); return undef; } return TokyoCabinet::adb_sync($$self[0]); } sub optimize { my $self = shift; my $params = shift; if(scalar(@_) != 0){ croak((caller(0))[3] . ": invalid parameter") if($TokyoCabinet::DEBUG); return undef; } $params = "" if(!defined($params)); return TokyoCabinet::adb_optimize($$self[0], $params); } sub vanish { my $self = shift; if(scalar(@_) != 0){ croak((caller(0))[3] . ": invalid parameter") if($TokyoCabinet::DEBUG); return undef; } return TokyoCabinet::adb_vanish($$self[0]); } sub copy { my $self = shift; my $path = shift; if(scalar(@_) != 0 || !defined($path)){ croak((caller(0))[3] . ": invalid parameter") if($TokyoCabinet::DEBUG); return undef; } return TokyoCabinet::adb_copy($$self[0], $path); } sub tranbegin { my $self = shift; if(scalar(@_) != 0){ croak((caller(0))[3] . ": invalid parameter") if($TokyoCabinet::DEBUG); return undef; } return TokyoCabinet::adb_tranbegin($$self[0]); } sub trancommit { my $self = shift; if(scalar(@_) != 0){ croak((caller(0))[3] . ": invalid parameter") if($TokyoCabinet::DEBUG); return undef; } return TokyoCabinet::adb_trancommit($$self[0]); } sub tranabort { my $self = shift; if(scalar(@_) != 0){ croak((caller(0))[3] . ": invalid parameter") if($TokyoCabinet::DEBUG); return undef; } return TokyoCabinet::adb_tranabort($$self[0]); } sub path { my $self = shift; if(scalar(@_) != 0){ croak((caller(0))[3] . ": invalid parameter") if($TokyoCabinet::DEBUG); return undef; } return TokyoCabinet::adb_path($$self[0]); } sub rnum { my $self = shift; if(scalar(@_) != 0){ croak((caller(0))[3] . ": invalid parameter") if($TokyoCabinet::DEBUG); return undef; } return TokyoCabinet::adb_rnum($$self[0]); } sub size { my $self = shift; if(scalar(@_) != 0){ croak((caller(0))[3] . ": invalid parameter") if($TokyoCabinet::DEBUG); return undef; } return TokyoCabinet::adb_size($$self[0]); } sub misc { my $self = shift; my $name = shift; my $args = shift; if(scalar(@_) != 0 || !defined($name)){ croak((caller(0))[3] . ": invalid parameter") if($TokyoCabinet::DEBUG); return undef; } $args = [] if(!defined($args) || ref($args) ne "ARRAY"); return TokyoCabinet::adb_misc($$self[0], $name, $args); } sub TIEHASH { my $class = shift; my $name = shift; my $adb = $class->new(); return undef if(!$adb->open($name)); return $adb; } sub UNTIE { my $self = shift; return $self->close(); } sub STORE { my $self = shift; my $key = shift; my $value = shift; return $self->put($key, $value); } sub DELETE { my $self = shift; my $key = shift; return $self->out($key); } sub FETCH { my $self = shift; my $key = shift; return $self->get($key); } sub EXISTS { my $self = shift; my $key = shift; return $self->vsiz($key) >= 0; } sub FIRSTKEY { my $self = shift; $self->iterinit(); return $self->iternext(); } sub NEXTKEY { my $self = shift; return $self->iternext(); } sub CLEAR { my $self = shift; return $self->vanish(); } 1; # END OF FILE tokyocabinet-perl-1.34/memsize.pl0000644000175000017500000000147211420766705016120 0ustar mikiomikio#! /usr/bin/perl use lib qw(./blib/lib ./blib/arch); use strict; use warnings; use TokyoCabinet; use Time::HiRes qw(gettimeofday); sub memoryusage { my $status = `cat /proc/$$/status`; my @lines = split("\n", $status); foreach my $line (@lines){ if($line =~ /^VmRSS:/){ $line =~ s/.*:\s*(\d+).*/$1/; return int($line) / 1024.0; } } return -1; } my $rnum = 1000000; if(scalar(@ARGV) > 0){ $rnum = int($ARGV[0]); } my %hash; if(scalar(@ARGV) > 1){ tie(%hash, "TokyoCabinet::ADB", $ARGV[1]) || die("tie failed"); } my $stime = gettimeofday(); for(my $i = 0; $i < $rnum; $i++){ my $buf = sprintf("%08d", $i); $hash{$buf} = $buf; } my $etime = gettimeofday(); printf("Time: %.3f sec.\n", $etime - $stime); printf("Usage: %.3f MB\n", memoryusage()); tokyocabinet-perl-1.34/tcbtest.pl0000644000175000017500000004421511420766747016127 0ustar mikiomikio#! /usr/bin/perl -w #------------------------------------------------------------------------------------------------- # The test cases of the B+ tree database API # Copyright (C) 2006-2010 FAL Labs # This file is part of Tokyo Cabinet. # Tokyo Cabinet is free software; you can redistribute it and/or modify it under the terms of # the GNU Lesser General Public License as published by the Free Software Foundation; either # version 2.1 of the License or any later version. Tokyo Cabinet is distributed in the hope # that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public # License for more details. # You should have received a copy of the GNU Lesser General Public License along with Tokyo # Cabinet; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, # Boston, MA 02111-1307 USA. #------------------------------------------------------------------------------------------------- use lib qw(./blib/lib ./blib/arch); use strict; use warnings; use ExtUtils::testlib; use Time::HiRes qw(gettimeofday); use Data::Dumper; use TokyoCabinet; $TokyoCabinet::DEBUG = 1; # main routine sub main { my $rv; scalar(@ARGV) >= 1 || usage(); if($ARGV[0] eq "write"){ $rv = runwrite(); } elsif($ARGV[0] eq "read"){ $rv = runread(); } elsif($ARGV[0] eq "remove"){ $rv = runremove(); } elsif($ARGV[0] eq "misc"){ $rv = runmisc(); } else { usage(); } return $rv; } # print the usage and exit sub usage { printf STDERR ("$0: test cases of the B+ tree database API\n"); printf STDERR ("\n"); printf STDERR ("usage:\n"); printf STDERR (" $0 write [-tl] [-td|-tb|-tt] [-nl|-nb] path rnum" . " [lmemb [nmemb [bnum [apow [fpow]]]]]\n"); printf STDERR (" $0 read [-nl|-nb] path\n"); printf STDERR (" $0 remove [-nl|-nb] path\n"); printf STDERR (" $0 misc [-tl] [-td|-tb|-tt] [-nl|-nb] path rnum\n"); printf STDERR ("\n"); exit(1); } # parse arguments of write command sub runwrite { my $path = undef; my $rnum = undef; my $lmemb = undef; my $nmemb = undef; my $bnum = undef; my $apow = undef; my $fpow = undef; my $opts = 0; my $omode = 0; for(my $i = 1; $i < scalar(@ARGV); $i++){ if(!defined($path) && $ARGV[$i] =~ /^-/){ if($ARGV[$i] eq "-tl"){ $opts |= TokyoCabinet::BDB::TLARGE; } elsif($ARGV[$i] eq "-td"){ $opts |= TokyoCabinet::BDB::TDEFLATE; } elsif($ARGV[$i] eq "-tb"){ $opts |= TokyoCabinet::BDB::TBZIP; } elsif($ARGV[$i] eq "-tt"){ $opts |= TokyoCabinet::BDB::TTCBS; } elsif($ARGV[$i] eq "-nl"){ $omode |= TokyoCabinet::BDB::ONOLCK; } elsif($ARGV[$i] eq "-nb"){ $omode |= TokyoCabinet::BDB::OLCKNB; } else { usage(); } } elsif(!defined($path)){ $path = $ARGV[$i]; } elsif(!defined($rnum)){ $rnum = TokyoCabinet::atoi($ARGV[$i]); } elsif(!defined($lmemb)){ $lmemb = TokyoCabinet::atoi($ARGV[$i]); } elsif(!defined($nmemb)){ $nmemb = TokyoCabinet::atoi($ARGV[$i]); } elsif(!defined($bnum)){ $bnum = TokyoCabinet::atoi($ARGV[$i]); } elsif(!defined($apow)){ $apow = TokyoCabinet::atoi($ARGV[$i]); } elsif(!defined($fpow)){ $fpow = TokyoCabinet::atoi($ARGV[$i]); } else { usage(); } } usage() if(!defined($path) || !defined($rnum) || $rnum < 1); $lmemb = defined($lmemb) ? $lmemb : -1; $nmemb = defined($nmemb) ? $nmemb : -1; $bnum = defined($bnum) ? $bnum : -1; $apow = defined($apow) ? $apow : -1; $fpow = defined($fpow) ? $fpow : -1; my $rv = procwrite($path, $rnum, $lmemb, $nmemb, $bnum, $apow, $fpow, $opts, $omode); return $rv; } # parse arguments of read command sub runread { my $path = undef; my $omode = 0; for(my $i = 1; $i < scalar(@ARGV); $i++){ if(!defined($path) && $ARGV[$i] =~ /^-/){ if($ARGV[$i] eq "-nl"){ $omode |= TokyoCabinet::BDB::ONOLCK; } elsif($ARGV[$i] eq "-nb"){ $omode |= TokyoCabinet::BDB::OLCKNB; } else { usage(); } } elsif(!defined($path)){ $path = $ARGV[$i]; } else { usage(); } } usage() if(!defined($path)); my $rv = procread($path, $omode); return $rv; } # parse arguments of remove command sub runremove { my $path = undef; my $omode = 0; for(my $i = 1; $i < scalar(@ARGV); $i++){ if(!defined($path) && $ARGV[$i] =~ /^-/){ if($ARGV[$i] eq "-nl"){ $omode |= TokyoCabinet::BDB::ONOLCK; } elsif($ARGV[$i] eq "-nb"){ $omode |= TokyoCabinet::BDB::OLCKNB; } else { usage(); } } elsif(!defined($path)){ $path = $ARGV[$i]; } else { usage(); } } usage() if(!defined($path)); my $rv = procremove($path, $omode); return $rv; } # parse arguments of misc command sub runmisc { my $path = undef; my $rnum = undef; my $opts = 0; my $omode = 0; for(my $i = 1; $i < scalar(@ARGV); $i++){ if(!defined($path) && $ARGV[$i] =~ /^-/){ if($ARGV[$i] eq "-tl"){ $opts |= TokyoCabinet::BDB::TLARGE; } elsif($ARGV[$i] eq "-td"){ $opts |= TokyoCabinet::BDB::TDEFLATE; } elsif($ARGV[$i] eq "-tb"){ $opts |= TokyoCabinet::BDB::TBZIP; } elsif($ARGV[$i] eq "-tt"){ $opts |= TokyoCabinet::BDB::TTCBS; } elsif($ARGV[$i] eq "-nl"){ $omode |= TokyoCabinet::BDB::ONOLCK; } elsif($ARGV[$i] eq "-nb"){ $omode |= TokyoCabinet::BDB::OLCKNB; } else { usage(); } } elsif(!defined($path)){ $path = $ARGV[$i]; } elsif(!defined($rnum)){ $rnum = TokyoCabinet::atoi($ARGV[$i]); } else { usage(); } } usage() if(!defined($path) || !defined($rnum) || $rnum < 1); my $rv = procmisc($path, $rnum, $opts, $omode); return $rv; } # print error message of B+ tree database sub eprint { my $hdb = shift; my $func = shift; my $path = $hdb->path(); printf STDERR ("%s: %s: %s: %s\n", $0, defined($path) ? $path : "-", $func, $hdb->errmsg()); } # perform write command sub procwrite { my $path = shift; my $rnum = shift; my $lmemb = shift; my $nmemb = shift; my $bnum = shift; my $apow = shift; my $fpow = shift; my $opts = shift; my $omode = shift; printf("\n path=%s rnum=%d lmemb=%d nmemb=%d bnum=%d apow=%d fpow=%d" . " opts=%d omode=%d\n\n", $path, $rnum, $lmemb, $nmemb, $bnum, $apow, $fpow, $opts, $omode); my $err = 0; my $stime = gettimeofday(); my $bdb = TokyoCabinet::BDB->new(); if(!$bdb->tune($lmemb, $nmemb, $bnum, $apow, $fpow, $opts)){ eprint($bdb, "tune"); $err = 1; } if(!$bdb->open($path, $bdb->OWRITER | $bdb->OCREAT | $bdb->OTRUNC | $omode)){ eprint($bdb, "open"); $err = 1; } for(my $i = 1; $i <= $rnum; $i++){ my $buf = sprintf("%08d", $i); if(!$bdb->put($buf, $buf)){ eprint($bdb, "put"); $err = 1; last; } if($rnum > 250 && $i % ($rnum / 250) == 0){ print('.'); if($i == $rnum || $i % ($rnum / 10) == 0){ printf(" (%08d)\n", $i); } } } printf("record number: %llu\n", $bdb->rnum()); printf("size: %llu\n", $bdb->fsiz()); if(!$bdb->close()){ eprint($bdb, "close"); $err = 1; } printf("time: %.3f\n", gettimeofday() - $stime); printf("%s\n\n", $err ? "error" : "ok"); return $err ? 1 : 0; } # perform read command sub procread { my $path = shift; my $omode = shift; printf("\n path=%s omode=%d\n\n", $path, $omode); my $err = 0; my $stime = gettimeofday(); my $bdb = TokyoCabinet::BDB->new(); if(!$bdb->open($path, $bdb->OREADER | $omode)){ eprint($bdb, "open"); $err = 1; } my $rnum = $bdb->rnum(); for(my $i = 1; $i <= $rnum; $i++){ my $buf = sprintf("%08d", $i); if(!$bdb->get($buf)){ eprint($bdb, "get"); $err = 1; last; } if($rnum > 250 && $i % ($rnum / 250) == 0){ print('.'); if($i == $rnum || $i % ($rnum / 10) == 0){ printf(" (%08d)\n", $i); } } } printf("record number: %llu\n", $bdb->rnum()); printf("size: %llu\n", $bdb->fsiz()); if(!$bdb->close()){ eprint($bdb, "close"); $err = 1; } printf("time: %.3f\n", gettimeofday() - $stime); printf("%s\n\n", $err ? "error" : "ok"); return $err ? 1 : 0; } # perform remove command sub procremove { my $path = shift; my $omode = shift; printf("\n path=%s omode=%d\n\n", $path, $omode); my $err = 0; my $stime = gettimeofday(); my $bdb = TokyoCabinet::BDB->new(); if(!$bdb->open($path, $bdb->OWRITER | $omode)){ eprint($bdb, "open"); $err = 1; } my $rnum = $bdb->rnum(); for(my $i = 1; $i <= $rnum; $i++){ my $buf = sprintf("%08d", $i); if(!$bdb->out($buf)){ eprint($bdb, "out"); $err = 1; last; } if($rnum > 250 && $i % ($rnum / 250) == 0){ print('.'); if($i == $rnum || $i % ($rnum / 10) == 0){ printf(" (%08d)\n", $i); } } } printf("record number: %llu\n", $bdb->rnum()); printf("size: %llu\n", $bdb->fsiz()); if(!$bdb->close()){ eprint($bdb, "close"); $err = 1; } printf("time: %.3f\n", gettimeofday() - $stime); printf("%s\n\n", $err ? "error" : "ok"); return $err ? 1 : 0; } # perform misc command sub procmisc { my $path = shift; my $rnum = shift; my $opts = shift; my $omode = shift; printf("\n path=%s rnum=%d opts=%d omode=%d\n\n", $path, $rnum, $opts, $omode); my $err = 0; my $stime = gettimeofday(); my $bdb = TokyoCabinet::BDB->new(); if(!$bdb->tune(10, 10, $rnum / 50, 2, -1, $opts)){ eprint($bdb, "tune"); $err = 1; } if(!$bdb->setcache(128, 256)){ eprint($bdb, "setcache"); $err = 1; } if(!$bdb->setxmsiz($rnum * 4)){ eprint($bdb, "setxmsiz"); $err = 1; } if(!$bdb->setdfunit(8)){ eprint($bdb, "setdfunit"); $err = 1; } if(!$bdb->open($path, $bdb->OWRITER | $bdb->OCREAT | $bdb->OTRUNC | $omode)){ eprint($bdb, "open"); $err = 1; } printf("writing:\n"); for(my $i = 1; $i <= $rnum; $i++){ my $buf = sprintf("%08d", $i); if(!$bdb->put($buf, $buf)){ eprint($bdb, "put"); $err = 1; last; } if($rnum > 250 && $i % ($rnum / 250) == 0){ print('.'); if($i == $rnum || $i % ($rnum / 10) == 0){ printf(" (%08d)\n", $i); } } } printf("reading:\n"); for(my $i = 1; $i <= $rnum; $i++){ my $buf = sprintf("%08d", $i); if(!$bdb->get($buf)){ eprint($bdb, "get"); $err = 1; last; } if($rnum > 250 && $i % ($rnum / 250) == 0){ print('.'); if($i == $rnum || $i % ($rnum / 10) == 0){ printf(" (%08d)\n", $i); } } } printf("removing:\n"); for(my $i = 1; $i <= $rnum; $i++){ my $buf = sprintf("%08d", $i); if(int(rand(2)) == 0 && !$bdb->out($buf)){ eprint($bdb, "out"); $err = 1; last; } if($rnum > 250 && $i % ($rnum / 250) == 0){ print('.'); if($i == $rnum || $i % ($rnum / 10) == 0){ printf(" (%08d)\n", $i); } } } printf("checking cursor:\n"); my $cur = TokyoCabinet::BDBCUR->new($bdb); if(!$cur->first() && $bdb->ecode() != $bdb->ENOREC){ eprint($bdb, "cur::first"); $err = 1; } my $inum = 0; while(defined(my $key = $cur->key())){ my $value = $cur->val(); if(!defined($value)){ eprint($bdb, "cur::val"); $err = 1; } $cur->next(); if($rnum > 250 && $inum % ($rnum / 250) == 0){ print('.'); if($inum == $rnum || $inum % ($rnum / 10) == 0){ printf(" (%08d)\n", $inum); } } $inum++; } printf(" (%08d)\n", $inum) if($rnum > 250); if($bdb->ecode() != $bdb->ENOREC || $inum != $bdb->rnum()){ eprint($bdb, "(validation)"); $err = 1; } my $keys = $bdb->fwmkeys("0", 10); if($bdb->rnum() >= 10 && scalar(@$keys) != 10){ eprint($bdb, "fwmkeys"); $err = 1; } printf("checking counting:\n"); for(my $i = 1; $i <= $rnum; $i++){ my $buf = sprintf("[%d]", int(rand($rnum))); if(int(rand(2)) == 0){ if(!$bdb->addint($buf, 1) && $bdb->ecode() != $bdb->EKEEP){ eprint($bdb, "addint"); $err = 1; last; } } else { if(!$bdb->adddouble($buf, 1) && $bdb->ecode() != $bdb->EKEEP){ eprint($bdb, "adddouble"); $err = 1; last; } } if($rnum > 250 && $i % ($rnum / 250) == 0){ print('.'); if($i == $rnum || $i % ($rnum / 10) == 0){ printf(" (%08d)\n", $i); } } } if(!$bdb->sync()){ eprint($bdb, "sync"); $err = 1; } if(!$bdb->optimize()){ eprint($bdb, "optimize"); $err = 1; } my $npath = $path . "-tmp"; if(!$bdb->copy($npath)){ eprint($bdb, "copy"); $err = 1; } unlink($npath); if(!$bdb->vanish()){ eprint($bdb, "vanish"); $err = 1; } printf("random writing:\n"); for(my $i = 1; $i <= $rnum; $i++){ my $buf = sprintf("%08d", int(rand($i))); if(!$bdb->putdup($buf, $buf)){ eprint($bdb, "put"); $err = 1; last; } if($rnum > 250 && $i % ($rnum / 250) == 0){ print('.'); if($i == $rnum || $i % ($rnum / 10) == 0){ printf(" (%08d)\n", $i); } } } printf("cursor updating:\n"); for(my $i = 1; $i <= $rnum; $i++){ if(int(rand(10)) == 0){ my $buf = sprintf("%08d", int(rand($rnum))); $cur->jump($buf); for(my $j = 1; $j <= 10; $j++){ my $key = $cur->key(); last if(!defined($key)); if(int(rand(3)) == 0){ $cur->out(); } else { my $cpmode = $cur->CPCURRENT + int(rand(3)); $cur->put($buf, $cpmode); } $cur->next(); } } if($rnum > 250 && $i % ($rnum / 250) == 0){ print('.'); if($i == $rnum || $i % ($rnum / 10) == 0){ printf(" (%08d)\n", $i); } } } if(!$bdb->tranbegin()){ eprint($bdb, "put"); $err = 1; } $bdb->putdup("::1", "1"); $bdb->putdup("::2", "2a"); $bdb->putdup("::2", "2b"); $bdb->putdup("::3", "3"); $cur->jump("::2"); $cur->put("2A"); $cur->put("2-", $cur->CPBEFORE); $cur->put("2+"); $cur->next(); $cur->next(); $cur->put("mid", $cur->CPBEFORE); $cur->put("2C", $cur->CPAFTER); $cur->prev(); $cur->out(); my $vals = $bdb->getlist("::2"); if(!defined($vals) || scalar(@$vals) != 4){ eprint($bdb, "getlist"); $err = 1; } my @pvals = ( "hop", "step", "jump" ); if(!$bdb->putlist("::1", \@pvals)){ eprint($bdb, "putlist"); $err = 1; } if(!$bdb->outlist("::1")){ eprint($bdb, "outlist"); $err = 1; } if(!$bdb->trancommit()){ eprint($bdb, "put"); $err = 1; } if(!$bdb->tranbegin() || !$bdb->tranabort()){ eprint($bdb, "put"); $err = 1; } printf("record number: %llu\n", $bdb->rnum()); printf("size: %llu\n", $bdb->fsiz()); if(!$bdb->close()){ eprint($bdb, "close"); $err = 1; } printf("checking tied updating:\n"); my %hash; if(!tie(%hash, "TokyoCabinet::BDB", $path, TokyoCabinet::BDB::OWRITER)){ eprint($bdb, "tie"); $err = 1; } for(my $i = 1; $i <= $rnum; $i++){ my $buf = sprintf("[%d]", int(rand($rnum))); my $rnd = int(rand(4)); if($rnd == 0){ $hash{$buf} = $buf; } elsif($rnd == 1){ my $value = $hash{$buf} } elsif($rnd == 2){ my $res = exists($hash{$buf}); } elsif($rnd == 3){ delete($hash{$buf}); } if($rnum > 250 && $i % ($rnum / 250) == 0){ print('.'); if($i == $rnum || $i % ($rnum / 10) == 0){ printf(" (%08d)\n", $i); } } } printf("checking tied iterator:\n"); $inum = 0; while(my ($key, $value) = each(%hash)){ $inum++; if($rnum > 250 && $inum % ($rnum / 250) == 0){ print('.'); if($inum == $rnum || $inum % ($rnum / 10) == 0){ printf(" (%08d)\n", $inum); } } } printf(" (%08d)\n", $inum) if($rnum > 250); %hash = (); untie(%hash); printf("time: %.3f\n", gettimeofday() - $stime); printf("version: %s\n", TokyoCabinet::VERSION); printf("%s\n\n", $err ? "error" : "ok"); return $err ? 1 : 0; } # execute main $| = 1; $0 =~ s/.*\///; exit(main()); # END OF FILE