X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FTable.pm;h=42631ded9ac97b3ceac7719394d56b4698d6ae4d;hb=f85f550e1a6edce9b939b32b604bbe85f1650d39;hp=9556eb911a87435ac7ee2c7e2510883658a6e05b;hpb=ea2e61bf5bb7187dc5e56513cd66c272d71d5074;p=dbsrgits%2FDBIx-Class-Historic.git diff --git a/lib/DBIx/Class/Table.pm b/lib/DBIx/Class/Table.pm index 9556eb9..42631de 100644 --- a/lib/DBIx/Class/Table.pm +++ b/lib/DBIx/Class/Table.pm @@ -3,96 +3,190 @@ package DBIx::Class::Table; use strict; use warnings; -use base qw/Class::Data::Inheritable Class::Accessor DBIx::Class::SQL/; +use DBIx::Class::ResultSet; +use Data::Page; -__PACKAGE__->mk_classdata('_columns' => {}); +use base qw/Class::Data::Inheritable/; -__PACKAGE__->mk_classdata('_primaries' => {}); +__PACKAGE__->mk_classdata('_columns' => {}); __PACKAGE__->mk_classdata('_table_name'); -sub new { - my ($class, $attrs) = @_; - $class = ref $class if ref $class; - my $new = bless({ _column_data => { } }, $class); - if ($attrs) { - die "Attrs must be a hashref" unless ref($attrs) eq 'HASH'; - while (my ($k, $v) = each %{$attrs}) { - $new->set_column($k => $v); - } - } +__PACKAGE__->mk_classdata('table_alias'); # FIXME: Doesn't actually do anything yet! + +__PACKAGE__->mk_classdata('_resultset_class' => 'DBIx::Class::ResultSet'); + +sub iterator_class { shift->_resultset_class(@_) } + +=head1 NAME + +DBIx::Class::Table - Basic table methods + +=head1 SYNOPSIS + +=head1 DESCRIPTION + +This class is responsible for defining and doing basic operations on +L objects. + +=head1 METHODS + +=over 4 + +=cut + +sub _register_columns { + my ($class, @cols) = @_; + my $names = { %{$class->_columns} }; + $names->{$_} ||= {} for @cols; + $class->_columns($names); } -sub insert { - my ($self) = @_; - return if $self->{_in_database}; - my $sth = $self->_get_sth('insert', [ keys %{$self->{_column_data}} ], - $self->_table_name, undef); - $sth->execute(values %{$self->{_column_data}}); - $self->{_in_database} = 1; - return $self; +sub _mk_column_accessors { + my ($class, @cols) = @_; + $class->mk_group_accessors('column' => @cols); } -sub create { - my ($class, $attrs) = @_; - return $class->new($attrs)->insert; +=item add_columns + + __PACKAGE__->add_columns(qw/col1 col2 col3/); + +Adds columns to the current package, and creates accessors for them + +=cut + +sub add_columns { + my ($class, @cols) = @_; + $class->_register_columns(@cols); + $class->_mk_column_accessors(@cols); } -sub update { - my ($self) = @_; - die "Not in database" unless $self->{_in_database}; - my @to_update = keys %{$self->{_dirty_columns} || {}}; - my $sth = $self->_get_sth('update', \@to_update, - $self->_table_name, $self->_ident_cond); - $sth->execute( (map { $self->{_column_data}{$_} } @to_update), - $self->_ident_values ); - $self->{_dirty_columns} = {}; - return $self; +=item search_literal + + my @obj = $class->search_literal($literal_where_cond, @bind); + my $cursor = $class->search_literal($literal_where_cond, @bind); + +=cut + +sub search_literal { + my ($class, $cond, @vals) = @_; + $cond =~ s/^\s*WHERE//i; + my $attrs = (ref $vals[$#vals] eq 'HASH' ? { %{ pop(@vals) } } : {}); + $attrs->{bind} = \@vals; + return $class->search(\$cond, $attrs); +} + +=item count_literal + + my $count = $class->count_literal($literal_where_cond); + +=cut + +sub count_literal { + my $class = shift; + return $class->search_literal(@_)->count; } -sub delete { - my ($self) = @_; - my $sth = $self->_get_sth('delete', undef, - $self->_table_name, $self->_ident_cond); - $sth->execute($self->_ident_values); - delete $self->{_in_database}; - return $self; +=item count + + my $count = $class->count({ foo => 3 }); + +=cut + +sub count { + my $class = shift; + return $class->search(@_)->count; } -sub get { - my ($self, $column) = @_; - die "No such column '${column}'" unless $self->_columns->{$column}; - return $self->{_column_data}{$column}; +=item search + + my @obj = $class->search({ foo => 3 }); + my $cursor = $class->search({ foo => 3 }); + +=cut + +sub search { + my $class = shift; + #warn "@_"; + my $attrs = { }; + if (@_ > 1 && ref $_[$#_] eq 'HASH') { + $attrs = { %{ pop(@_) } }; + } + $attrs->{where} = (@_ == 1 || ref $_[0] eq "HASH" ? shift: {@_}); + + my $rs = $class->resultset($attrs); + + return (wantarray ? $rs->all : $rs); } -sub set { - my ($self, $column, $value) = @_; - die "No such column '${column}'" unless $self->_columns->{$column}; - die "set_column called for ${column} without value" if @_ < 3; - $self->{_dirty_columns}{$column} = 1; - return $self->{_column_data}{$column} = $value; +sub resultset { + my $class = shift; + + my $rs_class = $class->_resultset_class; + eval "use $rs_class;"; + my $rs = $rs_class->new($class, @_); } -sub _ident_cond { - my ($class) = @_; - return join(" AND ", map { "$_ = ?" } keys %{$class->_primaries}); +=item search_like + +Identical to search except defaults to 'LIKE' instead of '=' in condition + +=cut + +sub search_like { + my $class = shift; + my $attrs = { }; + if (@_ > 1 && ref $_[$#_] eq 'HASH') { + $attrs = pop(@_); + } + my $query = ref $_[0] eq "HASH" ? { %{shift()} }: {@_}; + $query->{$_} = { 'like' => $query->{$_} } for keys %$query; + return $class->search($query, { %$attrs }); } -sub _ident_values { - my ($self) = @_; - return (map { $self->{_column_data}{$_} } keys %{$self->_primaries}); +sub _select_columns { + return keys %{$_[0]->_columns}; } -sub _register_columns { - my ($class, @cols) = @_; - my $names = { %{$class->_columns} }; - $names->{$_} ||= {} for @cols; - $class->_columns($names); +=item table + + __PACKAGE__->table('tbl_name'); + +=cut + +sub table { + shift->_table_name(@_); } -sub _mk_column_accessors { - my ($class, @cols) = @_; - $class->mk_accessors(@cols); +=item find_or_create + + $class->find_or_create({ key => $val, ... }); + +Searches for a record matching the search condition; if it doesn't find one, +creates one and returns that instead + +=cut + +sub find_or_create { + my $class = shift; + my $hash = ref $_[0] eq "HASH" ? shift: {@_}; + my $exists = $class->find($hash); + return defined($exists) ? $exists : $class->create($hash); } +sub columns { return keys %{shift->_columns}; } + 1; + +=back + +=head1 AUTHORS + +Matt S. Trout + +=head1 LICENSE + +You may distribute this code under the same terms as Perl itself. + +=cut +