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