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 DBIx::Class::SQL/;
   7
   8 __PACKAGE__->mk_classdata('_columns' => {});
   9
  10 __PACKAGE__->mk_classdata('_table_name');
  11
  12 sub new {
  13   my ($class, $attrs) = @_;
  14   $class = ref $class if ref $class;
  15   my $new = bless({ _column_data => { } }, $class);
  16   if ($attrs) {
  17     die "attrs must be a hashref" unless ref($attrs) eq 'HASH';
  18     while (my ($k, $v) = each %{$attrs}) {
  19       $new->store_column($k => $v);
  20     }
  21   }
  22   return $new;
  23 }
  24
  25 sub insert {
  26   my ($self) = @_;
  27   return if $self->{_in_database};
  28   my $sth = $self->_get_sth('insert', [ keys %{$self->{_column_data}} ],
  29                               $self->_table_name, undef);
  30   $sth->execute(values %{$self->{_column_data}});
  31   $self->{_in_database} = 1;
  32   $self->{_dirty_columns} = {};
  33   return $self;
  34 }
  35
  36 sub create {
  37   my ($class, $attrs) = @_;
  38   die "create needs a hashref" unless ref $attrs eq 'HASH';
  39   return $class->new($attrs)->insert;
  40 }
  41
  42 sub update {
  43   my ($self) = @_;
  44   die "Not in database" unless $self->{_in_database};
  45   my @to_update = keys %{$self->{_dirty_columns} || {}};
  46   return -1 unless @to_update;
  47   my $sth = $self->_get_sth('update', \@to_update,
  48                               $self->_table_name, $self->_ident_cond);
  49   my $rows = $sth->execute( (map { $self->{_column_data}{$_} } @to_update),
  50                   $self->_ident_values );
  51   if ($rows == 0) {
  52     die "Can't update $self: row not found";
  53   } elsif ($rows > 1) {
  54     die "Can't update $self: updated more than one row";
  55   }
  56   $self->{_dirty_columns} = {};
  57   return $self;
  58 }
  59
  60 sub delete {
  61   my $self = shift;
  62   if (ref $self) {
  63     my $sth = $self->_get_sth('delete', undef,
  64                                 $self->_table_name, $self->_ident_cond);
  65     $sth->execute($self->_ident_values);
  66     $sth->finish;
  67     delete $self->{_in_database};
  68   } else {
  69     my $attrs = { };
  70     if (@_ > 1 && ref $_[$#_] eq 'HASH') {
  71       $attrs = { %{ pop(@_) } };
  72     }
  73     my $query = (ref $_[0] eq 'HASH' ? $_[0] : {@_});
  74     my ($cond, @param) = $self->_cond_resolve($query, $attrs);
  75     my $sth = $self->_get_sth('delete', undef, $self->_table_name, $cond);
  76     $sth->execute(@param);
  77     $sth->finish;
  78   }
  79   return $self;
  80 }
  81
  82 sub get_column {
  83   my ($self, $column) = @_;
  84   die "Can't fetch data as class method" unless ref $self;
  85   die "No such column '${column}'" unless $self->_columns->{$column};
  86   return $self->{_column_data}{$column} if $self->_columns->{$column};
  87 }
  88
  89 sub set_column {
  90   my $self = shift;
  91   my ($column) = @_;
  92   my $ret = $self->store_column(@_);
  93   $self->{_dirty_columns}{$column} = 1;
  94   return $ret;
  95 }
  96
  97 sub store_column {
  98   my ($self, $column, $value) = @_;
  99   die "No such column '${column}'" unless $self->_columns->{$column};
 100   die "set_column called for ${column} without value" if @_ < 3;
 101   return $self->{_column_data}{$column} = $value;
 102 }
 103
 104 sub _register_columns {
 105   my ($class, @cols) = @_;
 106   my $names = { %{$class->_columns} };
 107   $names->{$_} ||= {} for @cols;
 108   $class->_columns($names);
 109 }
 110
 111 sub _mk_column_accessors {
 112   my ($class, @cols) = @_;
 113   $class->mk_group_accessors('column' => @cols);
 114 }
 115
 116 sub add_columns {
 117   my ($class, @cols) = @_;
 118   $class->_register_columns(@cols);
 119   $class->_mk_column_accessors(@cols);
 120 }
 121
 122 sub retrieve_from_sql {
 123   my ($class, $cond, @vals) = @_;
 124   $cond =~ s/^\s*WHERE//i;
 125   my @cols = $class->_select_columns;
 126   my $sth = $class->_get_sth( 'select', \@cols, $class->_table_name, $cond);
 127   return $class->sth_to_objects($sth, \@vals, \@cols);
 128 }
 129
 130 sub sth_to_objects {
 131   my ($class, $sth, $args, $cols) = @_;
 132   my @cols = ((ref $cols eq 'ARRAY') ? @$cols : @{$sth->{NAME_lc}} );
 133   $sth->execute(@$args);
 134   my @found;
 135   while (my @row = $sth->fetchrow_array) {
 136     my $new = $class->new;
 137     $new->store_column($_, shift @row) for @cols;
 138     $new->{_in_database} = 1;
 139     push(@found, $new);
 140   }
 141   return @found;
 142 }
 143
 144 sub search {
 145   my $class = shift;
 146   my $attrs = { };
 147   if (@_ > 1 && ref $_[$#_] eq 'HASH') {
 148     $attrs = { %{ pop(@_) } };
 149   }
 150   my $query    = ref $_[0] eq "HASH" ? shift: {@_};
 151   my ($cond, @param)  = $class->_cond_resolve($query, $attrs);
 152   return $class->retrieve_from_sql($cond, @param);
 153 }
 154
 155 sub search_like {
 156   my $class    = shift;
 157   my $attrs = { };
 158   if (@_ > 1 && ref $_[$#_] eq 'HASH') {
 159     $attrs = pop(@_);
 160   }
 161   return $class->search(@_, { %$attrs, cmp => 'LIKE' });
 162 }
 163
 164 sub _select_columns {
 165   return keys %{$_[0]->_columns};
 166 }
 167
 168 sub copy {
 169   my ($self, $changes) = @_;
 170   my $new = bless({ _column_data => { %{$self->{_column_data}}} }, ref $self);
 171   $new->set_column($_ => $changes->{$_}) for keys %$changes;
 172   return $new->insert;
 173 }
 174
 175 sub _cond_resolve {
 176   my ($self, $query, $attrs) = @_;
 177   my $op = $attrs->{'cmp'} || '=';
 178   my $cond = join(' AND ',
 179                map { (defined $query->{$_}
 180                        ? "$_ $op ?"
 181                        : (do { delete $query->{$_}; "$_ IS NULL"; }));
 182                    } keys %$query);
 183   return ($cond, values %$query);
 184 }
 185
 186 sub table {
 187   shift->_table_name(@_);
 188 }
 189
 190 1;