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 | |
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; |