File: | lib/Bot/IRC/Store/SQLite.pm |
Coverage: | 84.9% |
line | stmt | bran | cond | sub | pod | time | code |
---|---|---|---|---|---|---|---|
1 | package Bot::IRC::Store::SQLite; | ||||||
2 | # ABSTRACT: Bot::IRC Persistent Data Storage with SQLite | ||||||
3 | |||||||
4 | 1 1 1 | 13 5 70 | use strict; | ||||
5 | 1 1 1 | 8 4 284 | use warnings; | ||||
6 | |||||||
7 | 1 1 1 | 30662 338752 185 | use DBI; | ||||
8 | 1 1 1 | 13244 227392 91 | use DBD::SQLite; | ||||
9 | 1 1 1 | 23936 192229 13671 | use JSON::XS; | ||||
10 | |||||||
11 | # VERSION | ||||||
12 | |||||||
13 | sub init { | ||||||
14 | 1 | 0 | 7 | my ($bot) = @_; | |||
15 | 1 | 8 | my $obj = __PACKAGE__->new($bot); | ||||
16 | |||||||
17 | 1 4 | 13 36 | $bot->subs( 'store' => sub { return $obj } ); | ||||
18 | 1 | 8 | $bot->register('Bot::IRC::Store'); | ||||
19 | } | ||||||
20 | |||||||
21 | sub new { | ||||||
22 | 2 | 0 | 23 | my ( $class, $bot ) = @_; | |||
23 | 2 | 12 | my $self = bless( {}, $class ); | ||||
24 | |||||||
25 | 2 | 27 | $self->{file} = $bot->{vars}{store} || 'store.sqlite'; | ||||
26 | 2 | 28 | my $pre_exists = ( -f $self->{file} ) ? 1 : 0; | ||||
27 | |||||||
28 | 2 | 22 | $self->{dbh} = DBI->connect( 'dbi:SQLite:dbname=' . $self->{file} ) or die "$@\n"; | ||||
29 | |||||||
30 | 2 | 24 | $self->{dbh}->do(q{ | ||||
31 | CREATE TABLE IF NOT EXISTS bot_store ( | ||||||
32 | id INTEGER PRIMARY KEY ASC, | ||||||
33 | namespace TEXT, | ||||||
34 | key TEXT, | ||||||
35 | value TEXT | ||||||
36 | ) | ||||||
37 | }) unless ($pre_exists); | ||||||
38 | |||||||
39 | 2 | 549 | $self->{json} = JSON::XS->new->ascii; | ||||
40 | |||||||
41 | 2 | 19 | return $self; | ||||
42 | } | ||||||
43 | |||||||
44 | sub get { | ||||||
45 | 1 | 1 | 5 | my ( $self, $key ) = @_; | |||
46 | 1 | 6 | my $namespace = ( caller() )[0]; | ||||
47 | |||||||
48 | 1 | 32 | my $sth = $self->{dbh}->prepare(q{ | ||||
49 | SELECT value FROM bot_store WHERE namespace = ? AND key = ? | ||||||
50 | }); | ||||||
51 | 1 | 6 | $sth->execute( $namespace, $key ); | ||||
52 | 1 | 39 | my $value = $sth->fetchrow_array; | ||||
53 | |||||||
54 | 1 | 7 | if ($value) { | ||||
55 | 1 | 25 | $value = $self->{json}->decode($value) || undef; | ||||
56 | 1 | 12 | $value = $value->{value} if ( ref $value eq 'HASH' and exists $value->{value} ); | ||||
57 | } | ||||||
58 | |||||||
59 | 1 | 8 | return $value; | ||||
60 | } | ||||||
61 | |||||||
62 | sub set { | ||||||
63 | 1 | 1 | 6 | my ( $self, $key, $value ) = @_; | |||
64 | 1 | 6 | my $namespace = ( caller() )[0]; | ||||
65 | |||||||
66 | 1 | 39 | $self->{dbh}->prepare(q{ | ||||
67 | DELETE FROM bot_store WHERE namespace = ? AND key = ? | ||||||
68 | })->execute( $namespace, $key ); | ||||||
69 | |||||||
70 | $self->{dbh}->prepare(q{ | ||||||
71 | INSERT INTO bot_store ( namespace, key, value ) VALUES ( ?, ?, ? ) | ||||||
72 | 1 | 6 | })->execute( $namespace, $key, $self->{json}->encode( { value => $value } ) ); | ||||
73 | |||||||
74 | 1 | 7 | return $self; | ||||
75 | } | ||||||
76 | |||||||
77 | 1; |