File Coverage

blib/lib/Module/Build/Database/SQLite.pm
Criterion Covered Total %
statement 28 128 21.8
branch 1 26 3.8
condition 1 39 2.5
subroutine 10 30 33.3
pod 1 1 100.0
total 41 224 18.3


line stmt bran cond sub pod time code
1              
2             =head1 NAME
3              
4             Module::Build::Database::SQLite - SQLite implementation for MBD
5              
6             =head1 SYNOPSIS
7              
8             my $builder = Module::Build::Database->new(
9             database_type => "SQLite",
10             database_options => {
11             name => "my_database_name",
12             });
13              
14             =head1 DESCRIPTION
15              
16             SQLite driver for Module::Build::Database.
17              
18             =head1 METHODS
19              
20             =over
21              
22             =cut
23              
24             package Module::Build::Database::SQLite;
25 2     2   28703 use base 'Module::Build::Database';
  2         2  
  2         413  
26 2     2   11 use Module::Build::Database::Helpers qw/do_system verify_bin debug info/;
  2         3  
  2         14  
27              
28 2     2   785 use Path::Class qw( tempdir );
  2         3  
  2         95  
29 2     2   7 use File::Copy qw( copy );
  2         2  
  2         63  
30 2     2   7 use File::Temp;
  2         2  
  2         103  
31 2     2   7 use File::Basename qw/dirname/;
  2         2  
  2         57  
32 2     2   8 use Cwd qw/abs_path/;
  2         2  
  2         54  
33              
34 2     2   6 use strict;
  2         2  
  2         38  
35 2     2   5 use warnings;
  2         3  
  2         1859  
