Search-TokyoDystopia/scripts/tcqdb.pl

#!/usr/bin/perl

use warnings;
use strict;

use blib;
use Search::TokyoDystopia;

=head1 NAME

tcqdb.pl - example from documentation translated to perl

=cut

# create the object
my $qdb = tcqdbnew();

# open the database
if (!tcqdbopen($qdb, "casket", QDBOWRITER | QDBOCREAT)) {
        my $ecode = tcqdbecode($qdb);
        die "open error: ", tcqdberrmsg($ecode);
}

# store records
if(
        !tcqdbput($qdb, 1, "George Washington") ||
        !tcqdbput($qdb, 2, "John Adams") ||
        !tcqdbput($qdb, 3, "Thomas Jefferson")
){
        my $ecode = tcqdbecode($qdb);
        die("put error: ", tcqdberrmsg($ecode));
}

# search records
my $result = tcqdbsearch($qdb, "John", QDBSSUBSTR);
if($result){
        foreach my $i ( @$result ) {
        printf("%d\n", $i);
        }
} else {
        my $ecode = tcqdbecode($qdb);
        die("search error: ", tcqdberrmsg($ecode));
}

# close the database
if(!tcqdbclose($qdb)){
        my $ecode = tcqdbecode($qdb);
    die("close error: ", tcqdberrmsg($ecode));
}

# delete the object
tcqdbdel($qdb);

1	dpavlin	35	#!/usr/bin/perl
2
3			use warnings;
4			use strict;
5
6			use blib;
7			use Search::TokyoDystopia;
8
9			=head1 NAME
10
11			tcqdb.pl - example from documentation translated to perl
12
13			=cut
14
15			# create the object
16			my $qdb = tcqdbnew();
17
18			# open the database
19			if (!tcqdbopen($qdb, "casket", QDBOWRITER \| QDBOCREAT)) {
20			my $ecode = tcqdbecode($qdb);
21			die "open error: ", tcqdberrmsg($ecode);
22			}
23
24			# store records
25			if(
26			!tcqdbput($qdb, 1, "George Washington") \|\|
27			!tcqdbput($qdb, 2, "John Adams") \|\|
28			!tcqdbput($qdb, 3, "Thomas Jefferson")
29			){
30			my $ecode = tcqdbecode($qdb);
31			die("put error: ", tcqdberrmsg($ecode));
32			}
33
34			# search records
35			my $result = tcqdbsearch($qdb, "John", QDBSSUBSTR);
36			if($result){
37			foreach my $i ( @$result ) {
38			printf("%d\n", $i);
39			}
40			} else {
41			my $ecode = tcqdbecode($qdb);
42			die("search error: ", tcqdberrmsg($ecode));
43			}
44
45			# close the database
46			if(!tcqdbclose($qdb)){
47			my $ecode = tcqdbecode($qdb);
48			die("close error: ", tcqdberrmsg($ecode));
49			}
50
51			# delete the object
52			tcqdbdel($qdb);
53