/usr/share/doc/libtokyocabinet-perl/examples/tctdbex.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 | 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);
|