36             our $VERSION = '0.57';
37              
38             __PACKAGE__->add_property(database_options => default => { name => "unknown" });
39             __PACKAGE__->add_property(_tmp_db_dir => default => "" );
40              
41             our $dbFile;
42             our %Bin = (
43             Sqlite => 'sqlite3'
44             );
45             verify_bin(\%Bin);
46              
47             =item have_db_cli
48              
49             Is there a command line interface for sqlite available
50             in the current PATH?
51              
52             =cut
53              
54             sub have_db_cli {
55 1 50 33 1 1 27 return $Bin{Sqlite} && $Bin{Sqlite} !~ qr[/bin/false] ? 1 : 0;
56             }
57              
58             sub _show_live_db {
59 0     0     my $self = shift;
60 0   0       my $name = shift || $self->database_options('name');
61 0   0       info "database : ". (eval { abs_path($name) } || $name);
62             }
63              
64             sub _is_fresh_install {
65 0     0     my $self = shift;
66 0           my $database_name = $self->database_options('name');
67              
68 0 0 0       return -e $database_name && -s _ ? 0 : 1;
69             }
70              
71             sub _create_database {
72 0     0     my $self = shift;
73 0 0         $dbFile = $self->database_options('name') or die "no database name";
74             # nothing to do
75 0           return 1;
76             }
77              
78             sub _create_patch_table {
79 0     0     my $self = shift;
80 0   0       $dbFile ||= $self->database_options('name');
81 0           debug "creating patch table";
82 0           $self->_do_sqlite(<
83             CREATE TABLE patches_applied (
84             patch_name varchar(255) primary key,
85             patch_md5 varchar(255),
86             when_applied timestamp );
87             EOT
88             }
89              
90             sub _insert_patch_record {
91 0     0     my $self = shift;
92 0           my $record = shift;
93 0           my ($name,$md5) = @$record;
94 0           debug "adding patch record $name, $md5";
95 0           $self->_do_sqlite("insert into patches_applied (patch_name, patch_md5, when_applied) ".
96             " values ('$name','$md5',current_timestamp); ");
97             }
98              
99             sub _patch_table_exists {
100 0     0     my $self = shift;
101 0   0       $dbFile ||= $self->database_options('name');
102 0           my $is_it = do_system("_silent", "echo",q[.table patches_applied],"|",$Bin{Sqlite},$dbFile,"|","grep -q patches_applied");
103 0 0         return $is_it ? 1 : 0;
104             }
105              
106             sub _dump_patch_table {
107 0     0     my $self = shift;
108 0           my %args = @_;
109 0 0         my $filename = $args{outfile} or Carp::confess "need a filename";
110 0           debug "dumping patches into $filename";
111 0           $self->_do_sqlite_into_file($filename,"select patch_name,patch_md5 from patches_applied order by patch_name;");
112             }
113              
114             sub _remove_patches_applied_table {
115 0     0     my $self = shift;
116 0           $self->_do_sqlite("drop table if exists patches_applied;");
117             }
118              
119             sub _start_new_db {
120             # Make a new empty database file, return the name of the file.
121 0     0     my $self = shift;
122 0           $dbFile = File::Temp->new(UNLINK => 0);
123 0           $dbFile->close;
124 0           return "$dbFile";
125             }
126              
127             sub _do_sql_file {
128 0     0     my $self = shift;
129 0           my $filename = shift;
130 0           my $outfile = shift; # optional output file
131 0 0         Carp::confess "dbFile is not defined" unless defined($dbFile);
132 0 0         do_system( $Bin{Sqlite}, $dbFile, "<", $filename,
133             ( $outfile ? ( ">", $outfile ) : () ) );
134             }
135              
136             sub _do_sqlite {
137 0     0     my $self = shift;
138 0           my $sql = shift;
139 0           my $tmp = File::Temp->new(TEMPLATE => "tmp_db_XXXX", SUFFIX => '.sql');
140 0           print $tmp ".header off\n";
141 0           print $tmp ".mode list\n";
142 0           print $tmp ".separator ' '\n";
143 0           print $tmp $sql;
144 0           $tmp->close;
145 0           my $ret = $self->_do_sql_file("$tmp", @_); # pass @_ which may have an $outfile
146 0           $tmp->unlink_on_destroy($ret);
147 0           $ret;
148             }
149              
150             sub _do_sqlite_into_file {
151 0     0     my $self = shift;
152 0           my $filename = shift;
153 0           my $sql = shift;
154 0           debug "doing $sql";
155 0           $self->_do_sqlite($sql,$filename);
156             }
157              
158             sub _do_sqlite_getlines {
159 0     0     my $self = shift;
160 0           my $sql = shift;
161 0           my $filename = tempdir(CLEANUP=>1)->file("tmp.sql");
162 0           debug "doing $sql";
163 0           $self->_do_sqlite($sql,$filename);
164 0           my @result = $filename->slurp;
165 0           return @result;
166             }
167              
168             sub _apply_base_sql {
169 0     0     my $self = shift;
170 0   0       my $filename = shift || $self->base_dir."/db/dist/base.sql";
171 0 0         return unless -e $filename;
172 0           info "applying base.sql";
173 0           $self->_do_sql_file($filename);
174             }
175              
176             sub _apply_base_data {
177 0     0     my $self = shift;
178 0   0       my $filename = shift || $self->base_dir."/db/dist/base_data.sql";
179 0 0         return unless -e $filename;
180 0           info "applying base_data.sql";
181 0           $self->_do_sql_file($filename);
182             }
183              
184             sub _apply_patch {
185 0     0     my $self = shift;
186 0           my $patch_file = shift;
187              
188 0           return $self->_do_sql_file($self->base_dir."/db/patches/$patch_file");
189             }
190              
191             sub _dump_base_sql {
192 0     0     my $self = shift;
193              
194 0   0       $dbFile ||= $self->database_options('name');
195              
196             # Optional parameter "outfile" gives the name of the file into which to dump the schema.
197             # If the parameter is omitted, dump and atomically rename to db/dist/base.sql.
198 0           my %args = @_;
199 0   0       my $outfile = $args{outfile} || $self->base_dir. "/db/dist/base.sql";
200              
201 0           my $tmpfile = File::Temp->new(
202             TEMPLATE => (dirname $outfile)."/dump_XXXXXX",
203             UNLINK => 0
204             );
205 0           $tmpfile->close;
206              
207 0           debug "dumping base sql";
208 0           $self->_do_sqlite(qq[.output $tmpfile\n.schema\n.exit\n]);
209 0 0         rename "$tmpfile", $outfile or die "rename failed: $!";
210             }
211              
212             sub _dump_base_data {
213 0     0     my $self = shift;
214 0           my %args = @_;
215 0   0       my $outfile = $args{outfile} || $self->base_dir. "/db/dist/base_data.sql";
216              
217 0   0       $dbFile ||= $self->database_options('name');
218              
219 0           my $tmpfile = File::Temp->new(
220             TEMPLATE => (dirname $outfile)."/dump_XXXXXX",
221             UNLINK => 1,
222             );
223 0           debug "dumping base_data.sql";
224              
225 0           my ($tables) = $self->_do_sqlite_getlines(qq[.tables]);
226 0           for my $table (split /\s+/, $tables) {
227 0           my $more = tempdir(CLEANUP => 1)->file("more.sql");
228 0           my $more_safe_fn = $more;
229 0           $more_safe_fn =~ s{\\}{/}g;
230 0           $self->_do_sqlite(qq[.output $more_safe_fn\n.mode insert $table\nselect * from $table;\n.exit\n]);
231 0           $tmpfile->print($_) for $more->slurp;
232             }
233 0 0         copy $tmpfile, $outfile or die "copy failed: $!";
234             }
235              
236 0     0     sub _stop_db {
237             # there's no daemon, yay
238             }
239              
240             sub _remove_db {
241 0 0 0 0     return unless defined($dbFile) && -e "$dbFile";
242 0 0         unlink "$dbFile" or die "Could not unlink $dbFile :$!";
243             }
244              
245             =back
246              
247             =head1 SEE ALSO
248              
249             See L.
250              
251             =cut
252              
253             1;
254              
255