root/lang/perl/Data-Model/trunk/lib/Data/Model/Driver/DBI.pm @ 23747

Revision 23747, 6.7 kB (checked in by yappo, 5 years ago)

index を使った delete が出来るようになった

Line 
1package Data::Model::Driver::DBI;
2use strict;
3use warnings;
4use base 'Data::Model::Driver';
5
6use Carp ();
7use DBI;
8use Data::Dumper;
9
10use Data::Model::SQL;
11use Data::Model::Driver::DBI::DBD;
12
13sub dsn { shift->{dsn} }
14sub dbh { shift->{dbh} }
15sub dbd { shift->{dbd} }
16sub username { shift->{username} }
17sub password { shift->{password} }
18sub connect_options { shift->{connect_options} }
19
20sub init {
21    my $self = shift;
22    if (my($type) = $self->{dsn} =~ /^dbi:(\w*)/i) {
23        $self->{dbd} = Data::Model::Driver::DBI::DBD->new($type);
24    }
25    $self->{dsn} = +{
26        rw => $self->{dsn},
27    };
28}
29
30sub init_db {
31    my($self, $name) = @_;
32    my $dbh = DBI->connect(
33        $self->dsn->{$name}, $self->username, $self->password,
34        { RaiseError => 1, PrintError => 0, AutoCommit => 1, %{ $self->connect_options || {} } },
35    ) or Carp::croak("Connection error: " . $DBI::errstr);
36    $self->{__dbh_init_by_driver} = 1;
37    $dbh;
38}
39
40sub rw_handle {
41    my $self = shift;
42    $self->{dbh} = undef if $self->{dbh} and !$self->{dbh}->ping;
43    unless ($self->{dbh}) {
44        if (my $getter = $self->{get_dbh}) {
45            $self->{dbh} = $getter->();
46        } else {
47            $self->{dbh} = $self->init_db('rw') or die $self->last_error;
48        }
49    }
50    $self->{dbh};
51}
52sub r_handle { shift->rw_handle(@_) }
53
54sub last_error {}
55
56sub add_key_to_where {
57    my($self, $stmt, $columns, $key) = @_;
58    if ($key) {
59        # add where
60        my $i = 0;
61        for my $i (0..( scalar(@{ $key }) - 1 )) {
62            $stmt->add_where( $columns->[$i] => $key->[$i] );
63        }
64    }
65}
66
67sub add_index_to_where {
68    my($self, $schema, $stmt, $index_obj) = @_;
69    return unless my($index, $index_key) = (%{ $index_obj });
70    $index_key = [ $index_key ] unless ref($index_key) eq 'ARRAY';
71    for my $index_type (qw/ unique index /) {
72        if (exists $schema->{$index_type}->{$index}) {
73            $self->add_key_to_where($stmt, $schema->{$index_type}->{$index}, $index_key);
74            last;
75        }
76    }
77}
78
79sub fetch {
80    my($self, $rec, $schema, $key, $columns, %args) = @_;
81
82    $columns = +{} unless $columns;
83
84    $columns->{select} ||= [
85        keys %{ $schema->{column} },
86    ];
87
88    $columns->{from} ||= [];
89    unshift @{ $columns->{from} }, $schema->{model};
90
91    my $index_query = delete $columns->{index};
92    my $stmt = Data::Model::SQL->new(%{ $columns });
93    $self->add_key_to_where($stmt, $schema->{key}, $key) if $key;
94    $self->add_index_to_where($schema, $stmt, $index_query) if $index_query;
95    my $sql = $stmt->as_sql;
96
97    my @bind;
98    my $map = $stmt->select_map;
99    for my $col (@{ $stmt->select }) {
100        push @bind, \$rec->{ exists $map->{$col} ? $map->{$col} : $col };
101    }
102
103    my $dbh = $self->r_handle;
104    $self->start_query($sql, $stmt->bind);
105    my $sth = $args{no_cached_prepare} ? $dbh->prepare($sql) : $dbh->prepare_cached($sql);
106    $sth->execute(@{ $stmt->bind });
107    $sth->bind_columns(undef, @bind);
108
109    $sth;
110}
111
112
113sub get {
114    my($self, $schema, $key, $columns, %args) = @_;
115
116    my $rec = +{};
117    my $sth = $self->fetch($rec, $schema, $key, $columns, %args);
118
119    my $i = 0;
120    my $iterator = sub {
121        return $rec if $i++ eq 1;
122        unless ($sth->fetch) {
123            $sth->finish;
124            $self->end_query($sth);
125            return;
126        }
127        $rec;
128    };
129
130    # pre load
131    return unless $iterator->();
132    return $iterator, +{
133        end => sub { $sth->finish; $self->end_query($sth) },
134    };
135}
136
137# insert or replace
138sub set {
139    my $self = shift;
140    $self->_insert_or_replace(0, @_);
141}
142
143sub replace {
144    my($self, $schema, $key, $columns, %args) = @_;
145    if ($self->dbd->can_replace) {
146        return $self->_insert_or_replace(1, $schema, $key, $columns, %args);
147    } else {
148#        $self->thx(sub {
149        $self->delete($schema, $key, +{}, %args);
150        return $self->set($schema, $key, $columns, %args);
151#        });
152    }
153}
154
155sub _insert_or_replace {
156    my($self, $is_replace, $schema, $key, $columns, %args) = @_;
157    my $select_or_replace = $is_replace ? 'REPLACE' : 'INSERT';
158
159    my $table = $schema->{model};
160    my $cols = [ keys %{ $columns } ];
161    my $sql = "$select_or_replace INTO $table\n";
162    $sql .= '(' . join(', ', @{ $cols }) . ')' . "\n" .
163            'VALUES (' . join(', ', ('?') x @{ $cols }) . ')' . "\n";
164
165    my $dbh = $self->rw_handle;
166    $self->start_query($sql, $columns);
167    my $sth = $dbh->prepare_cached($sql);
168    my $i = 1;
169    while (my($col, $val) = each %{ $columns }) {
170        my $type = $schema->{columns}->{$col}->{type} || 'char';
171        my $attr = $self->dbd->bind_param_attributes($type, $columns, $col);
172        $sth->bind_param($i++, $val, $attr);
173    }
174    $sth->execute;
175    $sth->finish;
176    $self->end_query($sth);
177
178    # set autoincrement key
179    if (my @keys = @{ $schema->{key} }) {
180        for my $column (@keys) {
181            if (exists $schema->{column}->{$column}->{options}->{auto_increment} &&
182                    $schema->{column}->{$column}->{options}->{auto_increment}) {
183                $columns->{$column} = $self->dbd->fetch_last_id( $schema, $columns, $dbh, $sth );
184            }
185        }
186    }
187
188    $columns;
189}
190
191# update
192sub update {
193    my($self, $schema, $old_key, $key, $old_columns, $columns, $changed_columns, %args) = @_;
194
195    my $stmt = Data::Model::SQL->new;
196    $self->add_key_to_where($stmt, $schema->{key}, $old_key);
197
198    my $where_sql = $stmt->as_sql_where;
199    return unless $where_sql;
200
201    my @bind;
202    my @set;
203    for my $column (keys %{ $changed_columns }) {
204        push @set, "$column = ?";
205        push @bind, $columns->{$column};
206    }
207    push @bind, @{ $stmt->bind };
208
209    my $sql = 'UPDATE ' . $schema->{model} . ' SET ' . join(', ', @set) . ' ' . $where_sql;
210    my $dbh = $self->rw_handle;
211    $self->start_query($sql, \@bind);
212    my $sth = $dbh->prepare_cached($sql);
213    $sth->execute(@bind);
214    $sth->finish;
215    $self->end_query($sth);
216
217    return $sth->rows;
218}
219
220# delete
221sub delete {
222    my($self, $schema, $key, $columns, %args) = @_;
223
224    $columns->{from} = [ $schema->{model} ];
225    my $index_query = delete $columns->{index};
226    my $stmt = Data::Model::SQL->new(%{ $columns });
227    $self->add_key_to_where($stmt, $schema->{key}, $key) if $key;
228    $self->add_index_to_where($schema, $stmt, $index_query) if $index_query;
229
230    my $sql = "DELETE " . $stmt->as_sql;
231    my $dbh = $self->rw_handle;
232    $self->start_query($sql, $stmt->bind);
233    my $sth = $dbh->prepare_cached($sql);
234    $sth->execute(@{ $stmt->bind });
235    $sth->finish;
236    $self->end_query($sth);
237
238    return $sth->rows;
239}
240
241
242# profile
243sub start_query {}
244sub end_query {}
245
246sub DESTROY {
247    my $self = shift;
248    return unless $self->{__dbh_init_by_driver};
249
250#    if (my $dbh = $self->dbh) {
251#        $dbh->disconnect if $dbh;
252#    }
253}
254
255
2561;
Note: See TracBrowser for help on using the browser.