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 | } |
8fe001e1 |
22 | return $new; |
ea2e61bf |
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; |
8fe001e1 |
32 | $self->{_dirty_columns} = {}; |
ea2e61bf |
33 | return $self; |
34 | } |
35 | |
36 | sub create { |
37 | my ($class, $attrs) = @_; |
8fe001e1 |
38 | die "create needs a hashref" unless ref $attrs eq 'HASH'; |
ea2e61bf |
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 | my $sth = $self->_get_sth('update', \@to_update, |
47 | $self->_table_name, $self->_ident_cond); |
48 | $sth->execute( (map { $self->{_column_data}{$_} } @to_update), |
49 | $self->_ident_values ); |
50 | $self->{_dirty_columns} = {}; |
51 | return $self; |
52 | } |
53 | |
54 | sub delete { |
55 | my ($self) = @_; |
56 | my $sth = $self->_get_sth('delete', undef, |
57 | $self->_table_name, $self->_ident_cond); |
58 | $sth->execute($self->_ident_values); |
59 | delete $self->{_in_database}; |
60 | return $self; |
61 | } |
62 | |
63 | sub get { |
64 | my ($self, $column) = @_; |
8fe001e1 |
65 | die "Can't fetch data as class method" unless ref $self; |
ea2e61bf |
66 | die "No such column '${column}'" unless $self->_columns->{$column}; |
67 | return $self->{_column_data}{$column}; |
68 | } |
69 | |
70 | sub set { |
71 | my ($self, $column, $value) = @_; |
72 | die "No such column '${column}'" unless $self->_columns->{$column}; |
73 | die "set_column called for ${column} without value" if @_ < 3; |
74 | $self->{_dirty_columns}{$column} = 1; |
75 | return $self->{_column_data}{$column} = $value; |
76 | } |
77 | |
ea2e61bf |
78 | sub _register_columns { |
79 | my ($class, @cols) = @_; |
80 | my $names = { %{$class->_columns} }; |
81 | $names->{$_} ||= {} for @cols; |
82 | $class->_columns($names); |
83 | } |
84 | |
85 | sub _mk_column_accessors { |
86 | my ($class, @cols) = @_; |
87 | $class->mk_accessors(@cols); |
88 | } |
89 | |
8fe001e1 |
90 | sub set_columns { |
91 | my ($class, @cols) = @_; |
92 | $class->_register_columns(@cols); |
93 | $class->_mk_column_accessors(@cols); |
94 | } |
95 | |
96 | sub retrieve_from_sql { |
97 | my ($class, $cond, @vals) = @_; |
98 | $cond =~ s/^\s*WHERE//; |
99 | my @cols = $class->_select_columns; |
100 | my $sth = $class->_get_sth( 'select', \@cols, $class->_table_name, $cond); |
101 | $sth->execute(@vals); |
102 | my @found; |
103 | while (my @row = $sth->fetchrow_array) { |
104 | my $new = $class->new; |
105 | $new->set($_, shift @row) for @cols; |
106 | $new->{_in_database} = 1; |
107 | push(@found, $new); |
108 | } |
109 | return @found; |
110 | } |
111 | |
112 | sub search { |
113 | my $class = shift; |
114 | my $where = ref $_[0] eq "HASH" ? shift: {@_}; |
115 | my $cond = join(' AND ', map { "$_ = ?" } keys %$where); |
116 | return $class->retrieve_from_sql($cond, values %$where); |
117 | } |
118 | |
119 | sub _select_columns { |
120 | return keys %{$_[0]->_columns}; |
121 | } |
122 | |
123 | sub copy { |
124 | my ($self, $changes) = @_; |
125 | my $new = bless({ _column_data => { %{$self->{_column_data}}} }, ref $self); |
126 | $new->set($_ => $changes->{$_}) for keys %$changes; |
127 | return $new; |
128 | } |
129 | |
ea2e61bf |
130 | 1; |