Data-Model

 view release on metacpan or  search on metacpan

lib/Data/Model.pm  view on Meta::CPAN

    my($self, $row) = @_;

    my $class = ref($row);
    return unless $class;

    my($klass, $model) = $class =~ /^(.+)::([^:]+)$/;
    return unless (ref($self) || $self) eq $klass;
    return $self->get_schema($model);
}

sub update {
    my $self = shift;
    Carp::croak "The 'update' method can not be performed during a transaction." if $self->{active_transaction};
    my $row  = shift;
    return $self->update_direct($row, @_) unless ref($row) && $row->isa('Data::Model::Row');

    my $schema = $self->_get_schema_by_row($row);
    return unless $schema;
    return unless @{ $schema->{key} } > 0; # not has key

    return unless scalar(%{ $row->get_changed_columns });

lib/Data/Model.pm  view on Meta::CPAN

    return unless $result;

    $row;
}


#  $model->update_direct( model_name => 'key', +{ querys }, +{ update columns } );
#  $model->update_direct( model_name => [qw/ key1 key2 /], +{ querys }, +{ update columns } );
#  $model->update_direct( model_name => +{ querys }, +{ update columns } );
# direct_update get しないで直接 updateする where の組み立ては get/delete と同じ
sub update_direct {
    my $self   = shift;
    Carp::croak "The 'update_direct' method can not be performed during a transaction." if $self->{active_transaction};
    my $model  = shift;

    my $schema = $self->get_schema($model);
    return unless $schema;

    my $query = $self->_get_query_args($schema, @_);
    return unless @{ $query };

lib/Data/Model/Driver.pm  view on Meta::CPAN

    $count;
}

sub _as_sql_hook {}

sub lookup {}
sub lookup_multi {}
sub get {}
sub set {}
sub delete {}
sub update {}
sub replace {}

sub get_multi {}
sub set_multi {}
sub delete_multi {}

sub txn_begin { Carp::croak 'not transaction support' }
sub txn_rollback { Carp::croak 'not transaction support' }
sub txn_commit { Carp::croak 'not transaction support' }
sub txn_end {}

lib/Data/Model/Driver/Cache.pm  view on Meta::CPAN

sub fallback { shift->{fallback} }
sub cache    { shift->{cache} }

sub _as_sql_hook {
    my $self = shift;
    $self->{fallback}->_as_sql_hook(@_);
}

sub add_to_cache            { Carp::croak("NOT IMPLEMENTED") }
sub update_cache            { Carp::croak("NOT IMPLEMENTED") }
sub remove_from_cache       { Carp::croak("NOT IMPLEMENTED") }
sub get_from_cache          { Carp::croak("NOT IMPLEMENTED") }

sub get_multi_from_cache {
    my($self, $keys) = @_;

    my %got;
    while (my($key, $id) = each %{ $keys }) {
        my $obj = $self->get_from_cache($id->[1]) or next;
        $got{$key} = $obj;

lib/Data/Model/Driver/Cache.pm  view on Meta::CPAN

        my $cache_key = $self->cache_key($schema, $key);
        $self->remove_cache($cache_key);
    }
    $self->{fallback}->replace(@_);
}


# delete / update は key を指定した処理を主なターゲットとして
# udate_all / delete_all 的なのとかのkeyが判らない物は、いったんその条件でgetしてから、個別のobjectを処理する
# なので、直接keyを指定しないと、ここの処理のパフォーマンスはキャッシュ無しのがさらに早くなる
sub update {
    my $self = shift;
    my($schema, $old_key, $key, $old_columns, $columns, $changed_columns, %args) = @_;

    if (scalar(@{ $old_key }) == scalar(@{ $schema->key })) {
        my $cache_key = $self->cache_key($schema, $old_key);
        $self->remove_cache($cache_key);
    }

   $self->{fallback}->update(@_);
}

lib/Data/Model/Driver/Cache.pm  view on Meta::CPAN

        while (my $row = $it->()) {
            my $key = $schema->get_key_array_by_hash($row);
            my $cache_key = $self->cache_key($schema, $key);
            $self->remove_cache($cache_key);
        }
        $it_opt->{end}->() if exists $it_opt->{end} && ref($it_opt->{end}) eq 'CODE';
    }
    return 1;
}

sub update_direct {
    my $self = shift;
    my($schema, $key, $query, $columns, %args) = @_;

    if ($key && !$columns && scalar(@{ $key }) == scalar(@{ $schema->key })) {
        my $cache_key = $self->cache_key($schema, $key);
        $self->remove_cache($cache_key);
    } else {
        return unless $self->_delete_cache($schema, $key, $query, %args);
    }
    $self->{fallback}->update_direct(@_);

lib/Data/Model/Driver/DBI.pm  view on Meta::CPAN

        my @ret = $sth->rows;
        undef $sth;
        return @ret;
    } else {
        my $ret = $sth->rows;
        undef $sth;
        return $ret;
    }
}

