1package Class::DBI::DDL; 2 3use 5.008; 4use strict; 5use warnings; 6 7our $VERSION = '1.02'; 8 9use base qw(Class::Data::Inheritable Class::DBI); 10 11=head1 NAME 12 13Class::DBI::DDL - Combined with Class::DBI to create and dispose of tables 14 15=head1 SYNOPSIS 16 17 package My::DBI; 18 use base 'Class::DBI::DDL'; 19 20 # __PACKAGE__->set_db('Main', 'dbi:Pg:dbname=test', 'test', 'test'); 21 __PACKAGE->set_db('Main', 'dbi:mysql:test', 'test', 'test'); 22 23 package My::Folk; 24 25 use base 'My::DBI'; 26 27 # Regular Class::DBI definitions... 28 __PACKAGE__->table('folks'); 29 __PACKAGE__->columns(Primary => 'id'); 30 __PACKAGE__->columns(Essential => qw(first_name last_name age)); 31 __PACKAGE__->has_many(favorite_colors => 'My::Favorite'); 32 33 # DDL methods 34 __PACKAGE__->column_definitions([ 35 [ id => 'int', 'not null', 'auto_increment' ], 36 [ first_name => 'varchar(20)', 'not null' ], 37 [ last_name => 'varchar(20)', 'not null' ], 38 [ age => 'numeric(3)', 'not null' ], 39 ]); 40 41 __PACKAGE__->index_definitions([ 42 [ Unique => qw(last_name first_name) ], 43 ]); 44 45 __PACKAGE__->create_table; 46 47 package My::Favorite; 48 49 use base 'My::DBI'; 50 51 # Class::DBI definitions... 52 __PACKAGE__->table('favorites'); 53 __PACKAGE__->columns(Primary => 'id'); 54 __PACKAGE__->columns(Essential => qw(folk color)); 55 __PACKAGE__->has_a(folk => 'My::Folk'); 56 57 # DDL methods 58 __PACKAGE__->column_definitions([ 59 [ id => 'int', 'not null', 'auto_increment' ], 60 [ folk => 'numeric(5)', 'not null' ], 61 [ color => 'varchar(20)', 'not null' ], 62 ]); 63 64 __PACKAGE__->index_definitions([ 65 [ Unique => qw(folk color) ], 66 [ Foreign => 'folk', 'My::Folk', 'id' ], 67 ]); 68 69 __PACKAGE__->create_table; 70 71=head1 DESCRIPTION 72 73This module is used to added to a L<Class::DBI> class to allow it to 74automatically generate DDL calls to create a table if it doesn't exist in the 75database already. It attempts to do so in such a way as to be database 76independent whenever possible. 77 78Use the typical C<Class::DBI> methods to build your class methods. Then, use 79the C<column_definitions> and C<index_definitions> methods to define the 80structure of the table. Finally, call C<create_table> and the system will 81attempt to create the table if the table cannot be found. 82 83=head2 DBI DEPENDENCE 84 85The functionality provided by this library attempts to depend on as little that 86is database or driver specific as possible. However, it does, at this time, 87require that the DBD driver have a functioning C<tables> method for listing 88tables in the database. Such dependence may later be emulated in the same way 89L</DRIVER DEPENDENT OPERATIONS> is done, if necessary, but it is not at this 90time. 91 92=head2 DRIVER DEPENDENT OPERATIONS 93 94It also has some special support for situations where standard SQL generation 95will fail for a given database. The primary use of this facility is to make 96sure that auto-increment fields are properly handled. This system uses the the 97"auto_increment" property notation used by MySQL to handle this. This system 98does not work well with the C<sequence> method of C<Class::DBI>. 99 100=head2 METHODS 101 102In addition to the method found in L<Class::DBI>, this package defines the 103following: 104 105=over 106 107=item column_definitions 108 109 __PACKAGE__->column_definitions($array_reference); 110 111The array reference passed should contain an element for each column given to 112the C<columns> method of C<Class::DBI>. Each element is an array reference 113whose first element is the column name. The rest of the elements after the 114column name are used to define the column. Typically, the column type will 115be next followed by any flags, such as "NULL", "NOT NULL", "AUTO_INCREMENT", 116etc. Don't use index constraints here such as "PRIMARY" or "UNIQUE". 117 118=item index_definitions 119 120 __PACKAGE__->index_definitions($array_reference); 121 122The array reference passed should contain an element for each column index 123to create in addition to the primary key. Currently, two index types are 124supported: "UNIQUE" and "FOREIGN". The "UNIQUE" index will create an index 125that constrains the columns so that there are no duplicates in the given 126fields. The "FOREIGN" index will create a link between databases and should 127enforce referential integrity--if the underlying driver supports it. 128 129Each element of the column index is an array reference whose first element 130is the name of the type of index to use--this name is case-insensitive. 131Following this are the arguments to that type of index, whose format varies 132depending upon the index type: 133 134=over 135 136=item UNIQUE 137 138For a "UNIQUE" index, an array or array reference contain column names 139follows the "UNIQUE" keyword. The given column names will be used to create 140the index. 141 142=item FOREIGN 143 144A "FOREIGN" index takes exactly three arguments. The first and third arguments 145are column names and the second is the name of a package. The column name 146arguments may either be a single column name, or an array reference containing 147multiple column names. In any case, the first and third arguments must have 148exactly the same number of elements. The package name in the second argument 149should point to another C<Class::DBI> class that has already been defined. 150 151=back 152 153=cut 154 155__PACKAGE__->mk_classdata('column_definitions'); 156__PACKAGE__->mk_classdata('index_definitions'); 157__PACKAGE__->mk_classdata('__ddl_helper'); 158__PACKAGE__->column_definitions([]); 159__PACKAGE__->index_definitions([]); 160 161# =item _list_tables 162# 163# @tables = __PACKAGE__->_list_tables 164# 165# This method is not intended for external use, but is used to list all the 166# tables the database driver is aware of. This is used in testing whether or not 167# the actual CREATE or DROP expressions should be run--that is, since CREATE 168# TABLE IF NOT EXISTS and DROP TABLE IF EXISTS are not available everywhere. 169# 170# =cut 171sub _list_tables { 172 my $class = shift; 173 my $dbh = $class->db_Main; 174 return map { s/.*\.//; s/^(?:`|")//; s/(?:`|")//; $_ } $dbh->tables(); 175} 176 177# =item _load_driver_specifics 178# 179# $class->_load_driver_specifics; 180# 181# This method loads the helper class associated with the current driver. If no 182# such class exists, then it will use the fall-back helpers (defined within this 183# package). After this method is called the C<__ddl_helper> class accessor will 184# contain the name of the package to be used for calling C<pre_create_table>, 185# C<post_create_table>, C<pre_drop_table>, and C<post_drop_table>. 186# 187# =cut 188sub _load_driver_specifics { 189 my $class = shift; 190 191 # Find the driver name 192 my $driver_name = $class->db_Main->{Driver}->{Name}; 193 194 # Try to load the Class::DBI::DDL::$driver_name module 195 eval qq(package Class::DBI::DDL::_safe; require Class::DBI::DDL::$driver_name); 196 197 unless ($@) { 198 # We've loaded Class::DBI::DDL::$driver_name 199 $class->__ddl_helper("Class::DBI::DDL::$driver_name"); 200 } else { 201 # An error occurred, we'll fall back to the defaults 202 $class->__ddl_helper('Class::DBI::DDL'); 203 } 204} 205 206=item create_table 207 208 __PACKAGE__->create_table; 209 210 # -- OR -- 211 212 __PACKAGE__->create_table(sub { ... }); 213 214This method does most of the real work of this package. It takes the given 215C<column_definitions> and C<index_definitions> and some other C<Class::DBI> 216information to create the table if the table does not already exist in the 217database. 218 219If the method is passed a code reference, then the given code will be executed 220if the table is created. The code reference will be called after the table 221exists. This is so the user may populate the table with a "starter database" 222if the table needs to have some data in it at creation time. 223 224=cut 225 226__PACKAGE__->set_sql(create_table => q(CREATE TABLE __TABLE__ (%s))); 227__PACKAGE__->set_sql(drop_table => q(DROP TABLE __TABLE__)); 228 229sub create_table { 230 my $class = shift; 231 my $on_create = shift; 232 233 my $dbh = $class->db_Main; 234 my $table = $class->table; 235 my @tables = $class->_list_tables; 236 237 if (!grep /^$table$/, @tables) { 238 239 $class->_load_driver_specifics; 240 $class->__ddl_helper->pre_create_table($class); 241 242 my @decls; 243 for my $column (@{ $class->column_definitions }) { 244 push @decls, join(' ', @$column); 245 } 246 247 my @primary = $class->primary_columns; 248 push @decls, sprintf('PRIMARY KEY (%s)', join(',', @primary)); 249 250 for my $index (@{ $class->index_definitions }) { 251 my $type = $$index[0]; 252 if ($type =~ /unique/i) { 253 if (ref $$index[1]) { 254 push @decls, sprintf('UNIQUE (%s)', join(',', @{$$index[1]})); 255 } else { 256 push @decls, sprintf('UNIQUE (%s)', join(',', @$index[1 .. $#$index])); 257 } 258 } elsif ($type =~ /foreign/i) { 259 my @from = ref $$index[1] ? @{$$index[1]} : ($$index[1]); 260 my $table = $$index[2]; 261 my @to = ref $$index[3] ? @{$$index[3]} : ($$index[3]); 262 263 push @decls, sprintf('FOREIGN KEY (%s) REFERENCES %s (%s)', 264 join(',', @from), $table->table, join(',', @to)); 265 } else { 266 Class::DBI::_croak "Unknown index type $type."; 267 } 268 } 269 270 $class->sql_create_table(join(', ', @decls))->execute; 271 $class->__ddl_helper->post_create_table($class); 272 273 if (defined $on_create and ref $on_create eq 'CODE') { 274 &$on_create; 275 } 276 } 277} 278 279=item drop_table 280 281 __PACKAGE->drop_table; 282 283This method undoes the work of C<create_table>. It does nothing if the table 284doesn't exist. 285 286=cut 287 288sub drop_table { 289 my $class = shift; 290 291 my $dbh = $class->db_Main; 292 my $table = $class->table; 293 my @tables = $class->_list_tables; 294 295 if (grep /^$table$/, @tables) { 296 $class->_load_driver_specifics; 297 $class->__ddl_helper->pre_drop_table($class); 298 $class->sql_drop_table->execute; 299 $class->__ddl_helper->post_drop_table($class); 300 } 301} 302 303=back 304 305=head2 HELPER METHODS 306 307The C<Class::DBI::DDL> package uses helper methods named C<pre_create_table>, 308C<post_create_table>, C<pre_drop_table>, and C<post_drop_table> to take care of 309work that is specific to a database driver--specifically setting up 310auto_increment columns or stripping out unsupported constraints or indexes. 311 312As of this writing, C<Class::DBI::DDL> supports C<DBD::Pg> and C<DBD::mysql> 313directly, but provides a default that is general enough to work under most 314other environments. To define a new helper for another database driver, just 315create a package named C<Class::DBI::DDL::Driver>, where C<Driver> is the name 316of the database driver name returned by: 317 318 $dbh->{Driver}->{Name} 319 320After this class is installed somewhere in the Perl include path, it will be 321automatically loaded. If you create such a driver, please send it to me and I 322will consider its inclusion in the next release. 323 324Here are described the workings of the default helper methods--please let me 325know if this could be improved to be more general as this is largely untested! 326 327=over 328 329=item pre_create_table 330 331 Class::DBI::DDL::Driver->pre_create_table($class) 332 333As its first argument (besides the invocant) it is passed the class name of the 334caller. This method is called before C<create_table> processes any of the column 335or index information. 336 337The default method simply checks for the C<auto_increment> property in the 338column definitions. If found, it drops the C<auto_increment> property and adds a 339trigger that finds the maximum value in the column and adds one to that value 340and sets the column to the incremented value. Thus, this emulates the 341auto_increment feature for any database that supports the MAX aggregate 342function. 343 344=cut 345 346__PACKAGE__->set_sql(select_auto_increment => q( 347 SELECT MAX(%s)+1 FROM __TABLE__ 348)); 349 350sub pre_create_table { 351 my ($class, $self) = @_; 352 353 # For each column with an auto_increment property, drop that property and 354 # add triggers to set those values on insert to MAX($column)+1. 355 for my $column (@{$self->column_definitions}) { 356 if (grep /^auto_increment$/i, @{$column}[1 .. $#$column]) { 357 $self->add_trigger(before_create => sub { 358 my $self = shift; 359 my $sth = $self->sql_select_auto_increment($$column[0]); 360 $sth->execute; 361 my @row = $sth->fetchall; 362 $self->{$$column[0]} = $row[0][0] || 1; 363 }); 364 @$column = grep !/^auto_increment$/i, @$column; 365 } 366 } 367} 368 369=item post_create_table 370 371 Class::DBI::DDL::Driver->post_create_table($class) 372 373As its argument (besides the invocant) it is passed the class name of the 374caller. This method is called after C<create_table> has created the table and 375before the start database method is called (if present). 376 377The default method does nothing. 378 379=cut 380 381sub post_create_table { } 382 383=item pre_drop_table 384 385 Class::DBI::DDL::Driver->pre_drop_table($class) 386 387As its argument (besides the invocant) it is passed the class name of the 388caller. This method is called before C<drop_table> drops the table. 389 390The default method does nothing. 391 392=cut 393 394sub pre_drop_table { } 395 396=item post_drop_table 397 398 Class::DBI::DDL::Driver->post_drop_table($class) 399 400As its argument (besides the invocant) it is passed the class name of the 401caller. This method is called after C<drop_table> drops the table. 402 403The default method does nothing. 404 405=cut 406 407sub post_drop_table { } 408 409=back 410 411=head1 SEE ALSO 412 413L<Class::DBI>, L<DBI> 414 415=head1 AUTHOR 416 417Andrew Sterling Hanenkamp <sterling@hanenkamp.com> 418 419=head1 LICENSE AND COPYRIGHT 420 421Copyright 2003 Andrew Sterling Hanenkamp. All Rights Reserved. 422 423This module is free software and is distributed under the same license as Perl 424itself. 425 426=cut 427 4281 429