view release on metacpan or  search on metacpan

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

    my $self = shift;
    my $relationship_name = shift;

    my $result_source = $self->result_source;
    my $moniker = $self->moniker;

    TRACE->("[$self] Processing relationship $relationship_name for $moniker");
    my $schema_relationship = $result_source->relationship_info( $relationship_name );
    croak "No such relationship $relationship_name for ", $self->moniker unless $schema_relationship;
    my $model_relationship = DBICx::Modeler::Model::Relationship->new(
        modeler => $self->modeler,
        name => $relationship_name,
        model_source => $self,
        schema_relationship => $schema_relationship
    );
}

sub clone {
    my $self = shift;
    my %override = @_;
    my $clone = (blessed $self)->new(
        clone => 1,
        _relationship_map => { map { $_ => $self->_relationship_map->{$_}->clone } keys %{ $self->_relationship_map } },
        ( map { $_ => $self->$_ } qw/ modeler schema moniker model_class create_refresh / ),
        %override,
    );
    $clone->model_class->_model__meta->specialize_model_source( $clone ) if $override{model_class};
    return $clone;
}

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

    unless ($given->{clone}) {
        my $schema = $self->schema;
        my $moniker = $self->moniker;
        my $result_source = $self->result_source;

        for my $relationship_name ($result_source->relationships) {
            TRACE->( "[$self] Processing relationship $relationship_name for $moniker" );
            my $relationship = $result_source->relationship_info($relationship_name);
            my $model_relationship = DBICx::Modeler::Model::Relationship->new(parent_model_source => $self,
                modeler => $self->modeler, name => $relationship_name, schema_relationship => $relationship);
            $self->_relationship_map->{$relationship_name} = $model_relationship;
        }
        $self->model_class->_model__meta->specialize_model_source( $self );
    }
}

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

    my $rs = $self->schema->resultset( $self->moniker );
    my $storage = $rs->create( $given );
    $storage->discard_changes if $self->create_refresh && $storage->can( 'discard_changes' );
    return $self->inflate( _model__storage => $storage, @_ );
}

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

    my $rs = $self->schema->resultset( $self->moniker );
    my $storage = $rs->update_or_create( $given );
    $storage->discard_changes if $self->create_refresh && $storage->can( 'discard_changes' );
    return $self->inflate( _model__storage => $storage, @_ );
}

sub inflate {
    my $self = shift;
    return $self->_inflate( $self->model_class, @_ );
}

sub _inflate {
    my $self = shift;
    my $model_class = shift;
    my $inflate = @_ > 1 ? { @_ } : $_[0];
    return $model_class->new( %$inflate );
}

sub search {
    my $self = shift;
    my $cond = shift || undef;
    my $attr = shift || {};

    return $self->result_source->resultset->search( $cond, { result_class => $self->model_class, %$attr }, @_ );
}

sub inflate_related {
    my $self = shift;
    my $entity = shift;
    my $relationship_name = shift;
    my $inflate = @_ > 1 ? { @_ } : $_[0];

    my $relationship = $self->relationship( $relationship_name );

    # Don't create if entity doesn't have a relationship
    return undef unless my $storage = $entity->_model__storage->$relationship_name;

    return $self->_inflate( $relationship->model_class, _model__storage => $storage );
}

sub create_related {
    my $self = shift;
    my $entity = shift;
    my $relationship_name = shift;
    my $values = shift;

    my $relationship = $self->relationship( $relationship_name );

    my $storage = $entity->_model__storage->create_related( $relationship_name => $values );
    $storage->discard_changes if $self->create_refresh && $storage->can( 'discard_changes' );

    return $self->_inflate( $relationship->model_class, _model__storage => $storage );
}

sub search_related {
    my $self = shift;
    my $entity = shift;