... | ... |
@@ -1,5 +1,7 @@ |
1 | 1 |
package DBI::Custom; |
2 | 2 |
use Object::Simple; |
3 |
+use DBI; |
|
4 |
+use SQL::Abstract; |
|
3 | 5 |
|
4 | 6 |
sub new { |
5 | 7 |
my $self = shift->Object::Simple::new(@_); |
... | ... |
@@ -22,6 +24,8 @@ sub initialize_model { |
22 | 24 |
# Class attribute |
23 | 25 |
sub connect_info : Attr { type => 'hash' } |
24 | 26 |
sub table_infos : Attr { type => 'hash' } |
27 |
+sub dbh : Attr {} |
|
28 |
+sub sql_abstract : Attr { auto_build => sub { shift->sql_abstract(SQL::Abstract->new) }} |
|
25 | 29 |
|
26 | 30 |
sub column_info { |
27 | 31 |
my ($self, $table, $column_name, $column_info) = @_; |
... | ... |
@@ -70,18 +74,122 @@ sub create_table { |
70 | 74 |
} |
71 | 75 |
} |
72 | 76 |
|
77 |
+sub load_table_definitions { |
|
78 |
+ my $self = shift; |
|
79 |
+ my $dsn = $self->connect_info->{dsn}; |
|
80 |
+} |
|
73 | 81 |
|
82 |
+sub connect { |
|
83 |
+ my $self = shift; |
|
84 |
+ my $connect_info = $self->connect_info; |
|
85 |
+ |
|
86 |
+ my $dbh = DBI->connect( |
|
87 |
+ $connect_info->{dsn}, |
|
88 |
+ $connect_info->{user}, |
|
89 |
+ $connect_info->{password}, |
|
90 |
+ { |
|
91 |
+ RaiseError => 1, |
|
92 |
+ PrintError => 0, |
|
93 |
+ AutoCommit => 1, |
|
94 |
+ %{$connect_info->{options} || {} } |
|
95 |
+ } |
|
96 |
+ ); |
|
97 |
+ |
|
98 |
+ $self->dbh($dbh); |
|
99 |
+} |
|
74 | 100 |
|
101 |
+sub reconnect { |
|
102 |
+ my $self = shift; |
|
103 |
+ $self->dbh(undef); |
|
104 |
+ $self->connect; |
|
105 |
+} |
|
75 | 106 |
|
107 |
+sub query { |
|
108 |
+ my ($self, $query, @binds) = @_; |
|
109 |
+ $self->{success} = 0; |
|
110 |
+ |
|
111 |
+ $self->_replace_omniholder(\$query, \@binds); |
|
112 |
+ |
|
113 |
+ my $st; |
|
114 |
+ my $sth; |
|
115 |
+ |
|
116 |
+ my $old = $old_statements{$self}; |
|
117 |
+ |
|
118 |
+ if (my $i = (grep $old->[$_][0] eq $query, 0..$#$old)[0]) { |
|
119 |
+ $st = splice(@$old, $i, 1)->[1]; |
|
120 |
+ $sth = $st->{sth}; |
|
121 |
+ } else { |
|
122 |
+ eval { $sth = $self->{dbh}->prepare($query) } or do { |
|
123 |
+ if ($@) { |
|
124 |
+ $@ =~ s/ at \S+ line \d+\.\n\z//; |
|
125 |
+ Carp::croak($@); |
|
126 |
+ } |
|
127 |
+ $self->{reason} = "Prepare failed ($DBI::errstr)"; |
|
128 |
+ return _dummy; |
|
129 |
+ }; |
|
130 |
+ |
|
131 |
+ # $self is quoted on purpose, to pass along the stringified version, |
|
132 |
+ # and avoid increasing reference count. |
|
133 |
+ $st = bless { |
|
134 |
+ db => "$self", |
|
135 |
+ sth => $sth, |
|
136 |
+ query => $query |
|
137 |
+ }, 'DBIx::Simple::Statement'; |
|
138 |
+ $statements{$self}{$st} = $st; |
|
139 |
+ } |
|
76 | 140 |
|
141 |
+ eval { $sth->execute(@binds) } or do { |
|
142 |
+ if ($@) { |
|
143 |
+ $@ =~ s/ at \S+ line \d+\.\n\z//; |
|
144 |
+ Carp::croak($@); |
|
145 |
+ } |
|
77 | 146 |
|
78 |
-sub insert { |
|
79 |
- my $self = shift; |
|
80 |
- |
|
147 |
+ $self->{reason} = "Execute failed ($DBI::errstr)"; |
|
148 |
+ return _dummy; |
|
149 |
+ }; |
|
150 |
+ |
|
151 |
+ $self->{success} = 1; |
|
152 |
+ |
|
153 |
+ return bless { st => $st, lc_columns => $self->{lc_columns} }, $self->{result_class}; |
|
154 |
+} |
|
155 |
+ |
|
156 |
+sub query { |
|
157 |
+ my ($self, $sql) = @_; |
|
158 |
+ my $sth = $self->dbh->prepare($sql); |
|
159 |
+ $sth->execute(@bind); |
|
160 |
+} |
|
161 |
+ |
|
162 |
+sub select { |
|
163 |
+ my ($table, $column_names, $where, $order) = @_; |
|
81 | 164 |
|
165 |
+ my ($stmt, @bind) = $self->sql_abstract->select($table, $column_names, $where, $order); |
|
166 |
+ my $sth = $self->dbh->prepare($stmt); |
|
167 |
+ $sth->execute(@bind); |
|
168 |
+} |
|
169 |
+ |
|
170 |
+sub insert { |
|
171 |
+ my ($self, $table, $values) = @_; |
|
82 | 172 |
|
173 |
+ my ($stmt, @bind) = $self->sql_abstract->insert($table, $values); |
|
174 |
+ my $sth = $self->dbh->prepare($stmt); |
|
175 |
+ $sth->execute(@bind); |
|
176 |
+} |
|
177 |
+ |
|
178 |
+sub update { |
|
179 |
+ my ($self, $values, $where) = @_; |
|
180 |
+ my ($stmt, @bind) = $self->sql_abstract->update($table, $values, $where); |
|
181 |
+ my $sth = $self->dbh->prepare($stmt); |
|
182 |
+ $sth->execute(@bind); |
|
83 | 183 |
} |
84 | 184 |
|
185 |
+sub delete { |
|
186 |
+ my ($self, $where) = @_; |
|
187 |
+ my ($stmt, @bind) = $self->sql_abstract->delete($table, $where); |
|
188 |
+ my $sth = $self->dbh->prepare($stmt); |
|
189 |
+ $sth->execute(@bind); |
|
190 |
+} |
|
191 |
+ |
|
192 |
+ |
|
85 | 193 |
|
86 | 194 |
Object::Simple->build_class; |
87 | 195 |
|