line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Wiki::Toolkit::Setup::Database; |
2
|
|
|
|
|
|
|
|
3
|
5
|
|
|
5
|
|
600
|
use strict; |
|
5
|
|
|
|
|
10
|
|
|
5
|
|
|
|
|
169
|
|
4
|
|
|
|
|
|
|
|
5
|
5
|
|
|
5
|
|
26
|
use Carp qw( croak ); |
|
5
|
|
|
|
|
10
|
|
|
5
|
|
|
|
|
249
|
|
6
|
|
|
|
|
|
|
|
7
|
5
|
|
|
5
|
|
77
|
use vars qw( $VERSION @SUPPORTED_SCHEMAS); |
|
5
|
|
|
|
|
9
|
|
|
5
|
|
|
|
|
5526
|
|
8
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
$VERSION = 0.11; |
10
|
|
|
|
|
|
|
@SUPPORTED_SCHEMAS = qw( 10 11 ); |
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
=head1 NAME |
13
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
Wiki::Toolkit::Setup::Database - parent class for database storage setup |
15
|
|
|
|
|
|
|
classes for Wiki::Toolkit |
16
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
=cut |
18
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
# Fetch from schema version 10, and upgrade to version 11 |
20
|
|
|
|
|
|
|
sub fetch_upgrade_10_to_11 { |
21
|
0
|
|
|
0
|
0
|
|
my $dbh = shift; |
22
|
0
|
|
|
|
|
|
my %nodes; |
23
|
|
|
|
|
|
|
my %metadatas; |
24
|
0
|
|
|
|
|
|
my %contents; |
25
|
0
|
|
|
|
|
|
my @internal_links; |
26
|
|
|
|
|
|
|
|
27
|
0
|
|
|
|
|
|
print "Grabbing and upgrading old data... "; |
28
|
|
|
|
|
|
|
|
29
|
|
|
|
|
|
|
# Grab all the nodes |
30
|
0
|
|
|
|
|
|
my $sth = $dbh->prepare( "SELECT id,name,version,text,modified,moderate" |
31
|
|
|
|
|
|
|
. " FROM node" ); |
32
|
0
|
|
|
|
|
|
$sth->execute; |
33
|
0
|
|
|
|
|
|
while( my( $id, $name, $version, $text, $modified, $moderate) = |
34
|
|
|
|
|
|
|
$sth->fetchrow_array ) { |
35
|
0
|
|
|
|
|
|
$nodes{$name} = { |
36
|
|
|
|
|
|
|
name => $name, |
37
|
|
|
|
|
|
|
version => $version, |
38
|
|
|
|
|
|
|
text => $text, |
39
|
|
|
|
|
|
|
modified => $modified, |
40
|
|
|
|
|
|
|
id => $id, |
41
|
|
|
|
|
|
|
moderate => $moderate, |
42
|
|
|
|
|
|
|
}; |
43
|
|
|
|
|
|
|
} |
44
|
|
|
|
|
|
|
|
45
|
|
|
|
|
|
|
# Grab all the content |
46
|
0
|
|
|
|
|
|
$sth = $dbh->prepare( "SELECT node_id,version,text,modified,comment," |
47
|
|
|
|
|
|
|
. "moderated FROM content" ); |
48
|
0
|
|
|
|
|
|
$sth->execute; |
49
|
0
|
|
|
|
|
|
while ( my( $node_id, $version, $text, $modified, $comment, $moderated) = |
50
|
|
|
|
|
|
|
$sth->fetchrow_array ) { |
51
|
0
|
|
|
|
|
|
$contents{$node_id."-".$version} = { |
52
|
|
|
|
|
|
|
node_id => $node_id, |
53
|
|
|
|
|
|
|
version => $version, |
54
|
|
|
|
|
|
|
text => $text, |
55
|
|
|
|
|
|
|
modified => $modified, |
56
|
|
|
|
|
|
|
comment => $comment, |
57
|
|
|
|
|
|
|
moderated => $moderated, |
58
|
|
|
|
|
|
|
}; |
59
|
|
|
|
|
|
|
} |
60
|
|
|
|
|
|
|
|
61
|
|
|
|
|
|
|
# Grab all the metadata |
62
|
0
|
|
|
|
|
|
$sth = $dbh->prepare( "SELECT node_id,version,metadata_type,metadata_value" |
63
|
|
|
|
|
|
|
. " FROM metadata" ); |
64
|
0
|
|
|
|
|
|
$sth->execute; |
65
|
0
|
|
|
|
|
|
my $i = 0; |
66
|
0
|
|
|
|
|
|
while( my ( $node_id, $version, $metadata_type, $metadata_value ) = |
67
|
|
|
|
|
|
|
$sth->fetchrow_array) { |
68
|
0
|
|
|
|
|
|
$metadatas{$node_id."-".($i++)} = { |
69
|
|
|
|
|
|
|
node_id => $node_id, |
70
|
|
|
|
|
|
|
version => $version, |
71
|
|
|
|
|
|
|
metadata_type => $metadata_type, |
72
|
|
|
|
|
|
|
metadata_value => $metadata_value, |
73
|
|
|
|
|
|
|
}; |
74
|
|
|
|
|
|
|
} |
75
|
|
|
|
|
|
|
|
76
|
|
|
|
|
|
|
# Grab all the internal links |
77
|
0
|
|
|
|
|
|
$sth = $dbh->prepare( "SELECT link_from,link_to FROM internal_links" ); |
78
|
0
|
|
|
|
|
|
$sth->execute; |
79
|
0
|
|
|
|
|
|
while( my ( $link_from, $link_to ) = $sth->fetchrow_array ) { |
80
|
0
|
|
|
|
|
|
push @internal_links, { |
81
|
|
|
|
|
|
|
link_from => $link_from, |
82
|
|
|
|
|
|
|
link_to => $link_to, |
83
|
|
|
|
|
|
|
}; |
84
|
|
|
|
|
|
|
} |
85
|
|
|
|
|
|
|
|
86
|
0
|
|
|
|
|
|
print "done\n"; |
87
|
|
|
|
|
|
|
|
88
|
|
|
|
|
|
|
# Return it all |
89
|
0
|
|
|
|
|
|
return ( \%nodes, \%contents, \%metadatas, \@internal_links ); |
90
|
|
|
|
|
|
|
} |
91
|
|
|
|
|
|
|
|
92
|
|
|
|
|
|
|
# Get the version of the database schema |
93
|
|
|
|
|
|
|
sub get_database_version { |
94
|
0
|
|
|
0
|
0
|
|
my $dbh = shift; |
95
|
0
|
|
|
|
|
|
my $sql = "SELECT version FROM schema_info"; |
96
|
0
|
|
|
|
|
|
my $sth; |
97
|
0
|
|
|
|
|
|
eval{ $sth = $dbh->prepare($sql) }; |
|
0
|
|
|
|
|
|
|
98
|
0
|
0
|
|
|
|
|
if($@) { croak_too_old(); } |
|
0
|
|
|
|
|
|
|
99
|
0
|
|
|
|
|
|
eval{ $sth->execute }; |
|
0
|
|
|
|
|
|
|
100
|
0
|
0
|
|
|
|
|
if($@) { croak_too_old(); } |
|
0
|
|
|
|
|
|
|
101
|
|
|
|
|
|
|
|
102
|
0
|
|
|
|
|
|
my ($cur_schema) = $sth->fetchrow_array; |
103
|
0
|
0
|
0
|
|
|
|
if ( !$cur_schema || $cur_schema < $SUPPORTED_SCHEMAS[0] ) { |
104
|
0
|
|
|
|
|
|
croak_too_old(); |
105
|
|
|
|
|
|
|
} |
106
|
|
|
|
|
|
|
|
107
|
0
|
|
|
|
|
|
return $cur_schema; |
108
|
|
|
|
|
|
|
} |
109
|
|
|
|
|
|
|
|
110
|
|
|
|
|
|
|
sub croak_too_old { |
111
|
0
|
|
|
0
|
0
|
|
croak "Database schema too old — must be at least version " |
112
|
|
|
|
|
|
|
. $SUPPORTED_SCHEMAS[0]; |
113
|
|
|
|
|
|
|
} |
114
|
|
|
|
|
|
|
|
115
|
|
|
|
|
|
|
# Is an upgrade to the database required? |
116
|
|
|
|
|
|
|
sub get_database_upgrade_required { |
117
|
0
|
|
|
0
|
0
|
|
my ($dbh,$new_version) = @_; |
118
|
|
|
|
|
|
|
|
119
|
|
|
|
|
|
|
# Get the schema version |
120
|
0
|
|
|
|
|
|
my $schema_version = get_database_version($dbh); |
121
|
|
|
|
|
|
|
|
122
|
|
|
|
|
|
|
# Compare it |
123
|
0
|
0
|
|
|
|
|
if($schema_version eq $new_version) { |
|
|
0
|
|
|
|
|
|
124
|
|
|
|
|
|
|
# At latest version |
125
|
0
|
|
|
|
|
|
return undef; |
126
|
|
|
|
|
|
|
} elsif ( $schema_version < $new_version ) { |
127
|
0
|
|
|
|
|
|
return $schema_version."_to_".$new_version; |
128
|
|
|
|
|
|
|
} else { |
129
|
0
|
|
|
|
|
|
die "Aiee! We seem to be trying to downgrade the database schema from $schema_version to $new_version. Aborting.\n"; |
130
|
|
|
|
|
|
|
} |
131
|
|
|
|
|
|
|
} |
132
|
|
|
|
|
|
|
|
133
|
|
|
|
|
|
|
# Put the latest data into the latest database structure |
134
|
|
|
|
|
|
|
sub bulk_data_insert { |
135
|
0
|
|
|
0
|
0
|
|
my ($dbh, $nodesref, $contentsref, $metadataref, $internallinksref) = @_; |
136
|
|
|
|
|
|
|
|
137
|
0
|
|
|
|
|
|
print "Bulk inserting upgraded data... "; |
138
|
|
|
|
|
|
|
|
139
|
|
|
|
|
|
|
# Add nodes |
140
|
0
|
|
|
|
|
|
my $sth = $dbh->prepare("INSERT INTO node (id,name,version,text,modified,moderate) VALUES (?,?,?,?,?,?)"); |
141
|
0
|
|
|
|
|
|
foreach my $name (keys %$nodesref) { |
142
|
0
|
|
|
|
|
|
my %node = %{$nodesref->{$name}}; |
|
0
|
|
|
|
|
|
|
143
|
|
|
|
|
|
|
$sth->execute($node{'id'}, |
144
|
|
|
|
|
|
|
$node{'name'}, |
145
|
|
|
|
|
|
|
$node{'version'}, |
146
|
|
|
|
|
|
|
$node{'text'}, |
147
|
|
|
|
|
|
|
$node{'modified'}, |
148
|
0
|
|
|
|
|
|
$node{'moderate'}); |
149
|
|
|
|
|
|
|
} |
150
|
0
|
|
|
|
|
|
print "added ".(scalar keys %$nodesref)." nodes... "; |
151
|
|
|
|
|
|
|
|
152
|
|
|
|
|
|
|
# Add content |
153
|
0
|
|
|
|
|
|
$sth = $dbh->prepare("INSERT INTO content (node_id,version,text,modified,comment,moderated) VALUES (?,?,?,?,?,?)"); |
154
|
0
|
|
|
|
|
|
foreach my $key (keys %$contentsref) { |
155
|
0
|
|
|
|
|
|
my %content = %{$contentsref->{$key}}; |
|
0
|
|
|
|
|
|
|
156
|
|
|
|
|
|
|
$sth->execute($content{'node_id'}, |
157
|
|
|
|
|
|
|
$content{'version'}, |
158
|
|
|
|
|
|
|
$content{'text'}, |
159
|
|
|
|
|
|
|
$content{'modified'}, |
160
|
|
|
|
|
|
|
$content{'comment'}, |
161
|
0
|
|
|
|
|
|
$content{'moderated'}); |
162
|
|
|
|
|
|
|
} |
163
|
|
|
|
|
|
|
|
164
|
|
|
|
|
|
|
# Add metadata |
165
|
0
|
|
|
|
|
|
$sth = $dbh->prepare("INSERT INTO metadata (node_id,version,metadata_type,metadata_value) VALUES (?,?,?,?)"); |
166
|
0
|
|
|
|
|
|
foreach my $key (keys %$metadataref) { |
167
|
0
|
|
|
|
|
|
my %metadata = %{$metadataref->{$key}}; |
|
0
|
|
|
|
|
|
|
168
|
|
|
|
|
|
|
$sth->execute($metadata{'node_id'}, |
169
|
|
|
|
|
|
|
$metadata{'version'}, |
170
|
|
|
|
|
|
|
$metadata{'metadata_type'}, |
171
|
0
|
|
|
|
|
|
$metadata{'metadata_value'}); |
172
|
|
|
|
|
|
|
} |
173
|
|
|
|
|
|
|
|
174
|
|
|
|
|
|
|
# Add internal links |
175
|
0
|
|
|
|
|
|
$sth = $dbh->prepare("INSERT INTO internal_links (link_from,link_to) VALUES (?,?)"); |
176
|
0
|
|
|
|
|
|
foreach my $ilr (@$internallinksref) { |
177
|
0
|
|
|
|
|
|
my %il = %{$ilr}; |
|
0
|
|
|
|
|
|
|
178
|
|
|
|
|
|
|
$sth->execute($il{'link_from'}, |
179
|
0
|
|
|
|
|
|
$il{'link_to'}); |
180
|
|
|
|
|
|
|
} |
181
|
|
|
|
|
|
|
|
182
|
0
|
|
|
|
|
|
print "done\n"; |
183
|
|
|
|
|
|
|
} |
184
|
|
|
|
|
|
|
|
185
|
|
|
|
|
|
|
sub perm_check { |
186
|
0
|
|
|
0
|
0
|
|
my $dbh = shift; |
187
|
|
|
|
|
|
|
# If we can do all this, we'll be able to do a bulk upgrade too |
188
|
0
|
|
|
|
|
|
eval { |
189
|
0
|
|
|
|
|
|
my $sth = $dbh->prepare("CREATE TABLE dbtest (test int)"); |
190
|
0
|
|
|
|
|
|
$sth->execute; |
191
|
|
|
|
|
|
|
|
192
|
0
|
|
|
|
|
|
$sth = $dbh->prepare("CREATE INDEX dbtest_index ON dbtest (test)"); |
193
|
0
|
|
|
|
|
|
$sth->execute; |
194
|
|
|
|
|
|
|
|
195
|
0
|
|
|
|
|
|
$sth = $dbh->prepare("DROP TABLE dbtest"); |
196
|
0
|
|
|
|
|
|
$sth->execute; |
197
|
|
|
|
|
|
|
}; |
198
|
0
|
|
|
|
|
|
return $@; |
199
|
|
|
|
|
|
|
} |