| 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; | ||||||