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