File Coverage

blib/lib/Wiki/Toolkit/Setup/Database.pm
Criterion Covered Total %
statement 6 213 2.8
branch 0 14 0.0
condition 0 3 0.0
subroutine 2 12 16.6
pod 0 10 0.0
total 8 252 3.1


line stmt bran cond sub pod time code
1             package Wiki::Toolkit::Setup::Database;
2              
3 5     5   478 use strict;
  5         6  
  5         137  
4              
5 5     5   18 use vars qw( $VERSION @SUPPORTED_SCHEMAS);
  5         7  
  5         7203  
6              
7             $VERSION = 0.09;
8             @SUPPORTED_SCHEMAS = qw(8 9 10);
9              
10             =head1 NAME
11              
12             Wiki::Toolkit::Setup::Database - parent class for database storage setup
13             classes for Wiki::Toolkit
14              
15             =cut
16              
17             sub fetch_upgrade_old_to_8 {
18             # Compatible with old_to_10
19 0     0 0   fetch_upgrade_old_to_10(@_);
20             }
21              
22             sub fetch_upgrade_old_to_9 {
23             # Compatible with old_to_10
24 0     0 0   fetch_upgrade_old_to_10(@_);
25             }
26              
27             # Fetch from the old style database, ready for an upgrade to db version 10
28             sub fetch_upgrade_old_to_10 {
29 0     0 0   my $dbh = shift;
30 0           my %nodes;
31             my %metadatas;
32 0           my %contents;
33 0           my @internal_links;
34 0           my %ids;
35              
36 0           print "Grabbing and upgrading old data... ";
37              
38             # Grab all the nodes, and give them an ID
39 0           my $sth = $dbh->prepare("SELECT name,version,text,modified FROM node");
40 0           $sth->execute;
41 0           my $id = 0;
42 0           while( my($name,$version,$text,$modified) = $sth->fetchrow_array) {
43 0           my %node;
44 0           $id++;
45 0           $node{'name'} = $name;
46 0           $node{'version'} = $version;
47 0           $node{'text'} = $text;
48 0           $node{'modified'} = $modified;
49 0           $node{'id'} = $id;
50 0           $node{'moderate'} = 0;
51 0           $nodes{$name} = \%node;
52 0           $ids{$name} = $id;
53             }
54 0           print " read $id nodes... ";
55              
56             # Grab all the content, and upgrade to ID from name
57 0           $sth = $dbh->prepare("SELECT name,version,text,modified,comment FROM content");
58 0           $sth->execute;
59 0           while ( my($name,$version,$text,$modified,$comment) = $sth->fetchrow_array) {
60 0           my $id = $ids{$name};
61 0 0         if($id) {
62 0           my %content;
63 0           $content{'node_id'} = $id;
64 0           $content{'version'} = $version;
65 0           $content{'text'} = $text;
66 0           $content{'modified'} = $modified;
67 0           $content{'comment'} = $comment;
68 0           $content{'moderated'} = 1;
69 0           $contents{$id."-".$version} = \%content;
70             } else {
71 0           warn("There was no node entry for content with name '$name', unable to migrate it!");
72             }
73             }
74 0           print " read ".(scalar keys %contents)." contents... ";
75              
76             # Grab all the metadata, and upgrade to ID from node
77 0           $sth = $dbh->prepare("SELECT node,version,metadata_type,metadata_value FROM metadata");
78 0           $sth->execute;
79 0           my $i = 0;
80 0           while( my($node,$version,$metadata_type,$metadata_value) = $sth->fetchrow_array) {
81 0           my $id = $ids{$node};
82 0 0         if($id) {
83 0           my %metadata;
84 0           $metadata{'node_id'} = $id;
85 0           $metadata{'version'} = $version;
86 0           $metadata{'metadata_type'} = $metadata_type;
87 0           $metadata{'metadata_value'} = $metadata_value;
88 0           $metadatas{$id."-".($i++)} = \%metadata;
89             } else {
90 0           warn("There was no node entry for metadata with name (node) '$node', unable to migrate it!");
91             }
92             }
93              
94             # Grab all the internal links
95 0           $sth = $dbh->prepare("SELECT link_from,link_to FROM internal_links");
96 0           $sth->execute;
97 0           while( my($link_from,$link_to) = $sth->fetchrow_array) {
98 0           my %il;
99 0           $il{'link_from'} = $link_from;
100 0           $il{'link_to'} = $link_to;
101 0           push @internal_links, \%il;
102             }
103              
104 0           print "done\n";
105              
106             # Return it all
107 0           return (\%nodes,\%contents,\%metadatas,\@internal_links,\%ids);
108             }
109              
110             sub fetch_upgrade_8_to_9 {
111             # Compatible with 8_to_10
112 0     0 0   fetch_upgrade_8_to_10(@_);
113             }
114              
115             # Fetch from schema version 8, and upgrade to version 10
116             sub fetch_upgrade_8_to_10 {
117 0     0 0   my $dbh = shift;
118 0           my %nodes;
119             my %metadatas;
120 0           my %contents;
121 0           my @internal_links;
122              
123 0           print "Grabbing and upgrading old data... ";
124              
125             # Grab all the nodes
126 0           my $sth = $dbh->prepare("SELECT id,name,version,text,modified FROM node");
127 0           $sth->execute;
128 0           while( my($id,$name,$version,$text,$modified) = $sth->fetchrow_array) {
129 0           my %node;
130 0           $node{'name'} = $name;
131 0           $node{'version'} = $version;
132 0           $node{'text'} = $text;
133 0           $node{'modified'} = $modified;
134 0           $node{'id'} = $id;
135 0           $node{'moderate'} = 0;
136 0           $nodes{$name} = \%node;
137             }
138              
139             # Grab all the content
140 0           $sth = $dbh->prepare("SELECT node_id,version,text,modified,comment FROM content");
141 0           $sth->execute;
142 0           while ( my($node_id,$version,$text,$modified,$comment) = $sth->fetchrow_array) {
143 0           my %content;
144 0           $content{'node_id'} = $node_id;
145 0           $content{'version'} = $version;
146 0           $content{'text'} = $text;
147 0           $content{'modified'} = $modified;
148 0           $content{'comment'} = $comment;
149 0           $content{'moderated'} = 1;
150 0           $contents{$node_id."-".$version} = \%content;
151             }
152              
153             # Grab all the metadata
154 0           $sth = $dbh->prepare("SELECT node_id,version,metadata_type,metadata_value FROM metadata");
155 0           $sth->execute;
156 0           my $i = 0;
157 0           while( my($node_id,$version,$metadata_type,$metadata_value) = $sth->fetchrow_array) {
158 0           my %metadata;
159 0           $metadata{'node_id'} = $node_id;
160 0           $metadata{'version'} = $version;
161 0           $metadata{'metadata_type'} = $metadata_type;
162 0           $metadata{'metadata_value'} = $metadata_value;
163 0           $metadatas{$node_id."-".($i++)} = \%metadata;
164             }
165              
166             # Grab all the internal links
167 0           $sth = $dbh->prepare("SELECT link_from,link_to FROM internal_links");
168 0           $sth->execute;
169 0           while( my($link_from,$link_to) = $sth->fetchrow_array) {
170 0           my %il;
171 0           $il{'link_from'} = $link_from;
172 0           $il{'link_to'} = $link_to;
173 0           push @internal_links, \%il;
174             }
175              
176 0           print "done\n";
177              
178             # Return it all
179 0           return (\%nodes,\%contents,\%metadatas,\@internal_links);
180             }
181              
182             # Fetch from schema version 9, and upgrade to version 10
183             sub fetch_upgrade_9_to_10 {
184 0     0 0   my $dbh = shift;
185 0           my %nodes;
186             my %metadatas;
187 0           my %contents;
188 0           my @internal_links;
189              
190 0           print "Grabbing and upgrading old data... ";
191              
192             # Grab all the nodes
193 0           my $sth = $dbh->prepare("SELECT id,name,version,text,modified,moderate FROM node");
194 0           $sth->execute;
195 0           while( my($id,$name,$version,$text,$modified,$moderate) = $sth->fetchrow_array) {
196 0           my %node;
197 0           $node{'name'} = $name;
198 0           $node{'version'} = $version;
199 0           $node{'text'} = $text;
200 0           $node{'modified'} = $modified;
201 0           $node{'id'} = $id;
202 0           $node{'moderate'} = $moderate;
203 0           $nodes{$name} = \%node;
204             }
205              
206             # Grab all the content
207 0           $sth = $dbh->prepare("SELECT node_id,version,text,modified,comment,moderated FROM content");
208 0           $sth->execute;
209 0           while ( my($node_id,$version,$text,$modified,$comment,$moderated) = $sth->fetchrow_array) {
210 0           my %content;
211 0           $content{'node_id'} = $node_id;
212 0           $content{'version'} = $version;
213 0           $content{'text'} = $text;
214 0           $content{'modified'} = $modified;
215 0           $content{'comment'} = $comment;
216 0           $content{'moderated'} = $moderated;
217 0           $contents{$node_id."-".$version} = \%content;
218             }
219              
220             # Grab all the metadata
221 0           $sth = $dbh->prepare("SELECT node_id,version,metadata_type,metadata_value FROM metadata");
222 0           $sth->execute;
223 0           my $i = 0;
224 0           while( my($node_id,$version,$metadata_type,$metadata_value) = $sth->fetchrow_array) {
225 0           my %metadata;
226 0           $metadata{'node_id'} = $node_id;
227 0           $metadata{'version'} = $version;
228 0           $metadata{'metadata_type'} = $metadata_type;
229 0           $metadata{'metadata_value'} = $metadata_value;
230 0           $metadatas{$node_id."-".($i++)} = \%metadata;
231             }
232              
233             # Grab all the internal links
234 0           $sth = $dbh->prepare("SELECT link_from,link_to FROM internal_links");
235 0           $sth->execute;
236 0           while( my($link_from,$link_to) = $sth->fetchrow_array) {
237 0           my %il;
238 0           $il{'link_from'} = $link_from;
239 0           $il{'link_to'} = $link_to;
240 0           push @internal_links, \%il;
241             }
242              
243 0           print "done\n";
244              
245             # Return it all
246 0           return (\%nodes,\%contents,\%metadatas,\@internal_links);
247             }
248              
249             # Get the version of the database schema
250             sub get_database_version {
251 0     0 0   my $dbh = shift;
252 0           my $sql = "SELECT version FROM schema_info";
253 0           my $sth;
254 0           eval{ $sth = $dbh->prepare($sql) };
  0            
255 0 0         if($@) { return "old"; }
  0            
256 0           eval{ $sth->execute };
  0            
257 0 0         if($@) { return "old"; }
  0            
258              
259 0           my ($cur_schema) = $sth->fetchrow_array;
260 0 0         unless($cur_schema) { return "old"; }
  0            
261              
262 0           return $cur_schema;
263             }
264              
265             # Is an upgrade to the database required?
266             sub get_database_upgrade_required {
267 0     0 0   my ($dbh,$new_version) = @_;
268              
269             # Get the schema version
270 0           my $schema_version = get_database_version($dbh);
271              
272             # Compare it
273 0 0 0       if($schema_version eq $new_version) {
    0          
274             # At latest version
275 0           return undef;
276             } elsif ($schema_version eq 'old' or $schema_version < $new_version) {
277 0           return $schema_version."_to_".$new_version;
278             } else {
279 0           die "Aiee! We seem to be trying to downgrade the database schema from $schema_version to $new_version. Aborting.\n";
280             }
281             }
282              
283             # Put the latest data into the latest database structure
284             sub bulk_data_insert {
285 0     0 0   my ($dbh, $nodesref, $contentsref, $metadataref, $internallinksref) = @_;
286              
287 0           print "Bulk inserting upgraded data... ";
288              
289             # Add nodes
290 0           my $sth = $dbh->prepare("INSERT INTO node (id,name,version,text,modified,moderate) VALUES (?,?,?,?,?,?)");
291 0           foreach my $name (keys %$nodesref) {
292 0           my %node = %{$nodesref->{$name}};
  0            
293             $sth->execute($node{'id'},
294             $node{'name'},
295             $node{'version'},
296             $node{'text'},
297             $node{'modified'},
298 0           $node{'moderate'});
299             }
300 0           print "added ".(scalar keys %$nodesref)." nodes... ";
301              
302             # Add content
303 0           $sth = $dbh->prepare("INSERT INTO content (node_id,version,text,modified,comment,moderated) VALUES (?,?,?,?,?,?)");
304 0           foreach my $key (keys %$contentsref) {
305 0           my %content = %{$contentsref->{$key}};
  0            
306             $sth->execute($content{'node_id'},
307             $content{'version'},
308             $content{'text'},
309             $content{'modified'},
310             $content{'comment'},
311 0           $content{'moderated'});
312             }
313              
314             # Add metadata
315 0           $sth = $dbh->prepare("INSERT INTO metadata (node_id,version,metadata_type,metadata_value) VALUES (?,?,?,?)");
316 0           foreach my $key (keys %$metadataref) {
317 0           my %metadata = %{$metadataref->{$key}};
  0            
318             $sth->execute($metadata{'node_id'},
319             $metadata{'version'},
320             $metadata{'metadata_type'},
321 0           $metadata{'metadata_value'});
322             }
323              
324             # Add internal links
325 0           $sth = $dbh->prepare("INSERT INTO internal_links (link_from,link_to) VALUES (?,?)");
326 0           foreach my $ilr (@$internallinksref) {
327 0           my %il = %{$ilr};
  0            
328             $sth->execute($il{'link_from'},
329 0           $il{'link_to'});
330             }
331              
332 0           print "done\n";
333             }
334              
335             sub perm_check {
336 0     0 0   my $dbh = shift;
337             # If we can do all this, we'll be able to do a bulk upgrade too
338 0           eval {
339 0           my $sth = $dbh->prepare("CREATE TABLE dbtest (test int)");
340 0           $sth->execute;
341              
342 0           $sth = $dbh->prepare("CREATE INDEX dbtest_index ON dbtest (test)");
343 0           $sth->execute;
344              
345 0           $sth = $dbh->prepare("DROP TABLE dbtest");
346 0           $sth->execute;
347             };
348 0           return $@;
349             }