view release on metacpan or  search on metacpan

lib/DBIx/ObjectMapper/Metadata/Table.pm  view on Meta::CPAN

    my ( $type, @cond );
    if ( List::MoreUtils::all { exists $col{$_} } @{ $self->primary_key } ) {
        $type = undef;
        @cond = map{ $self->c($_) == $col{$_} } @{$self->primary_key};
    }
    else {
        for my $uinfo ( @{ $self->unique_key } ) {
            if ( List::MoreUtils::all { exists $col{$_} } @{ $uinfo->[1] } ) {
                $type = $uinfo->[0];
                @cond = map { $self->c($_) == $col{$_} } @{ $uinfo->[1] };
            }
        }
    }

    return( $type, @cond );
}

sub insert {
    my $self = shift;
    my $query = $self->query_object->insert(
        $self->_insert_query_callback,
        $self->primary_key
    )->into( $self->table_name );
    $query->values(@_) if @_;
    return $query;
}

sub _insert_query_callback {
    my $self = shift;

    return sub {
        my $query = shift;
        my $dbh = shift;
        my $input_val = $query->values;
        return unless ref($input_val) eq 'HASH'; # XXXXX

        my %context = %$input_val;
        for my $c ( @{ $self->columns } ) {
            my $val = $c->to_storage(
                \%context,
                $dbh,
            );
            if( defined $val ) {
                $input_val->{ $c->name } = $val;
            }
            elsif( exists $input_val->{ $c->name } ) {
                delete $input_val->{ $c->name };
            }
        }
    };
}

sub delete {
    my $self = shift;
    my $query = $self->query_object->delete( $self->_delete_query_callback )
        ->table( $self->table_name );
    $query->where(@_) if @_;
    return $query;
}

sub _delete_query_callback { undef } # TODO cascade delete

sub update {
    my $self = shift;
    my ( $data, $cond ) = @_;
    my $query = $self->query_object->update( $self->_update_query_callback )
        ->table( $self->table_name );
    $query->set(%$data) if $data;
    $query->where( @$cond ) if $cond;
    return $query;
}

sub _update_query_callback {
    my $self = shift;

    return sub {
        my $query = shift;
        my $engine = shift;

        my %context = %{$query->set};
        for my $c ( @{ $self->columns } ) {
            my $val = $c->to_storage_on_update(
                \%context,
                $self->engine->dbh,
            );
            $query->set->{ $c->name } = $val if defined $val;
        }
    };
}

=head2 clone

=cut

sub clone {
    my $self = shift;
    my $alias = shift;

    my %data = %$self;
    my $obj = bless \%data, ref $self;

    if( $alias ) {
        $obj->{table_name} = [ $obj->table_name, $alias ];
        my @columns;
        for my $c ( @{$obj->columns} ) {
            my $new_col = $c->clone;
            $new_col->{table} = $alias;
            push @columns, $new_col;
        }
        $obj->{columns} = \@columns;
    }

    return $obj;
}

*as =\&clone;

=head2 is_clone

=cut