sub update {
    my($self, $schema, $old_key, $key, $old_columns, $columns, $changed_columns, %args) = @_;

    my $stmt = Data::Model::SQL->new;
    $self->add_key_to_where($stmt, $schema->key, $old_key);

    my $where_sql = $stmt->as_sql_where;
    return unless $where_sql;

    return $self->_update($schema, $changed_columns, $columns, $where_sql, $stmt->bind, $stmt->bind_column);
}

sub update_direct {
    my($self, $schema, $key, $query, $columns, %args) = @_;

    my $index_query = delete $query->{index};
    my $stmt = Data::Model::SQL->new(%{ $query });
    $self->add_key_to_where($stmt, $schema->key, $key) if $key;
    $self->add_index_to_where($schema, $stmt, $index_query) if $index_query;

    my $where_sql = $stmt->as_sql_where;
    return unless $where_sql;

lib/Data/Model/Driver/Memcached.pm  view on Meta::CPAN

package Data::Model::Driver::Memcached;
use strict;
use warnings;
use base 'Data::Model::Driver';

use Carp ();
$Carp::Internal{(__PACKAGE__)}++;

sub memcached { shift->{memcached} }

sub update_direct { Carp::croak("update_direct is NOT IMPLEMENTED") }

sub init {
    my $self = shift;
    if (my $serializer = $self->{serializer}) {
        $serializer = 'Data::Model::Driver::Memcached::Serializer::' . $serializer
            unless $serializer =~ s/^\+//;
        unless ($serializer eq 'Data::Model::Driver::Memcached::Serializer::Default') {
            eval "use $serializer"; ## no critic
            Carp::croak $@;
        }

lib/Data/Model/Driver/Memcached.pm  view on Meta::CPAN

    $data = $self->strip_undefvalue($schema, $data)      if $self->{ignore_undef_value};
    my $map = $schema->options->{column_name_rename};
    $data = $self->column_name_rename($map, $data)       if $map;
    $data = $self->{serializer}->serialize($self, $data) if $self->{serializer};
    my $ret = $self->{memcached}->set( $cache_key, $data );
    return unless $ret;

    $columns;
}

sub update {
    my($self, $schema, $old_key, $key, $old_columns, $columns, $changed_columns, %args) = @_;

    my $old_cache_key = $self->cache_key($schema, $old_key);
    my $new_cache_key = $self->cache_key($schema, $key);
    unless ($old_cache_key eq $new_cache_key) {
        my $ret = $self->delete($schema, $old_key);
        return unless $ret;
    }

    my $data = $columns;

lib/Data/Model/Driver/Memory.pm  view on Meta::CPAN

    my $data = $self->load_data($schema);
    $data->{records}->{$record_id} = +{ %{ $columns } };
}

sub replace {
    my($self, $schema, $key, $columns, %args) = @_;
    $self->delete($schema, $key, +{}, %args);
    $self->set($schema, $key, $columns, %args);
}

sub update {
    my($self, $schema, $old_key, $key, $old_columns, $columns, $changed_columns, %args) = @_;

    # fetch record id
    my $result_id_list = $self->get_record_id_list($schema, $old_key, +{});
    return unless $result_id_list && @{ $result_id_list };
    return if @{ $result_id_list } != 1; # not unique key
    my $id = $result_id_list->[0];

    # reindex
    $self->delete_memory_index($schema, $old_key, $old_columns, $id);

lib/Data/Model/Driver/Memory.pm  view on Meta::CPAN

    # delete data
    my $data = $self->load_data($schema);
    my @rows;
    for my $id ( map { $_->[0] } @{ $results }) {
        my @ret = $code->($data, $id);
        push @rows, @ret if @ret;
    }
    return @rows ? [ @rows ] : undef;
}

sub update_direct {
    my($self, $schema, $key, $query, $columns, %args) = @_;

    $self->_uodate_delete_visitor(
        $schema, $key, $query, 
        sub {
            my($data, $id) = @_;
            $self->delete_memory_index($schema, $key, $data->{records}->{$id}, $id);
            while (my($key, $val) = each %{ $columns }) {
                $data->{records}->{$id}->{$key} = $val;
            }

lib/Data/Model/Row.pm  view on Meta::CPAN

    $columns ||= {};
    bless {
        model         => $model,
        column_values => { %{ $columns } },
        alias_values  => +{},
        changed_cols  => +{},
        original_cols => +{},
    }, $class;
}

sub update {
    my $self = shift;
    $self->{model}->update($self, @_);
}

sub delete {
    my $self = shift;
    $self->{model}->delete($self, @_);
}

sub get_column {

t/lib/Mock/Logic/Simple.pm  view on Meta::CPAN

    $obj->{name} = 'Osawa' if $key->[0] eq 'yappo';
    $obj->{name} = 'Danjou' if $key->[0] eq 'lopnor';
    $obj;
}

sub set_user {
    my($self, $schema, $key, $columns, %args) = @_;
    $columns;
}

sub update_user {}

sub delete_user {
    my($self, $schema, $key, $columns, %args) = @_;
    $key->[0] eq 'ok' ? 1 : 0;
}

install_model barerow => schema {
    driver $logic;
    key 'id';
    columns qw/ id name /;