view release on metacpan or  search on metacpan

lib/DBIx/OO.pm  view on Meta::CPAN

package DBIx::OO;

use base qw(Class::Data::Inheritable);

use warnings;
use strict;
use Carp ();
use Encode ();

use version; our $VERSION = qv('0.0.9');

use DBI ();
use SQL::Abstract ();

__PACKAGE__->mk_classdata('__dboo_table');
__PACKAGE__->mk_classdata('__dboo_columns');
__PACKAGE__->mk_classdata('__dboo_colgroups');
__PACKAGE__->mk_classdata('__dboo_defaults');
## __PACKAGE__->mk_classdata('__dboo_sql');
__PACKAGE__->mk_classdata('__dboo_sqlabstract');
## __PACKAGE__->mk_classdata('__dboo_relations');

my %INVALID_FIELD_NAMES = ( id      => 1,
                            can     => 1,
                            our     => 1,
                            columns => 1,
                            table   => 1,
                            set     => 1,
                            get     => 1,
                            count   => 1,
                          );

use vars qw( $HAS_WEAKEN );

BEGIN {
    $HAS_WEAKEN = 1;
    eval {
        require Scalar::Util;
        import Scalar::Util qw(weaken);
    };
    if ($@) {
        $HAS_WEAKEN = 0;
    }
}

sub __T { my $c = $_[0]; ref $c || $c; }

=head1 NAME

DBIx::OO - Database to Perl objects abstraction

=head1 SYNOPSIS

    package MyDB;
    use base 'DBIx::OO';

    # We need to overwrite get_dbh since it's an abstract function.
    # The way you connect to the DB is really your job; this function
    # should return the database handle.  The default get_dbh() croaks.

    my $dbh;
    sub get_dbh {
        $dbh = DBI->connect_cached('dbi:mysql:test', 'user', 'passwd')
          if !defined $dbh;
        return $dbh;
    }

    package MyDB::Users;
    use base 'MyDB';

    __PACKAGE__->table('Users');
    __PACKAGE__->columns(P => [ 'id' ],
                         E => [qw/ first_name last_name email /]);
    __PACKAGE__->has_many(pages => 'MyDB::Pages', 'user');

    package MyDB::Pages;
    use base 'MyDB';

    __PACKAGE__->table('Pages');
    __PACKAGE__->columns(P => [ 'id' ],
                         E => [qw/ title content user /]);
    __PACKAGE__->has_a(user => 'MyDB::Users');

    package main;

    my $u = MyDB::Users->create({ id          => 'userid',
                                  first_name  => 'Q',
                                  last_name   => 'W' });

    my $foo = MyDB::Users->retrieve('userid');
    my @p = @{ $foo->fk_pages };
    print "User: ", $foo->first_name, " ", $foo->last_name, " pages:\n";
    foreach (@p) {
        print $_->title, "\n";
    }

    $foo->first_name('John');
    $foo->last_name('Doe');
# or