| Description: |
This code is a utility I whipped up to turn my MySQL database into a Class::DBI module.
Unlike other solutions like Class::DBI::AutoLoader and Class::DBI::Loader this is designed to run at development time rather than run time. Unlike Class::DBI::Schema2Code it doesn't require other modules that check your database at runtime.
However, like Class::DBI::Schema2Code, it does have expectations on your data structure, but as it's code rather than a module, you're expected to tinker.
We assume that your primary key field is called 'id' and that your foreign keys are in the form 'tablename_id'. We also assume that your primary key is the first field in your table. (yes I know there's ways to discover it ...)
Using these assumptions we set up both has_a and has_many relationships for each table.
As I'm a huge DateTime fan, I inflate all my date and time fields into datetime objects. The database I'm working with has a lot of legacy epoch date/time fields in it, so I also try to find them.
THIS IS NOT A COMPLETE SOLUTION
You'll note that the other thing we output is a die message telling you to check the code carefully! NEVER use this code without reading the resulting code. You have been warned.
I've also created my own plural/singular routines rather than use Lingua::EN::Inflect as in my case I have mixed plurals and singulars on column names (legacy schema!) when I call PL('cats') I want 'cats'.
I hope you find this code useful. I do.
The reason I've written it is because creating the files that run Class::DBI, I do the same thing over and over again. I'm sure I'm not the only one who has a 'standard' way of creating a database, that should easily be convertable.
Let me know if you use it, and feel free to offer suggestions!
usage:
perl generator.pl > Module.pm
|
#!/usr/bin/perl
use DBI;
use Data::Dumper;
#use Lingua::EN::Inflect qw/PL/;
my $basename = 'My::Data';
my $dsn = 'dbi:mysql:database:127.0.0.1';
my $user = 'user';
my $pass = 'pass';
my $dbh = DBI -> connect( $dsn, $user, $pass );
my $table_sth = $dbh->table_info('%','','');
print "package $basename;\n\n";
print "use base 'Class::DBI';\n\n";
print "use DateTime;\nuse DateTime::Format::ISO8601;\n\n";
print "$basename->connection('$dsn', '$user', '$pass');\n\n\n\n";
foreach $table ( @{$table_sth->fetchall_arrayref()} ) {
my ($cat, $schema, $table_name, $type, $remarks) = @{$table};
$table{$table_name}{camel_name} = "${basename}::".SI(CamelCaps($ta
+ble_name));
$table{$table_name}{type} = $type;
$table{$table_name}{remarks} = $remarks;
my $column_sth = $dbh->column_info($cat, $schema, $table_name, '%'
+);
foreach $column ( sort { $a->[16] <=> $b->[16] } @{$column_sth->fe
+tchall_arrayref } ) {
my (undef, undef, undef, $col_name, $data_type, $data_type_nam
+e,
$col_size, $buffer_len, $decimals, undef, $nullable, $rema
+rks,
$default, $sql_data_type, $sql_data_subtype, $col_char_siz
+e, $order,
undef, undef, undef,undef,undef,undef,undef,undef,undef,un
+def,undef,
undef,undef,undef,undef,undef,undef,undef,undef,$max_card,
+$dtd_ident,undef
) = @{$column};
push(@{$table{$table_name}{cols}}, {
name => $col_name,
remark => $remark || $dtd_ident,
type => $dtd_ident,
});
}
}
foreach $table (keys %table) {
print div();
print "# $table{$table}{remarks}\n" if $table{$table}{remarks};
print 'package '.$table{$table}{camel_name}.";\n";
print div();
print "use base '$basename';\n\n";
print $table{$table}{camel_name}."->table( '$table' );\n";
print $table{$table}{camel_name}."->columns(\n\tAll => qw/\n\t\t".
+ join("\n\t\t", map{$_->{name}}@{$table{$table}{cols}}) . "\n\t/)\n);
+\n";
print "die('You forgot to check the definition for the '$table' ta
+ble. Or you forgot to remove this message!');\n";
# Check all columns for foreign key looking fields. eg ${tablename
+}_id
my $has_a = 0;
foreach my $col ( @{$table{$table}{cols}} ) {
if ($col->{name}=~/^(.+)_id$/) {
my $rel_col = $1;
my $class =
($table{$rel_col}) ? $table{$rel_col}{camel_name}
+ :
($table{PL($rel_col)}) ? $table{PL($rel_col)}{camel_na
+me} : '';
next unless $class;
print $table{$table}{camel_name}."->has_a( ".$col->{name}.
+" => '$class' );\n";
} elsif ($col->{type} =~ /int\(1[01]\)/ and $col->{name} =~ /(
+start|end|expir|received|delivered|quarantined)/) {
print $table{$table}{camel_name}."->has_a(\n";
print "\t$col->{name} => 'DateTime',\n";
print "\tinflate => sub { DateTime->from_epoch( shift ) },
+\n";
print "\tdeflate => 'epoch'\n";
print ");\n";
} elsif ($col->{type} =~ /(date|time)/) {
print $table{$table}{camel_name}."->has_a(\n";
print "\t$col->{name} => 'DateTime',\n";
print "\tinflate => sub { DateTime::Format::ISO8601->parse
+_datetime( shift ) },\n";
print qq|\tdeflate => "strftime('%H:%M:%S')"\n|;
print ");\n";
}
$has_a++;
}
print "\n" if $has_a;
# Check everywhere else for foreign keys to our table
my $table_singular = SI($table);
my $has_many = 0;
foreach my $tbl ( grep {$_ ne $table} keys %table ) {
foreach my $col ( @{$table{$tbl}{cols}}) {
#print "Looking for ${table_singular}_id : $col->{name}\n"
+;
next unless $col->{name} eq "${table_singular}_id";
print $table{$table}{camel_name}."->has_many( ". CamelCaps
+(PL($tbl)) ." => '$table{$tbl}{camel_name}' );\n";
}
}
print "\n" if $has_many;
print "\n";
}
sub CamelCaps {
my $string = shift;
return join('', map { ucfirst lc $_ } split(/[^a-z]/i,$string));
}
sub div {
return '#' . ('-' x 71) . "\n";
}
sub SI {
# Simple singularifier
my $plural = shift;
$plural =~ s/ces$/x/i and return $plural;
$plural =~ s/ies$/y/i and return $plural;
$plural =~ s/s$//i and return $plural;
return $plural
}
sub PL {
# Simple pluralizer
my $singular = shift;
$singular =~ s/y$/ies/i and return $singular;
$singular =~ s/x$/ces/i and return $singular;
$singular .= 's' unless $singular =~ /s$/;
return $singular
}
|
