view release on metacpan or  search on metacpan

lib/DBICx/Modeler.pm  view on Meta::CPAN

=head1 METHODS

DBICx::Modeler->new( ... )

    schema          The connected DBIx::Class schema to use/inspect

    namespace       The package containing the Moose classes that will mimic the class structure of <schema>

$modeler->model( <moniker> )

    Return the model source for <moniker>

$modeler->create( <moniker> => ... )

    Create a new row for <moniker> and return the modeled object

$modeler->search( <moniker> => ... )

    Make a search of <moniker> that will inflate into modeled objects

=cut

use Moose;

use DBICx::Modeler::Carp;
use constant TRACE => DBICx::Modeler::Carp::TRACE;

use Class::Inspector();
use Scalar::Util qw/weaken/;

use DBICx::Modeler::Model::Source;

#########
# Class #
#########

sub ensure_class_loaded {
    shift;
    my $class = shift;
    return $class if Class::Inspector->loaded( $class );
    eval "require $class;";
    die "Couldn't load class $class: $@" if $@;
    return $class;
}

sub _expand_relative_name {
    my ($self, $name) = @_;
    my $class = ref $self || $self;

    return unless $name;

    my $parent_class = $class;

    if ($name =~ s/^\+//) {
        # Hammatime: Don't touch this!
    }
    else {
        if ($name =~ s/^\-//) {
            # User wants the parent (wants to be a sibling)
            my @class = split m/::/, $parent_class;
            pop @class;
            $parent_class = join '::', @class;
        }
        $name = $parent_class . '::' . $name;
    }
    return $name;
}

###########
# Object ##
###########

has schema => qw/is ro required 1/;
has schema_class => qw/is ro lazy_build 1/;

has [qw/
    namespace
    skip_moniker
/] => qw/is rw/;

has [qw/
    create_refresh
    sibling_namespace
/] => qw/is rw default 1/;

has skip_schema_modeler_accessor => qw/is rw default 0/;
has [qw/ _model_source_list /] => qw/is ro required 1 lazy 1 isa ArrayRef/, default => sub { [] };
has [qw/ _namespace_list /] => qw/is ro lazy_build 1 isa ArrayRef/;
sub _build__namespace_list {
    my $self = shift;
    my $class = ref $self || $self;

    my $default_namespace = do {
        my @default = split m/::/, $class;
        if ( my $name = $self->sibling_namespace ) {
            $name = "Model" if $name eq 1;
            pop @default; # Use Example::${name} instead of Example::Modeler::${name} (e.g. Example::Model)
            push @default, $name;
        }
        "+" . join "::", @default;
    };

    my $namespace = $self->namespace;
    $namespace = [] unless defined $namespace;
    $namespace = [ $namespace ] unless ref $namespace eq "ARRAY";
    unless (@$namespace) {
        croak "You didn't specify a namespace" if $class eq __PACKAGE__;
        @$namespace = ("?"); # Use the default namespace if none specified
    }
    @$namespace = map { $_ eq "?" ? $default_namespace : $_ } @$namespace;

    $_ = $self->_expand_relative_name( $_ ) for @$namespace;

    return [ @$namespace ];
}
has [qw/
    _model_source_lookup_map
    _model_class_by_moniker_map
    _moniker_by_model_class_map
/] => qw/is ro required 1 lazy 1 isa HashRef/, default => sub { {} };

sub _build_schema_class {
    my $self = shift;
    return ref $self->schema;
}

sub BUILD {
    my $self = shift;
    my $given = shift;

    $self->skip_moniker( $given->{skip} ) if ! exists $given->{skip_moniker} && $given->{skip};

    my $schema = $self->schema;
    my $schema_class = $self->schema_class;

    $self->_setup_schema_modeler_accessor unless $self->skip_schema_modeler_accessor;
    $self->_setup_base_model_sources;
    {
        $self->schema->modeler( $self );
        weaken $self->schema->{modeler};
    }

    return 1;
}

sub _setup_schema_modeler_accessor {
    my $self = shift;
    return if $self->schema_class->can( qw/modeler/ );
    $self->schema_class->mk_group_accessors( simple => qw/modeler/ );
}

sub _setup_base_model_sources {
    my $self = shift;
    my %option = @_;