package My::ClassDBI; use strict; use warnings; use base 'Class::DBI'; my $dsn = 'dbi:mysql:database'; my $user = 'user'; my $password = 'password'; My::ClassDBI->set_db('Main', $dsn, $user, $password); # auto load tables my $base = __PACKAGE__; # "My::ClassDBI"; # create connection to database my $dbh = DBI->connect($dsn,$user,$password) or die $DBI::errstr; # not the Right Way(tm) but works for now my $get_tables = $dbh->prepare(qq!SHOW TABLES!); $get_tables->execute; my @tables; while ( my $table = $get_tables->fetchrow ) { my @columns; my $ucftable = ucfirst($table); my $get_column = $dbh->prepare(qq!DESC $table!); $get_column->execute(); while ( my @cols = $get_column->fetchrow() ) { # force the primary key to be first # this insures Class::DBI correctly relates table # without having to manually define the Primary Key $cols[3] =~ /pri/i ? unshift @columns , $cols[0] : push @columns , $cols[0] } eval qq!package Table::$ucftable; use base '$base'; Table::$ucftable->table('$table'); Table::$ucftable->columns(All => qw/! . join(" ",@columns) . "/);"; } # this bit of code is explained below Table::User->has_many( 'pages' , 'Table::Page' => 'user_id' ); 1; #### Table::Tablename->columns( Primary => 'primary_key_column_name' ); #### Table::User->has_many( 'pages' , 'Table::Page' => 'user_id' ); #### # sql for testing CREATE TABLE user ( user_id int(11) unsigned NOT NULL auto_increment, user_name varchar(255) default NULL, first_name varchar(255) default NULL, last_name varchar(255) default NULL, password varchar(255) default NULL, date_of_birth varchar(255) default NULL, occupation varchar(255) default NULL, is_active tinyint(4) NOT NULL default '0', last_visited_on datetime default NULL, created_on datetime default NULL, modified_on timestamp(14) NOT NULL, email varchar(75) default NULL, city varchar(75) default NULL, state varchar(75) default NULL, country varchar(255) default NULL, postal_code varchar(75) default NULL, phone_number varchar(75) default NULL, organization varchar(255) default NULL, address varchar(200) default NULL, PRIMARY KEY (user_id) ) TYPE=MyISAM; CREATE TABLE page ( page_id int(11) unsigned NOT NULL auto_increment, name varchar(255) default NULL, created_on datetime NOT NULL default '0000-00-00 00:00:00', modified_on timestamp(14) NOT NULL, filename varchar(255) NOT NULL default '', PRIMARY KEY (page_id) ) TYPE=MyISAM; #### use My::ClassDBI; use DBI; use strict; # Since this is our test code we will create a # traditional connection to the database so we # can display the actual database contents along # with our abstracted interaction my $dbh = DBI->connect('dbi:mysql:test') or die $! , "\n"; # the create method is misleading since it is # a mthod that adds records not tables like the # SQL CREATE command. # Lets add a user to the user table, we will # only add a small amount of initial information Table::User->create( { user_name => 'trs80', first_name => 'Fist', last_name => 'Last', } ); # Verify it added with traditional SQL sub traditional_select { print "\n>> Traditional SQL results\n"; my $cursor = $dbh->prepare("SELECT user_name, first_name, last_name, email, phone_number, address FROM user"); $cursor->execute; my $count = 1; while ( my @columns = $cursor->fetchrow() ) { print " Row " . $count++ . ":" . join("\t",@columns) . "\n"; } print "\n"; } traditional_select(); # now we will make an object that relates to a single # record. We know that our entry is id 1 since it is # the only record in the database so we do the following our $user = Table::User->retrieve(1); # $user contains our object, but since we haven't called # any methods on the objects it has not made any calls to # the database. print ">> Class::DBI Results (single column)\n"; print " Users First Name: " , $user->first_name , "\n\n"; # Now $user contains all the information related to # the record in the database. You can verify this with # Data::Dumper if you want. # Lets add some more data to our users record # We do this by passing our value to the method # names that correspond to our table columns, # these were auto created by Class::DBI $user->email('email@domain.com'); $user->phone_number('999-511-1212'); $user->update(); print ">> Class::DBI Results (single column)\n"; print " Users Phone Number: " , $user->phone_number , "\n"; # Verify with traditional_sql traditional_select(); # Notice we used update here, what happens if we don't use # update? $user->address('123 First Street'); print ">> Class::DBI Results (single column)\n"; print " Users Address: " , $user->address , "\n"; # Verify with traditional_sql traditional_select(); # This is a bit confusing here since the update has not # made it to the database, the value exists in the # object, but until you do 'update' no change is # passed to the database. This is important because # it allows for a pseduo rollback even in databases that # don't support transactions. # If we take the object out of scope and recreate it, we # see that address has lost its value. undef $user; $user = Table::User->retrieve(1); print ">> Class::DBI Results (single column)\n"; print " Users Address: " , $user->address , "\n\n"; # Class::DBI is nice enough to print a warning about # destroying the user object without updating, but the # app will continue to run. # Now lets get our page data (there shouldn't be any) # we are going to put it in a sub since we use it # several times. sub print_page_names { # it is a good idea to make sure you are # working with a valid Class before attempting # to use relationship methods, Class::DBI will # die if you attempt to use a method on a deleted # record. if ( $user->isa( 'Table::User' ) ) { my @pages = $user->pages; print ">> Attempting to print page names\n"; foreach (@pages) { print " " , $_->name , "\n"; } print "\n"; } else { warn "\nUser object no longer valid\n"; } } print_page_names(); # so that didn't do anything, which is good, this # shows we can access empty tables and suffer no # errors. # Lets add some data to the page table Table::Page->create( { user_id => 1, name => "Page number 1", filename => "page.html", } ); # Now lets rerun our pages call above # It should now print Our Page print_page_names(); # that worked good so lets add 5 new pages foreach (2..5) { Table::Page->create( { user_id => 1, name => "Page number $_", filename => "page$_.html", } ); } # run our pages code again and show # all 5 pages print_page_names(); # Next we want to delete the user, and this should # have a side effect of removing all the pages. $user->delete(1); # Now if we try to print out page names # we get no output. print_page_names(); # lets clear up the auto_increment for the next # run $dbh->do("DELETE FROM user"); $dbh->do("DELETE FROM page"); print "\nFinished\n"; 1; #### =pod =head1 Purpose This script will generate the sub classed files required for working with Class::DBI. By default the Class is called Table, you can modify it by passing in a command line argument. Redirect STDOUT (at the command line is how I do it) to a file to save the output, like so: perl create_table_classes.pl > Table.pm =cut use DBI; use strict; my $base = "My::ClassDBI"; my $dsn = 'dbi:mysql:database'; my $user = 'user'; my $password = 'password'; # create connection to database my $dbh = DBI->connect($dsn,$user,$password) or die $DBI::errstr; my $get_tables = $dbh->prepare(qq!SHOW TABLES!); $get_tables->execute; my @tables; while ( my $table = $get_tables->fetchrow ) { my @columns; my $get_column = $dbh->prepare(qq!DESC $_!); $get_column->execute(); while ( my @cols = $get_column->fetchrow() ) { $cols[3] =~ /pri/i ? unshift @columns , $cols[0] : push @columns , $cols[0] } my $col_list = "\t" . join("\n\t",@columns); print qq!package Table::$table; use base '$base'; Table::$table->table('$_'); Table::$table->columns(All => qw/ $col_list /); 1; !; }