File Coverage

blib/lib/DBomb.pm

Criterion	Covered	Total	%
statement	21	21	100.0
branch			n/a
condition			n/a
subroutine	7	7	100.0
pod			n/a
total	28	28	100.0

package DBomb;

=head1 NAME

DBomb - Database Object Mapping

=cut

use strict;
use warnings;
use DBomb::Util qw(is_same_value);
use DBomb::Query;
use Carp::Assert;
use Carp qw(cluck);
use base qw(DBomb::DBH::Owner);
use base qw(Exporter);

our $VERSION = '$Revision: 1.26 $';

our %EXPORT_TAGS = ( 'all' => [qw( PlaceHolder ) ]);
Exporter::export_ok_tags('all');
sub PlaceHolder { DBomb::Query::PlaceHolder() }



__PACKAGE__->mk_classdata('tables');
__PACKAGE__->mk_classdata('databases');
__PACKAGE__->mk_classdata('one_to_manys');
__PACKAGE__->mk_classdata('todo_after_resolve');
__PACKAGE__->mk_classdata('did_resolve');

__PACKAGE__->tables(+{}); ## table_name -> table_info
__PACKAGE__->databases(+{}); ## TODO
__PACKAGE__->one_to_manys([]); ## List of OneToMany objects
__PACKAGE__->todo_after_resolve([]); ## [ [ CODEREF, $args_list, caller] , ... ]


## eval { DBomb->resolve };
sub resolve
{
    my $class = shift;

    if (defined $class->did_resolve){
        my ($package, $filename, $line, $subroutine) = @{$class->did_resolve};
        cluck("DBomb::resolve was already called. The first time was from $package\:\:$subroutine at $filename line $line ");
    }
    $class->did_resolve([caller(1)]);

    for(values %{$class->tables}){
        $_->resolve;
    }

    for (@{$class->todo_after_resolve}){
        my ($coderef, $args, $caller_info) = @$_;
        eval {
            $coderef->(@$args);
        };
        if ($@) {
            ## The coderef failed.
            my ($package, $filename, $line, $subroutine) = map{defined($_)?$_:''} @$caller_info;
            die("$filename\:$line in $package\:\:$subroutine\:  $@\n");
        }
    }
}

## returns a table_info object or undef
## $class->resolve_table_name($database,$tname)
sub resolve_table_name
{
##TODO: database not used
    my ($class,$database,$table_name) = @_;
        assert(@_ == 3, 'parameter count');
        assert(UNIVERSAL::isa($class,__PACKAGE__));
        assert(defined($table_name), "resolve_table_info requires a table name");
    return $table_name if UNIVERSAL::isa($table_name,'DBomb::Meta::TableInfo');
    return $class->tables->{$table_name} if exists $class->tables->{$table_name};

    ## Ok, it's not a table name. maybe it is a package name.

    for (values %{$class->tables}){
        next unless UNIVERSAL::isa($_,'DBomb::TableInfo');

        ## TODO: compare database name too.
        return $_ if is_same_value($_->class, $table_name);
    }

    undef; ## not found
}

## push code to be run after resolve. caller information is for error handling
## do_after_resolve(sub{...}, $args, [caller])
sub do_after_resolve
{
    my ($class,$coderef,$args, $caller) = @_;
        assert(UNIVERSAL::isa($coderef,'CODE'), 'do_after_resolve requires a coderef');
        assert(UNIVERSAL::isa($args,'ARRAY'), 'do_after_resolve requires an args listref');
        assert(UNIVERSAL::isa($caller,'ARRAY'), 'do_after_resolve requires a caller listref');
        assert(@$caller >= 4, 'do_after_resolve requires a valid caller list.');

    push @{$class->todo_after_resolve}, [ $coderef, $args, $caller];
}

1;
__END__