File Coverage

blib/lib/Wiki/Toolkit/Store/SQLite.pm
Criterion Covered Total %
statement 17 44 38.6
branch 0 8 0.0
condition 0 3 0.0
subroutine 5 11 45.4
pod 2 2 100.0
total 24 68 35.2


line stmt bran cond sub pod time code
1             package Wiki::Toolkit::Store::SQLite;
2              
3 3     3   2060 use strict;
  3         6  
  3         104  
4              
5 3     3   16 use vars qw( @ISA $VERSION );
  3         6  
  3         180  
6              
7 3     3   1425 use Wiki::Toolkit::Store::Database;
  3         10  
  3         121  
8 3     3   20 use Carp qw/carp croak/;
  3         7  
  3         1587  
9              
10             @ISA = qw( Wiki::Toolkit::Store::Database );
11             $VERSION = 0.06;
12              
13             =head1 NAME
14              
15             Wiki::Toolkit::Store::SQLite - SQLite storage backend for Wiki::Toolkit
16              
17             =head1 SYNOPSIS
18              
19             See Wiki::Toolkit::Store::Database
20              
21             =cut
22              
23             # Internal method to return the data source string required by DBI.
24             sub _dsn {
25 0     0   0 my ($self, $dbname) = @_;
26 0         0 return "dbi:SQLite:dbname=$dbname";
27             }
28              
29             =head1 METHODS
30              
31             =over 4
32              
33             =item B
34              
35             my $store = Wiki::Toolkit::Store::SQLite->new( dbname => "wiki" );
36              
37             The dbname parameter is mandatory.
38              
39             =cut
40              
41             sub new {
42 1     1 1 96 my ($class, %args) = @_;
43 1         3 my $self = {};
44 1         3 bless $self, $class;
45 1         6 @args{qw(dbuser dbpass)} = ("", ""); # for the parent class _init
46 1         10 return $self->_init(%args);
47             }
48              
49             =item B
50              
51             $store->check_and_write_node( node => $node,
52             checksum => $checksum,
53             %other_args );
54              
55             Locks the node, verifies the checksum, calls
56             C with all supplied arguments, unlocks the
57             node. Returns the version of the updated node on successful writing, 0 if
58             checksum doesn't match, -1 if the change was not applied, croaks on error.
59              
60             =back
61              
62             =cut
63              
64             sub check_and_write_node {
65 0     0 1   my ($self, %args) = @_;
66 0           my ($node, $checksum) = @args{qw( node checksum )};
67              
68 0           my $dbh = $self->{_dbh};
69 0           $dbh->begin_work;
70              
71 0           my $ok = eval {
72 0 0         $self->verify_checksum($node, $checksum) or return 0;
73 0           $self->write_node_post_locking( %args );
74             };
75 0 0         if ($@) {
76 0           my $error = $@;
77 0           $dbh->rollback;
78 0 0 0       if ( $error =~ /database is locked/
79             or $error =~ /DBI connect.+failed/ ) {
80 0           return 0;
81             } else {
82 0           croak "Unhandled error: [$error]";
83             }
84             } else {
85 0           $dbh->commit;
86 0           return $ok;
87             }
88             }
89              
90             # Get the attributes for the database connection. We set
91             # sqlite_use_immediate_transaction to false because we use database locking
92             # explicitly in check_and_write_node. This is required for DBD::SQLite 1.38.
93             sub _get_dbh_connect_attr {
94 0     0     my $self = shift;
95 0           my $attrs = $self->SUPER::_get_dbh_connect_attr;
96             return {
97 0           %$attrs,
98             sqlite_use_immediate_transaction => 0
99             };
100             }
101              
102             sub _get_lowercase_compare_sql {
103 0     0     my ($self, $column) = @_;
104 0           return "$column LIKE ?";
105             }
106              
107             sub _get_comparison_sql {
108 0     0     my ($self, %args) = @_;
109 0 0         if ( $args{ignore_case} ) {
110 0           return "$args{thing1} LIKE $args{thing2}";
111             } else {
112 0           return "$args{thing1} = $args{thing2}";
113             }
114             }
115              
116             sub _get_node_exists_ignore_case_sql {
117 0     0     return "SELECT name FROM node WHERE name LIKE ? ";
118             }
119              
120             1;