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