lib/DBIx/Class/Table.pm

   1 package DBIx::Class::Table;
   2
   3 use strict;
   4 use warnings;
   5
   6 use base qw/Class::Data::Inheritable Class::Accessor DBIx::Class::SQL/;
   7
   8 __PACKAGE__->mk_classdata('_columns' => {});
   9
  10 __PACKAGE__->mk_classdata('_primaries' => {});
  11
  12 __PACKAGE__->mk_classdata('_table_name');
  13
  14 sub new {
  15   my ($class, $attrs) = @_;
  16   $class = ref $class if ref $class;
  17   my $new = bless({ _column_data => { } }, $class);
  18   if ($attrs) {
  19     die "Attrs must be a hashref" unless ref($attrs) eq 'HASH';
  20     while (my ($k, $v) = each %{$attrs}) {
  21       $new->set_column($k => $v);
  22     }
  23   }
  24 }
  25
  26 sub insert {
  27   my ($self) = @_;
  28   return if $self->{_in_database};
  29   my $sth = $self->_get_sth('insert', [ keys %{$self->{_column_data}} ],
  30                               $self->_table_name, undef);
  31   $sth->execute(values %{$self->{_column_data}});
  32   $self->{_in_database} = 1;
  33   return $self;
  34 }
  35
  36 sub create {
  37   my ($class, $attrs) = @_;
  38   return $class->new($attrs)->insert;
  39 }
  40
  41 sub update {
  42   my ($self) = @_;
  43   die "Not in database" unless $self->{_in_database};
  44   my @to_update = keys %{$self->{_dirty_columns} || {}};
  45   my $sth = $self->_get_sth('update', \@to_update,
  46                               $self->_table_name, $self->_ident_cond);
  47   $sth->execute( (map { $self->{_column_data}{$_} } @to_update),
  48                   $self->_ident_values );
  49   $self->{_dirty_columns} = {};
  50   return $self;
  51 }
  52
  53 sub delete {
  54   my ($self) = @_;
  55   my $sth = $self->_get_sth('delete', undef,
  56                               $self->_table_name, $self->_ident_cond);
  57   $sth->execute($self->_ident_values);
  58   delete $self->{_in_database};
  59   return $self;
  60 }
  61
  62 sub get {
  63   my ($self, $column) = @_;
  64   die "No such column '${column}'" unless $self->_columns->{$column};
  65   return $self->{_column_data}{$column};
  66 }
  67
  68 sub set {
  69   my ($self, $column, $value) = @_;
  70   die "No such column '${column}'" unless $self->_columns->{$column};
  71   die "set_column called for ${column} without value" if @_ < 3;
  72   $self->{_dirty_columns}{$column} = 1;
  73   return $self->{_column_data}{$column} = $value;
  74 }
  75
  76 sub _ident_cond {
  77   my ($class) = @_;
  78   return join(" AND ", map { "$_ = ?" } keys %{$class->_primaries});
  79 }
  80
  81 sub _ident_values {
  82   my ($self) = @_;
  83   return (map { $self->{_column_data}{$_} } keys %{$self->_primaries});
  84 }
  85
  86 sub _register_columns {
  87   my ($class, @cols) = @_;
  88   my $names = { %{$class->_columns} };
  89   $names->{$_} ||= {} for @cols;
  90   $class->_columns($names);
  91 }
  92
  93 sub _mk_column_accessors {
  94   my ($class, @cols) = @_;
  95   $class->mk_accessors(@cols);
  96 }
  97
  98 1;