X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FTable.pm;h=49a9ffe82de1079c151a81fba8668efdac8fa425;hb=8452e496adea0c57b81f413e11b2f5b5b6e62c5c;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..49a9ffe 100644 --- a/lib/DBIx/Class/Table.pm +++ b/lib/DBIx/Class/Table.pm @@ -3,96 +3,45 @@ package DBIx::Class::Table; use strict; use warnings; -use base qw/Class::Data::Inheritable Class::Accessor DBIx::Class::SQL/; - -__PACKAGE__->mk_classdata('_columns' => {}); - -__PACKAGE__->mk_classdata('_primaries' => {}); - -__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); - } - } -} - -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 create { - my ($class, $attrs) = @_; - return $class->new($attrs)->insert; -} - -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; -} - -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; -} - -sub get { - my ($self, $column) = @_; - die "No such column '${column}'" unless $self->_columns->{$column}; - return $self->{_column_data}{$column}; -} - -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 _ident_cond { - my ($class) = @_; - return join(" AND ", map { "$_ = ?" } keys %{$class->_primaries}); -} - -sub _ident_values { - my ($self) = @_; - return (map { $self->{_column_data}{$_} } keys %{$self->_primaries}); -} - -sub _register_columns { - my ($class, @cols) = @_; - my $names = { %{$class->_columns} }; - $names->{$_} ||= {} for @cols; - $class->_columns($names); -} - -sub _mk_column_accessors { - my ($class, @cols) = @_; - $class->mk_accessors(@cols); -} +use DBIx::Class::ResultSet; + +use Carp qw/croak/; + +use base qw/DBIx::Class/; +__PACKAGE__->load_components(qw/ResultSource AccessorGroup/); + +__PACKAGE__->mk_group_accessors('simple' => + qw/_columns _primaries name resultset_class result_class schema/); + +=head1 NAME + +DBIx::Class::Table - Table object + +=head1 SYNOPSIS + +=head1 DESCRIPTION + +Table object that inherits from L + +=head1 METHODS + +=head2 from + +Returns the FROM entry for the table (i.e. the table name) + +=cut + +sub from { shift->name; } 1; + +=head1 AUTHORS + +Matt S. Trout + +=head1 LICENSE + +You may distribute this code under the same terms as Perl itself. + +=cut +