package DBIx::Custom::Model; use strict; use warnings; use base 'Object::Simple'; use Carp 'croak'; # Carp trust relationship push @DBIx::Custom::CARP_NOT, __PACKAGE__; __PACKAGE__->attr( ['dbi', 'table'], columns => sub { [] }, primary_key => sub { [] }, relation => sub { {} } ); our $AUTOLOAD; sub AUTOLOAD { my $self = shift; # Method name my ($package, $mname) = $AUTOLOAD =~ /^([\w\:]+)\:\:(\w+)$/; # Method $self->{_methods} ||= {}; if (my $method = $self->{_methods}->{$mname}) { return $self->$method(@_) } elsif ($self->dbi->can($mname)) { $self->dbi->$mname(@_); } elsif ($self->dbi->dbh->can($mname)) { $self->dbi->dbh->$mname(@_); } else { croak qq/Can't locate object method "$mname" via "$package"/ } } sub column_clause { my $self = shift; my $args = ref $_[0] eq 'HASH' ? $_[0] : {@_}; my $table = $self->table; my $columns = $self->columns; my $add = $args->{add} || []; my $remove = $args->{remove} || []; my %remove = map {$_ => 1} @$remove; my @column; foreach my $column (@$columns) { push @column, "$table.$column as $column" unless $remove{$column}; } foreach my $column (@$add) { push @column, $column; } return join (', ', @column); } sub delete { my $self = shift; $self->dbi->delete(table => $self->table, @_); } sub delete_all { my $self = shift; $self->dbi->delete_all(table => $self->table, @_); } sub delete_at { my $self = shift; return $self->dbi->delete_at( table => $self->table, primary_key => $self->primary_key, @_ ); } sub DESTROY { } sub insert { my $self = shift; $self->dbi->insert(table => $self->table, @_); } sub method { my $self = shift; # Merge my $methods = ref $_[0] eq 'HASH' ? $_[0] : {@_}; $self->{_methods} = {%{$self->{_methods} || {}}, %$methods}; return $self; } sub select { my $self = shift; $self->dbi->select( table => $self->table, relation => $self->relation, @_ ); } sub select_at { my $self = shift; return $self->dbi->select_at( table => $self->table, primary_key => $self->primary_key, relation => $self->relation, @_ ); } sub update { my $self = shift; $self->dbi->update(table => $self->table, @_) } sub update_all { my $self = shift; $self->dbi->update_all(table => $self->table, @_); } sub update_at { my $self = shift; return $self->dbi->update_at( table => $self->table, primary_key => $self->primary_key, @_ ); } 1; =head1 NAME DBIx::Custom::Model - Model (experimental) =head1 SYNOPSIS use DBIx::Custom::Table; my $table = DBIx::Custom::Model->new(table => 'books'); =head1 ATTRIBUTES =head2 C<(experimental) columns> my $columns = $model->columns; $model = $model->columns(['id', 'number']); =head2 C my $dbi = $model->dbi; $model = $model->dbi($dbi); L object. =head2 C my $table = $model->table; $model = $model->table('book'); Table name. =head2 C my $primary_key = $model->primary_key; $model = $model->primary_key(['id', 'number']); Foreign key. This is used by C, C, C. =head1 METHODS L inherits all methods from L, and you can use all methods of the object set to C. and implements the following new ones. =head2 C $table->delete(...); Same as C of L except that you don't have to specify C
option. =head2 C $table->delete_all(...); Same as C of L except that you don't have to specify C
option. =head2 C $table->method( count => sub { my $self = shift; return $self->select(column => 'count(*)', @_) ->fetch_first->[0]; } ); Add method to a L object. =head2 C $table->insert(...); Same as C of L except that you don't have to specify C
option. =head2 C my $table = DBIx::Custom::Table->new; Create a L object. =head2 C
option. =head2 C $table->update(...); Same as C of L except that you don't have to specify C
option. =head2 C $table->update_all(param => \%param); Same as C of L except that you don't have to specify table name.