Class::DBI::ClassGenerator - generate Class::DBI sub-class modules from a

package Class::DBI::ClassGenerator;

use strict;
use warnings;
use DBI;

use File::Spec;

use vars qw($VERSION);

$VERSION = '1.03';

sub create {
    my %params = @_;
    die(__PACKAGE__."::create: no directory specified\n")
        unless($params{directory});
    die(__PACKAGE__."::create: no connect_info specified\n")
        unless($params{connect_info});
    die(__PACKAGE__."::create: no base class specified\n")
        unless($params{base_class});

    mkdir($params{directory});
    die("Couldn't create $params{directory}: $!\n")
        unless(-d $params{directory});

    my $dbh = _get_dbh($params{connect_info});
    my $db_driver = _get_db_driver($params{connect_info});

    # get tables from DB if necessary
    $params{tables} = {
        map {
            $_ => _table_to_class($params{base_class}, $_)
        } $db_driver->_get_tables($dbh)
    } unless(ref($params{tables}));

    # get columns from DB
    $params{tables} = {
        map {
            $_ => {
                classname => $params{tables}->{$_},
                columns   => { $db_driver->_get_columns($dbh, $_) }
            }
        } keys %{$params{tables}}
    };

    my @files_created = ();

    foreach my $table (keys %{$params{tables}}) {
        my $pks = join(' ',
            grep { $params{tables}->{$table}->{columns}->{$_}->{pk} }
            keys %{$params{tables}->{$table}->{columns}}
        );
        my $nonpks = join(' ',
            grep { !$params{tables}->{$table}->{columns}->{$_}->{pk} }
            keys %{$params{tables}->{$table}->{columns}}
        );
        my $classfile = File::Spec->catfile(
            $params{directory},
            split('::', $params{tables}->{$table}->{classname}.'.pm')
        );
        _mkdir($params{directory}, $params{tables}->{$table}->{classname});
        open(my $classfilefh, '>', $classfile) ||
            die("Can't write $classfile: $!\n");
        print $classfilefh "package ".$params{tables}->{$table}->{classname}.";\n";
        print $classfilefh "use base '$params{base_class}';\n\n";
        print $classfilefh "__PACKAGE__->table('$table');\n";
        print $classfilefh "__PACKAGE__->columns(Primary => qw($pks));\n";
        print $classfilefh "__PACKAGE__->columns(Others  => qw($nonpks));\n";
        close($classfilefh);
        # system("cat $classfile");
        push @files_created, $classfile;
    }

    my $basefile = File::Spec->catfile(
        _mkdir($params{directory}, $params{base_class}),
        (split(/::/, $params{base_class}))[-1].'.pm'
    );
    open(my $basefilefh, '>', $basefile) ||
        die("Can't write $basefile: $!\n");
    print $basefilefh "package $params{base_class};\nuse base 'Class::DBI';\n\n";
    print $basefilefh "$params{base_class}->connection('".
        join("', '", @{$params{connect_info}}).
    "');\n\n";
    print $basefilefh "use $_;\n" foreach(
        map {
            $params{tables}->{$_}->{classname}
        } keys %{$params{tables}}
    );
    close($basefilefh);
    push @files_created, $basefile;
    # system("cat $basefile");
    

    return @files_created;
}

# create a directory hierarchy for a class. Takes the base dir and
# class name.  Given, eg, ('lib', 'Foo::Bar::Baz') it will create
# lib/Foo and lib/Foo/Bar.  Returns the name of the last directory
# created.

sub _mkdir {
    my($base, $class) = @_;
    my @components = split(/::/, $class);
    pop @components; # remove last bit - that's a filename
    my $dir = $base;
    while(@components) {
        $dir = File::Spec->catdir($dir, shift(@components));
        mkdir $dir || die("Couldn't create $dir: $!\n");
    }
    return $dir;
}

# given a DSN/username/password arrayref, get a DBH
sub _get_dbh { DBI->connect(@{$_[0]}); }

# given a DSN/username/password arrayref, load and return the C::DBI::CG::DBD::blah
sub _get_db_driver {
    my $dsn = shift;
    my $db_driver = __PACKAGE__.'::DBD::'.
        (split(':', $dsn->[0]))[1];
    eval "use $db_driver";
    die(
        __PACKAGE__.
        ": can't find db-specific code for ".
        $dsn->[0].
        "\n:$@\n"
    ) if($@);
    return $db_driver;
}

# map a table name to a classname. Takes a base class name and a table
# name, returns a classname
sub _table_to_class {
    my($base, $table) = @_;
    $table =~ s/(^|_)(.)/uc($2)/eg;
    join('::', $base, $table);
}

1;