/usr/share/doc/libtokyocabinet-perl/examples/tcbdbex.pl is in libtokyocabinet-perl 1.34-1build2.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 | 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);
|