view release on metacpan or  search on metacpan

lib/DBIx/ObjectMapper/Mapper.pm  view on Meta::CPAN

        : ( $type eq 'HASHREF' || $type eq 'ARRAYREF' ) ? $param
        : ( $type eq 'ARRAY' ) ? @$param
        :                        undef
    );

    $obj->__mapper__->initialize; # initialized mapper

    for my $name ( keys %relation ) {
        my $mapper = $obj->__mapper__;
        if( ref $relation{$name} eq 'ARRAY' ) {
            $mapper->set_val(
                $name => DBIx::ObjectMapper::Session::Array->new(
                    $name,
                    $mapper,
                    @{$relation{$name}},
                )
            );
        }
        else {
            $mapper->set_val( $name => $relation{$name} );
        }
    }

    return $uow ? $uow->add_storage_object($obj) : $obj;
}

sub find {
    my $self = shift;
    my $where = shift;
    my @where = @$where;
    my $it = $self->select->where(@where)->execute;
    return unless $it;
    return $self->mapping($it->next || undef, @_);
}

sub load_properties {
    my $self = shift;

    my @column;
    for my $prop_name ( $self->attributes->property_names ) {
        my $prop = $self->attributes->property_info($prop_name);
        next unless $prop->type eq 'column' and !$prop->lazy;
        push @column, $prop->{isa};
    }
    return @column;
}

sub select {
    my $self = shift;
    my @column = @_;
    push @column, $self->load_properties unless @column;
    return $self->table->select->column(@column);
}

sub insert {
    my $self = shift;
    my %data = @_;
    return $self->table->insert(%data)->execute;
}

sub update {
    my $self = shift;
    my ( $data, $cond ) = @_;
    return map { $_->execute } $self->table->update($data, $cond);
}

sub delete {
    my $self = shift;
    my @where = @_;
    return map { $_->execute } $self->table->delete(@where);
}

sub get_unique_condition {
    my ( $self, $id ) = @_;

    my @cond = $self->table->cast_condition($id);
    if( my @default_cond = @{$self->default_condition} ) {
        push @cond, @default_cond;
    }
    confess "invalid condition." unless @cond;

    my ( $type, @uniq_cond ) = $self->table->get_unique_condition(\@cond);
    confess "condition is not unique." unless @uniq_cond;
    return $self->create_cache_key($type, @uniq_cond), @cond;
}

sub create_cache_key {
    my ( $self, $cond_type, @cond ) = @_;
    my $key
        = $cond_type
        ? $cond_type . '#'
            . join( '&', map { $_->[0]->name . '=' . $_->[2] } @cond )
        : join( '&', map { $_->[0]->name . '=' . $_->[2] } @cond );

    return md5_hex( $self->mapped_class . '@' . $key );
}

sub primary_cache_key {
    my ( $self, $result ) = @_;

    my @ids;
    for my $key ( @{ $self->table->primary_key } ) {
        push @ids,
            $key . '='
            . ( defined $result->{$key} ? $result->{$key} : 'NULL' );
    }

    return md5_hex( $self->mapped_class . '@' . join( '&', @ids ) );
}

sub unique_cache_keys {
    my ( $self, $result ) = @_;
    my @keys;
    for my $uniq ( @{ $self->table->unique_key } ) {
        my $name = $uniq->[0];
        my $keys = $uniq->[1];
        my @uniq_ids;
        for my $key (@$keys) {
            push @uniq_ids,
                $key . '='
                . ( defined $result->{$key} ? $result->{$key} : 'NULL' );