summaryrefslogtreecommitdiff
path: root/lmdb.pl
blob: 35931eba1d9ee391b96fc8dcea98eff6be193bff (plain)
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
59
60
61
62
63
64
65
66
#!/usr/bin/perl

# Usage:
#
#   ./lmdb.pl create dbfile <dictionary
#   ./lmdb.pl bench dbfile
#   ./lmdb.pl extract dbfile >dictionary

use strict;
use warnings;
use v5.10;
use LMDB_File ':flags', ':cursor_op';

my($cmd, $dbfile) = @ARGV;
my($env, $txn, $dbi);

sub db {
    my $wr = shift;
    $env = LMDB::Env->new($dbfile, { mapsize => 1<<36, maxdbs => 1, flags => MDB_NOSUBDIR|($wr?0:MDB_RDONLY) });
    $txn = $env->BeginTxn($wr ? 0 : MDB_RDONLY);
    $dbi = $txn->open('db', $wr ? MDB_CREATE : undef);
}

sub encode {
    db 1;
    while(<STDIN>) {
        chomp;
        $txn->put($dbi => $_, '') if length($_) && length($_) < 510;
    }
    $txn->commit;
}


sub bench {
    db;
    my $lookup = sub { eval { $txn->get($dbi => $_[0], my $d); 1 } };

    use Benchmark 'timethis', ':hireswallclock';
    sub rstr { state $s=['a'..'z','A'..'Z','0'..'9','!','@','#']; join '', map $s->[rand @$s], 1..5 }
    srand 0;
    timethis 200000, sub { $lookup->(rstr()) }, 'lmdb';
}


sub extract {
    # This ugly periodic opening/closing of the database is to work around a
    # memory leak somewhere.
    eval {
        my $key;
        while(1) {
            $env = $txn = $dbi = undef;
            db;
            my $db = LMDB_File->new($txn, $dbi);
            my $cur = $db->Cursor();
            $cur->get($key, (my $value), defined($key) ? MDB_SET_KEY : MDB_FIRST);
            for (0..10_000) {
                print "$key\n";
                $cur->get($key, $value, MDB_NEXT);
            }
        }
    }
}

encode if $cmd eq 'create';
bench if $cmd eq 'bench';
extract if $cmd eq 'extract';