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;
!;
}