| 1 | package Wiki::Toolkit::Setup::MySQL; |
|---|
| 2 | |
|---|
| 3 | use strict; |
|---|
| 4 | |
|---|
| 5 | use vars qw( @ISA $VERSION ); |
|---|
| 6 | |
|---|
| 7 | use Wiki::Toolkit::Setup::Database; |
|---|
| 8 | |
|---|
| 9 | @ISA = qw( Wiki::Toolkit::Setup::Database ); |
|---|
| 10 | $VERSION = '0.09'; |
|---|
| 11 | |
|---|
| 12 | use DBI; |
|---|
| 13 | use Carp; |
|---|
| 14 | |
|---|
| 15 | my %create_sql = ( |
|---|
| 16 | schema_info => [ qq| |
|---|
| 17 | CREATE TABLE schema_info ( |
|---|
| 18 | version int(10) NOT NULL default 0 |
|---|
| 19 | ) |
|---|
| 20 | |, qq| |
|---|
| 21 | INSERT INTO schema_info VALUES (|.($VERSION*100).qq|) |
|---|
| 22 | | ], |
|---|
| 23 | |
|---|
| 24 | node => [ qq| |
|---|
| 25 | CREATE TABLE node ( |
|---|
| 26 | id integer NOT NULL AUTO_INCREMENT, |
|---|
| 27 | name varchar(200) NOT NULL DEFAULT '', |
|---|
| 28 | version int(10) NOT NULL default 0, |
|---|
| 29 | text mediumtext NOT NULL default '', |
|---|
| 30 | modified datetime default NULL, |
|---|
| 31 | moderate bool NOT NULL default '0', |
|---|
| 32 | PRIMARY KEY (id) |
|---|
| 33 | ) |
|---|
| 34 | | ], |
|---|
| 35 | |
|---|
| 36 | content => [ qq| |
|---|
| 37 | CREATE TABLE content ( |
|---|
| 38 | node_id integer NOT NULL, |
|---|
| 39 | version int(10) NOT NULL default 0, |
|---|
| 40 | text mediumtext NOT NULL default '', |
|---|
| 41 | modified datetime default NULL, |
|---|
| 42 | comment mediumtext NOT NULL default '', |
|---|
| 43 | moderated bool NOT NULL default '1', |
|---|
| 44 | PRIMARY KEY (node_id, version) |
|---|
| 45 | ) |
|---|
| 46 | | ], |
|---|
| 47 | internal_links => [ qq| |
|---|
| 48 | CREATE TABLE internal_links ( |
|---|
| 49 | link_from varchar(200) NOT NULL default '', |
|---|
| 50 | link_to varchar(200) NOT NULL default '', |
|---|
| 51 | PRIMARY KEY (link_from, link_to) |
|---|
| 52 | ) |
|---|
| 53 | | ], |
|---|
| 54 | metadata => [ qq| |
|---|
| 55 | CREATE TABLE metadata ( |
|---|
| 56 | node_id integer NOT NULL, |
|---|
| 57 | version int(10) NOT NULL default 0, |
|---|
| 58 | metadata_type varchar(200) NOT NULL DEFAULT '', |
|---|
| 59 | metadata_value mediumtext NOT NULL DEFAULT '' |
|---|
| 60 | ) |
|---|
| 61 | |, qq| |
|---|
| 62 | CREATE INDEX metadata_index ON metadata(node_id, version, metadata_type, metadata_value(10)) |
|---|
| 63 | | ] |
|---|
| 64 | ); |
|---|
| 65 | |
|---|
| 66 | =head1 NAME |
|---|
| 67 | |
|---|
| 68 | Wiki::Toolkit::Setup::MySQL - Set up tables for a Wiki::Toolkit store in a MySQL database. |
|---|
| 69 | |
|---|
| 70 | =head1 SYNOPSIS |
|---|
| 71 | |
|---|
| 72 | use Wiki::Toolkit::Setup::MySQL; |
|---|
| 73 | Wiki::Toolkit::Setup::MySQL::setup($dbname, $dbuser, $dbpass, $dbhost); |
|---|
| 74 | |
|---|
| 75 | Omit $dbhost if the database is local. |
|---|
| 76 | |
|---|
| 77 | =head1 DESCRIPTION |
|---|
| 78 | |
|---|
| 79 | Set up a MySQL database for use as a Wiki::Toolkit store. |
|---|
| 80 | |
|---|
| 81 | =head1 FUNCIONS |
|---|
| 82 | |
|---|
| 83 | =over 4 |
|---|
| 84 | |
|---|
| 85 | =item B<setup> |
|---|
| 86 | |
|---|
| 87 | use Wiki::Toolkit::Setup::MySQL; |
|---|
| 88 | Wiki::Toolkit::Setup::MySQL::setup($dbname, $dbuser, $dbpass, $dbhost); |
|---|
| 89 | |
|---|
| 90 | or |
|---|
| 91 | |
|---|
| 92 | Wiki::Toolkit::Setup::Mysql::setup( $dbh ); |
|---|
| 93 | |
|---|
| 94 | You can either provide an active database handle C<$dbh> or connection |
|---|
| 95 | parameters. |
|---|
| 96 | |
|---|
| 97 | If you provide connection parameters the following arguments are |
|---|
| 98 | mandatory -- the database name, the username and the password. The |
|---|
| 99 | username must be able to create and drop tables in the database. |
|---|
| 100 | |
|---|
| 101 | The $dbhost argument is optional -- omit it if the database is local. |
|---|
| 102 | |
|---|
| 103 | B<NOTE:> If a table that the module wants to create already exists, |
|---|
| 104 | C<setup> will leave it alone. This means that you can safely run this |
|---|
| 105 | on an existing L<Wiki::Toolkit> database to bring the schema up to date |
|---|
| 106 | with the current L<Wiki::Toolkit> version. If you wish to completely start |
|---|
| 107 | again with a fresh database, run C<cleardb> first. |
|---|
| 108 | |
|---|
| 109 | =cut |
|---|
| 110 | |
|---|
| 111 | sub setup { |
|---|
| 112 | my @args = @_; |
|---|
| 113 | my $dbh = _get_dbh( @args ); |
|---|
| 114 | my $disconnect_required = _disconnect_required( @args ); |
|---|
| 115 | |
|---|
| 116 | # Check whether tables exist |
|---|
| 117 | my %tables = fetch_tables_listing($dbh); |
|---|
| 118 | |
|---|
| 119 | # Do we need to upgrade the schema of existing tables? |
|---|
| 120 | # (Don't check if no tables currently exist) |
|---|
| 121 | my $upgrade_schema; |
|---|
| 122 | my @cur_data; |
|---|
| 123 | if(scalar keys %tables > 0) { |
|---|
| 124 | $upgrade_schema = Wiki::Toolkit::Setup::Database::get_database_upgrade_required($dbh,$VERSION); |
|---|
| 125 | } |
|---|
| 126 | if($upgrade_schema) { |
|---|
| 127 | # Grab current data |
|---|
| 128 | print "Upgrading: $upgrade_schema\n"; |
|---|
| 129 | @cur_data = eval("&Wiki::Toolkit::Setup::Database::fetch_upgrade_".$upgrade_schema."(\$dbh)"); |
|---|
| 130 | if($@) { warn $@; } |
|---|
| 131 | |
|---|
| 132 | # Check to make sure we can create, index and drop tables |
|---|
| 133 | # before doing any more |
|---|
| 134 | my $perm_check = Wiki::Toolkit::Setup::Database::perm_check($dbh); |
|---|
| 135 | if ($perm_check) { |
|---|
| 136 | die "Unable to create/drop database tables as required by upgrade: $perm_check"; |
|---|
| 137 | } |
|---|
| 138 | |
|---|
| 139 | # Drop the current tables |
|---|
| 140 | cleardb($dbh); |
|---|
| 141 | |
|---|
| 142 | # Grab new list of tables |
|---|
| 143 | %tables = fetch_tables_listing($dbh); |
|---|
| 144 | } |
|---|
| 145 | |
|---|
| 146 | # Set up tables if not found |
|---|
| 147 | foreach my $required ( keys %create_sql ) { |
|---|
| 148 | if ( $tables{$required} ) { |
|---|
| 149 | print "Table $required already exists... skipping...\n"; |
|---|
| 150 | } else { |
|---|
| 151 | print "Creating table $required... done\n"; |
|---|
| 152 | foreach my $sql ( @{ $create_sql{$required} } ) { |
|---|
| 153 | $dbh->do($sql) or croak $dbh->errstr; |
|---|
| 154 | } |
|---|
| 155 | } |
|---|
| 156 | } |
|---|
| 157 | |
|---|
| 158 | # If upgrading, load in the new data |
|---|
| 159 | if($upgrade_schema) { |
|---|
| 160 | Wiki::Toolkit::Setup::Database::bulk_data_insert($dbh,@cur_data); |
|---|
| 161 | } |
|---|
| 162 | |
|---|
| 163 | # Clean up if we made our own dbh. |
|---|
| 164 | $dbh->disconnect if $disconnect_required; |
|---|
| 165 | } |
|---|
| 166 | |
|---|
| 167 | # Internal method - what Wiki::Toolkit tables are defined? |
|---|
| 168 | sub fetch_tables_listing { |
|---|
| 169 | my $dbh = shift; |
|---|
| 170 | |
|---|
| 171 | # Check what tables exist |
|---|
| 172 | my $sth = $dbh->prepare("SHOW TABLES") or croak $dbh->errstr; |
|---|
| 173 | $sth->execute; |
|---|
| 174 | my %tables; |
|---|
| 175 | while ( my $table = $sth->fetchrow_array ) { |
|---|
| 176 | exists $create_sql{$table} and $tables{$table} = 1; |
|---|
| 177 | } |
|---|
| 178 | return %tables; |
|---|
| 179 | } |
|---|
| 180 | |
|---|
| 181 | =item B<cleardb> |
|---|
| 182 | |
|---|
| 183 | use Wiki::Toolkit::Setup::MySQL; |
|---|
| 184 | |
|---|
| 185 | # Clear out all Wiki::Toolkit tables from the database. |
|---|
| 186 | Wiki::Toolkit::Setup::MySQL::cleardb($dbname, $dbuser, $dbpass, $dbhost); |
|---|
| 187 | |
|---|
| 188 | or |
|---|
| 189 | |
|---|
| 190 | Wiki::Toolkit::Setup::Mysql::cleardb( $dbh ); |
|---|
| 191 | |
|---|
| 192 | You can either provide an active database handle C<$dbh> or connection |
|---|
| 193 | parameters. |
|---|
| 194 | |
|---|
| 195 | If you provide connection parameters the following arguments are |
|---|
| 196 | mandatory -- the database name, the username and the password. The |
|---|
| 197 | username must be able to drop tables in the database. |
|---|
| 198 | |
|---|
| 199 | The $dbhost argument is optional -- omit if the database is local. |
|---|
| 200 | |
|---|
| 201 | Clears out all L<Wiki::Toolkit> store tables from the database. B<NOTE> |
|---|
| 202 | that this will lose all your data; you probably only want to use this |
|---|
| 203 | for testing purposes or if you really screwed up somewhere. Note also |
|---|
| 204 | that it doesn't touch any L<Wiki::Toolkit> search backend tables; if you |
|---|
| 205 | have any of those in the same or a different database see either |
|---|
| 206 | L<Wiki::Toolkit::Setup::DBIxFTS> or L<Wiki::Toolkit::Setup::SII>, depending on |
|---|
| 207 | which search backend you're using. |
|---|
| 208 | |
|---|
| 209 | =cut |
|---|
| 210 | |
|---|
| 211 | sub cleardb { |
|---|
| 212 | my @args = @_; |
|---|
| 213 | my $dbh = _get_dbh( @args ); |
|---|
| 214 | my $disconnect_required = _disconnect_required( @args ); |
|---|
| 215 | |
|---|
| 216 | print "Dropping tables... "; |
|---|
| 217 | $dbh->do("DROP TABLE IF EXISTS " . join( ",", keys %create_sql ) ) |
|---|
| 218 | or croak $dbh->errstr; |
|---|
| 219 | print "done\n"; |
|---|
| 220 | |
|---|
| 221 | # Clean up if we made our own dbh. |
|---|
| 222 | $dbh->disconnect if $disconnect_required; |
|---|
| 223 | } |
|---|
| 224 | |
|---|
| 225 | sub _get_dbh { |
|---|
| 226 | # Database handle passed in. |
|---|
| 227 | if ( ref $_[0] and ref $_[0] eq 'DBI::db' ) { |
|---|
| 228 | return $_[0]; |
|---|
| 229 | } |
|---|
| 230 | |
|---|
| 231 | # Args passed as hashref. |
|---|
| 232 | if ( ref $_[0] and ref $_[0] eq 'HASH' ) { |
|---|
| 233 | my %args = %{$_[0]}; |
|---|
| 234 | if ( $args{dbh} ) { |
|---|
| 235 | return $args{dbh}; |
|---|
| 236 | } else { |
|---|
| 237 | return _make_dbh( %args ); |
|---|
| 238 | } |
|---|
| 239 | } |
|---|
| 240 | |
|---|
| 241 | # Args passed as list of connection details. |
|---|
| 242 | return _make_dbh( |
|---|
| 243 | dbname => $_[0], |
|---|
| 244 | dbuser => $_[1], |
|---|
| 245 | dbpass => $_[2], |
|---|
| 246 | dbhost => $_[3], |
|---|
| 247 | ); |
|---|
| 248 | } |
|---|
| 249 | |
|---|
| 250 | sub _disconnect_required { |
|---|
| 251 | # Database handle passed in. |
|---|
| 252 | if ( ref $_[0] and ref $_[0] eq 'DBI::db' ) { |
|---|
| 253 | return 0; |
|---|
| 254 | } |
|---|
| 255 | |
|---|
| 256 | # Args passed as hashref. |
|---|
| 257 | if ( ref $_[0] and ref $_[0] eq 'HASH' ) { |
|---|
| 258 | my %args = %{$_[0]}; |
|---|
| 259 | if ( $args{dbh} ) { |
|---|
| 260 | return 0; |
|---|
| 261 | } else { |
|---|
| 262 | return 1; |
|---|
| 263 | } |
|---|
| 264 | } |
|---|
| 265 | |
|---|
| 266 | # Args passed as list of connection details. |
|---|
| 267 | return 1; |
|---|
| 268 | } |
|---|
| 269 | |
|---|
| 270 | sub _make_dbh { |
|---|
| 271 | my %args = @_; |
|---|
| 272 | my $dsn = "dbi:mysql:$args{dbname}"; |
|---|
| 273 | $dsn .= ";host=$args{dbhost}" if $args{dbhost}; |
|---|
| 274 | my $dbh = DBI->connect($dsn, $args{dbuser}, $args{dbpass}, |
|---|
| 275 | { PrintError => 1, RaiseError => 1, |
|---|
| 276 | AutoCommit => 1 } ) |
|---|
| 277 | or croak DBI::errstr; |
|---|
| 278 | return $dbh; |
|---|
| 279 | } |
|---|
| 280 | |
|---|
| 281 | =back |
|---|
| 282 | |
|---|
| 283 | =head1 ALTERNATIVE CALLING SYNTAX |
|---|
| 284 | |
|---|
| 285 | As requested by Podmaster. Instead of passing arguments to the methods as |
|---|
| 286 | |
|---|
| 287 | ($dbname, $dbuser, $dbpass, $dbhost) |
|---|
| 288 | |
|---|
| 289 | you can pass them as |
|---|
| 290 | |
|---|
| 291 | ( { dbname => $dbname, |
|---|
| 292 | dbuser => $dbuser, |
|---|
| 293 | dbpass => $dbpass, |
|---|
| 294 | dbhost => $dbhost |
|---|
| 295 | } |
|---|
| 296 | ) |
|---|
| 297 | |
|---|
| 298 | or indeed as |
|---|
| 299 | |
|---|
| 300 | ( { dbh => $dbh } ) |
|---|
| 301 | |
|---|
| 302 | Note that's a hashref, not a hash. |
|---|
| 303 | |
|---|
| 304 | =head1 AUTHOR |
|---|
| 305 | |
|---|
| 306 | Kake Pugh (kake@earth.li). |
|---|
| 307 | |
|---|
| 308 | =head1 COPYRIGHT |
|---|
| 309 | |
|---|
| 310 | Copyright (C) 2002-2004 Kake Pugh. All Rights Reserved. |
|---|
| 311 | Copyright (C) 2006 the Wiki::Toolkit team. All Rights Reserved. |
|---|
| 312 | |
|---|
| 313 | This module is free software; you can redistribute it and/or modify it |
|---|
| 314 | under the same terms as Perl itself. |
|---|
| 315 | |
|---|
| 316 | =head1 SEE ALSO |
|---|
| 317 | |
|---|
| 318 | L<Wiki::Toolkit>, L<Wiki::Toolkit::Setup::DBIxMySQL>, L<Wiki::Toolkit::Setup::SII> |
|---|
| 319 | |
|---|
| 320 | =cut |
|---|
| 321 | |
|---|
| 322 | 1; |
|---|
| 323 | |
|---|