line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package App::Zapzi::Database; |
2
|
|
|
|
|
|
|
# ABSTRACT: database access for Zapzi |
3
|
|
|
|
|
|
|
|
4
|
|
|
|
|
|
|
|
5
|
8
|
|
|
8
|
|
43
|
use utf8; |
|
8
|
|
|
|
|
12
|
|
|
8
|
|
|
|
|
58
|
|
6
|
8
|
|
|
8
|
|
273
|
use strict; |
|
8
|
|
|
|
|
16
|
|
|
8
|
|
|
|
|
288
|
|
7
|
8
|
|
|
8
|
|
54
|
use warnings; |
|
8
|
|
|
|
|
11
|
|
|
8
|
|
|
|
|
474
|
|
8
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
our $VERSION = '0.016'; # VERSION |
10
|
|
|
|
|
|
|
|
11
|
8
|
|
|
8
|
|
16864
|
use Moo; |
|
8
|
|
|
|
|
119768
|
|
|
8
|
|
|
|
|
48
|
|
12
|
8
|
|
|
8
|
|
19808
|
use SQL::Translator; |
|
8
|
|
|
|
|
2238731
|
|
|
8
|
|
|
|
|
305
|
|
13
|
8
|
|
|
8
|
|
4205
|
use App::Zapzi::Database::Schema; |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
use App::Zapzi::Config; |
15
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
has app => (is => 'ro'); |
18
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
sub database_file |
21
|
|
|
|
|
|
|
{ |
22
|
|
|
|
|
|
|
my $self = shift; |
23
|
|
|
|
|
|
|
if ($self->app->test_database) |
24
|
|
|
|
|
|
|
{ |
25
|
|
|
|
|
|
|
return ':memory:'; |
26
|
|
|
|
|
|
|
} |
27
|
|
|
|
|
|
|
else |
28
|
|
|
|
|
|
|
{ |
29
|
|
|
|
|
|
|
return $self->app->zapzi_dir . "/zapzi.db"; |
30
|
|
|
|
|
|
|
} |
31
|
|
|
|
|
|
|
} |
32
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
sub dsn |
35
|
|
|
|
|
|
|
{ |
36
|
|
|
|
|
|
|
my $self = shift; |
37
|
|
|
|
|
|
|
return "dbi:SQLite:dbname=" . $self->database_file; |
38
|
|
|
|
|
|
|
} |
39
|
|
|
|
|
|
|
|
40
|
|
|
|
|
|
|
our $_schema; |
41
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
sub schema |
44
|
|
|
|
|
|
|
{ |
45
|
|
|
|
|
|
|
my $self = shift; |
46
|
|
|
|
|
|
|
$_schema //= App::Zapzi::Database::Schema->connect({ |
47
|
|
|
|
|
|
|
dsn =>$self->dsn, |
48
|
|
|
|
|
|
|
sqlite_unicode => 1, |
49
|
|
|
|
|
|
|
on_connect_do => 'PRAGMA foreign_keys = ON'}); |
50
|
|
|
|
|
|
|
return $_schema; |
51
|
|
|
|
|
|
|
} |
52
|
|
|
|
|
|
|
|
53
|
|
|
|
|
|
|
|
54
|
|
|
|
|
|
|
sub init |
55
|
|
|
|
|
|
|
{ |
56
|
|
|
|
|
|
|
my $self = shift; |
57
|
|
|
|
|
|
|
my ($ddl) = @_; |
58
|
|
|
|
|
|
|
|
59
|
|
|
|
|
|
|
mkdir $self->app->zapzi_dir; |
60
|
|
|
|
|
|
|
die "Can't access ", $self->app->zapzi_dir |
61
|
|
|
|
|
|
|
if ! -d $self->app->zapzi_dir; |
62
|
|
|
|
|
|
|
mkdir $self->app->zapzi_ebook_dir; |
63
|
|
|
|
|
|
|
|
64
|
|
|
|
|
|
|
$self->schema->storage->disconnect if $self->app->force; |
65
|
|
|
|
|
|
|
unlink $self->database_file unless $self->app->test_database; |
66
|
|
|
|
|
|
|
$_schema = undef; |
67
|
|
|
|
|
|
|
|
68
|
|
|
|
|
|
|
# Adjust the page size to match the expected blob size for articles |
69
|
|
|
|
|
|
|
# http://www.sqlite.org/intern-v-extern-blob.html |
70
|
|
|
|
|
|
|
$self->schema->storage->dbh->do("PRAGMA page_size = 8192"); |
71
|
|
|
|
|
|
|
|
72
|
|
|
|
|
|
|
if (defined($ddl)) |
73
|
|
|
|
|
|
|
{ |
74
|
|
|
|
|
|
|
# Create a special version of the database from the supplied DDL |
75
|
|
|
|
|
|
|
# Used for testing upgrades |
76
|
|
|
|
|
|
|
my @commands = split(/;\n/, $ddl); |
77
|
|
|
|
|
|
|
for (@commands) |
78
|
|
|
|
|
|
|
{ |
79
|
|
|
|
|
|
|
$self->schema->storage->dbh->do($_); |
80
|
|
|
|
|
|
|
} |
81
|
|
|
|
|
|
|
|
82
|
|
|
|
|
|
|
return; |
83
|
|
|
|
|
|
|
} |
84
|
|
|
|
|
|
|
|
85
|
|
|
|
|
|
|
$self->schema->deploy(); |
86
|
|
|
|
|
|
|
|
87
|
|
|
|
|
|
|
my @folders = ({id => 100, name => 'Inbox'}, |
88
|
|
|
|
|
|
|
{name => 'Archive'}); |
89
|
|
|
|
|
|
|
$self->schema->populate('Folder', \@folders); |
90
|
|
|
|
|
|
|
|
91
|
|
|
|
|
|
|
my @articles = ({title => 'Welcome to Zapzi', folder => 100, |
92
|
|
|
|
|
|
|
article_text => |
93
|
|
|
|
|
|
|
{ text => '<p>Welcome to Zapzi! Please run <pre>zapzi -h</pre> to see documentation.</p>'}}); |
94
|
|
|
|
|
|
|
scalar $self->schema->populate('Article', \@articles); |
95
|
|
|
|
|
|
|
|
96
|
|
|
|
|
|
|
my @config = ({name => 'schema_version', |
97
|
|
|
|
|
|
|
value => $self->schema->schema_version} ); |
98
|
|
|
|
|
|
|
$self->schema->populate('Config', \@config); |
99
|
|
|
|
|
|
|
} |
100
|
|
|
|
|
|
|
|
101
|
|
|
|
|
|
|
|
102
|
|
|
|
|
|
|
sub get_version |
103
|
|
|
|
|
|
|
{ |
104
|
|
|
|
|
|
|
my $self = shift; |
105
|
|
|
|
|
|
|
my $schema = $self->schema; |
106
|
|
|
|
|
|
|
|
107
|
|
|
|
|
|
|
my $version; |
108
|
|
|
|
|
|
|
|
109
|
|
|
|
|
|
|
# If the eval fails, there's no config table, so this must be |
110
|
|
|
|
|
|
|
# schema version 0. |
111
|
|
|
|
|
|
|
eval { $version = App::Zapzi::Config::get('schema_version') }; |
112
|
|
|
|
|
|
|
return $@ ? 0 : $version; |
113
|
|
|
|
|
|
|
} |
114
|
|
|
|
|
|
|
|
115
|
|
|
|
|
|
|
|
116
|
|
|
|
|
|
|
|
117
|
|
|
|
|
|
|
sub check_version |
118
|
|
|
|
|
|
|
{ |
119
|
|
|
|
|
|
|
my $self = shift; |
120
|
|
|
|
|
|
|
|
121
|
|
|
|
|
|
|
return $self->get_version == $self->schema->schema_version; |
122
|
|
|
|
|
|
|
} |
123
|
|
|
|
|
|
|
|
124
|
|
|
|
|
|
|
|
125
|
|
|
|
|
|
|
sub upgrade |
126
|
|
|
|
|
|
|
{ |
127
|
|
|
|
|
|
|
my $self = shift; |
128
|
|
|
|
|
|
|
my $schema = $self->schema; |
129
|
|
|
|
|
|
|
|
130
|
|
|
|
|
|
|
my $from = $self->get_version; |
131
|
|
|
|
|
|
|
my $to = $self->schema->schema_version; |
132
|
|
|
|
|
|
|
|
133
|
|
|
|
|
|
|
print "Upgrading database from version $from to $to\n"; |
134
|
|
|
|
|
|
|
|
135
|
|
|
|
|
|
|
if ($from < 1) |
136
|
|
|
|
|
|
|
{ |
137
|
|
|
|
|
|
|
$self->schema->storage->dbh->do("CREATE TABLE config ( " . |
138
|
|
|
|
|
|
|
" name text NOT NULL, " . |
139
|
|
|
|
|
|
|
" value text NOT NULL DEFAULT '', " . |
140
|
|
|
|
|
|
|
" PRIMARY KEY (name) ". |
141
|
|
|
|
|
|
|
")"); |
142
|
|
|
|
|
|
|
App::Zapzi::Config::set('schema_version', 1); |
143
|
|
|
|
|
|
|
} |
144
|
|
|
|
|
|
|
|
145
|
|
|
|
|
|
|
if ($from < 2) |
146
|
|
|
|
|
|
|
{ |
147
|
|
|
|
|
|
|
$self->schema->storage->dbh->do("ALTER TABLE articles " . |
148
|
|
|
|
|
|
|
"ADD COLUMN " . |
149
|
|
|
|
|
|
|
" source NOT NULL DEFAULT '' "); |
150
|
|
|
|
|
|
|
App::Zapzi::Config::set('schema_version', 2); |
151
|
|
|
|
|
|
|
} |
152
|
|
|
|
|
|
|
} |
153
|
|
|
|
|
|
|
|
154
|
|
|
|
|
|
|
1; |
155
|
|
|
|
|
|
|
|
156
|
|
|
|
|
|
|
__END__ |
157
|
|
|
|
|
|
|
|
158
|
|
|
|
|
|
|
=pod |
159
|
|
|
|
|
|
|
|
160
|
|
|
|
|
|
|
=encoding UTF-8 |
161
|
|
|
|
|
|
|
|
162
|
|
|
|
|
|
|
=head1 NAME |
163
|
|
|
|
|
|
|
|
164
|
|
|
|
|
|
|
App::Zapzi::Database - database access for Zapzi |
165
|
|
|
|
|
|
|
|
166
|
|
|
|
|
|
|
=head1 VERSION |
167
|
|
|
|
|
|
|
|
168
|
|
|
|
|
|
|
version 0.016 |
169
|
|
|
|
|
|
|
|
170
|
|
|
|
|
|
|
=head1 DESCRIPTION |
171
|
|
|
|
|
|
|
|
172
|
|
|
|
|
|
|
This class provides access to the Zapzi database. |
173
|
|
|
|
|
|
|
|
174
|
|
|
|
|
|
|
=head1 ATTRIBUTES |
175
|
|
|
|
|
|
|
|
176
|
|
|
|
|
|
|
=head2 app |
177
|
|
|
|
|
|
|
|
178
|
|
|
|
|
|
|
Link to the App::Zapzi application object. |
179
|
|
|
|
|
|
|
|
180
|
|
|
|
|
|
|
=head1 METHODS |
181
|
|
|
|
|
|
|
|
182
|
|
|
|
|
|
|
=head2 database_file |
183
|
|
|
|
|
|
|
|
184
|
|
|
|
|
|
|
The SQLite file where the database is stored. |
185
|
|
|
|
|
|
|
|
186
|
|
|
|
|
|
|
=head2 dsn |
187
|
|
|
|
|
|
|
|
188
|
|
|
|
|
|
|
The DSN used to connect to the SQLite database. |
189
|
|
|
|
|
|
|
|
190
|
|
|
|
|
|
|
=head2 schema |
191
|
|
|
|
|
|
|
|
192
|
|
|
|
|
|
|
The DBIx::Class::Schema object for the application. |
193
|
|
|
|
|
|
|
|
194
|
|
|
|
|
|
|
=head2 init |
195
|
|
|
|
|
|
|
|
196
|
|
|
|
|
|
|
Initialise the database to a new state. |
197
|
|
|
|
|
|
|
|
198
|
|
|
|
|
|
|
=head2 get_version |
199
|
|
|
|
|
|
|
|
200
|
|
|
|
|
|
|
Returns the version of the schema defined in the database |
201
|
|
|
|
|
|
|
|
202
|
|
|
|
|
|
|
=head2 check_version |
203
|
|
|
|
|
|
|
|
204
|
|
|
|
|
|
|
Compares the version of the schema in the database to that in the |
205
|
|
|
|
|
|
|
code. Return true if they match, undef if not. |
206
|
|
|
|
|
|
|
|
207
|
|
|
|
|
|
|
=head2 upgrade |
208
|
|
|
|
|
|
|
|
209
|
|
|
|
|
|
|
Upgrades the database to the current schema version. |
210
|
|
|
|
|
|
|
|
211
|
|
|
|
|
|
|
=head1 AUTHOR |
212
|
|
|
|
|
|
|
|
213
|
|
|
|
|
|
|
Rupert Lane <rupert@rupert-lane.org> |
214
|
|
|
|
|
|
|
|
215
|
|
|
|
|
|
|
=head1 COPYRIGHT AND LICENSE |
216
|
|
|
|
|
|
|
|
217
|
|
|
|
|
|
|
This software is copyright (c) 2015 by Rupert Lane. |
218
|
|
|
|
|
|
|
|
219
|
|
|
|
|
|
|
This is free software; you can redistribute it and/or modify it under |
220
|
|
|
|
|
|
|
the same terms as the Perl 5 programming language system itself. |
221
|
|
|
|
|
|
|
|
222
|
|
|
|
|
|
|
=cut |