DBIx-Custom / lib / DBI / Custom.pm /
Newer Older
297 lines | 6.26kb
first commit
yuki-kimoto authored on 2009-10-13
1
package DBI::Custom;
2
use Object::Simple;
add some method
yuki-kimoto authored on 2009-10-14
3
use DBI;
4
use SQL::Abstract;
first commit
yuki-kimoto authored on 2009-10-13
5

            
cleanup
yuki-kimoto authored on 2009-10-14
6
sub new {
7
    my $self = shift->Object::Simple::new(@_);
8
    my $class = ref $self;
9
    return bless {%{$class->model}, %{$self}}, $class;
first commit
yuki-kimoto authored on 2009-10-13
10
}
11

            
cleanup
yuki-kimoto authored on 2009-10-14
12
sub create_model {shift->Object::Simple::new(@_);
first commit
yuki-kimoto authored on 2009-10-13
13

            
cleanup
yuki-kimoto authored on 2009-10-14
14
sub initialize_model {
15
    my ($class, $callback) = @_;
16
    
17
    my $model = $class->create_model;
18
    
19
    $callback->($model);
20
    
21
    $class->model($model);
first commit
yuki-kimoto authored on 2009-10-13
22
}
23

            
24
# Class attribute
cleanup
yuki-kimoto authored on 2009-10-14
25
sub connect_info : Attr { type => 'hash' }
26
sub table_infos  : Attr { type => 'hash' }
add some method
yuki-kimoto authored on 2009-10-14
27
sub dbh          : Attr {}
28
sub sql_abstract : Attr { auto_build => sub { shift->sql_abstract(SQL::Abstract->new) }}
first commit
yuki-kimoto authored on 2009-10-13
29

            
30
sub column_info {
cleanup
yuki-kimoto authored on 2009-10-14
31
    my ($self, $table, $column_name, $column_info) = @_;
32
    
33
    if (@_ > 3) {
34
        $self->table_infos->{$table}{column}{$column_name} = $column_info;
35
        return $self;
36
    }
37
    return $self->table_infos->{$table}{column}{$column_name};
first commit
yuki-kimoto authored on 2009-10-13
38
}
39

            
40
sub columns {
cleanup
yuki-kimoto authored on 2009-10-14
41
    my ($self, $table) = @_;
first commit
yuki-kimoto authored on 2009-10-13
42
    
43
    return sort { 
cleanup
yuki-kimoto authored on 2009-10-14
44
        $self->table_infos->{$table}{column}{$a}{pos} 
first commit
yuki-kimoto authored on 2009-10-13
45
        <=>
cleanup
yuki-kimoto authored on 2009-10-14
46
        $self->table_infos->{$table}{column}{$b}{pos}
47
    } keys %{$self->table_info->{$table}{column}}
first commit
yuki-kimoto authored on 2009-10-13
48
}
49

            
50
sub tables {
cleanup
yuki-kimoto authored on 2009-10-14
51
    my $self = shift;
first commit
yuki-kimoto authored on 2009-10-13
52
    return keys %{$self->table_info};
53
}
54

            
cleanup
yuki-kimoto authored on 2009-10-14
55
sub create_table {
56
    my ($self, $table, @row_infos) = @_;
57
    
58
    $self->table_infos->{$table} = {};
59
    
60
    for (my $i = 0; $i < @columns; i++) {
61
        my $column = $columns[$i];
62
        
63
        my $column_name = shift @$column;
64
        my $column_type = shift @$column;
65
        my %column_options = @$column;
66
        
67
        my $column_info = {};
68
        
69
        $column_info->{pos}     = $i;
70
        $column_info->{type}    = $column_type;
71
        $column_info->{options} = \%column_options;
72
        
73
        $self->column_info($table, $column_name, $column_info);
74
    }
75
}
76

            
add some method
yuki-kimoto authored on 2009-10-14
77
sub load_table_definitions {
78
    my $self = shift;
79
    my $dsn  = $self->connect_info->{dsn};
80
}
cleanup
yuki-kimoto authored on 2009-10-14
81

            
add some method
yuki-kimoto authored on 2009-10-14
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
}
first commit
yuki-kimoto authored on 2009-10-13
100

            
add some method
yuki-kimoto authored on 2009-10-14
101
sub reconnect {
102
    my $self = shift;
103
    $self->dbh(undef);
104
    $self->connect;
105
}
first commit
yuki-kimoto authored on 2009-10-13
106

            
add some method
yuki-kimoto authored on 2009-10-14
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
    }
first commit
yuki-kimoto authored on 2009-10-13
140

            
add some method
yuki-kimoto authored on 2009-10-14
141
    eval { $sth->execute(@binds) } or do {
142
        if ($@) {
143
            $@ =~ s/ at \S+ line \d+\.\n\z//;
144
            Carp::croak($@);
145
        }
first commit
yuki-kimoto authored on 2009-10-13
146

            
add some method
yuki-kimoto authored on 2009-10-14
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) = @_;
first commit
yuki-kimoto authored on 2009-10-13
164
    
add some method
yuki-kimoto authored on 2009-10-14
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) = @_;
first commit
yuki-kimoto authored on 2009-10-13
172
    
add some method
yuki-kimoto authored on 2009-10-14
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);
first commit
yuki-kimoto authored on 2009-10-13
183
}
184

            
add some method
yuki-kimoto authored on 2009-10-14
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

            
first commit
yuki-kimoto authored on 2009-10-13
193

            
194
Object::Simple->build_class;
195

            
196
=head1 NAME
197

            
198
DBI::Custom - The great new DBI::Custom!
199

            
200
=head1 VERSION
201

            
202
Version 0.01
203

            
204
=cut
205

            
206
our $VERSION = '0.01';
207

            
208

            
209
=head1 SYNOPSIS
210

            
211
Quick summary of what the module does.
212

            
213
Perhaps a little code snippet.
214

            
215
    use DBI::Custom;
216

            
217
    my $foo = DBI::Custom->new();
218
    ...
219

            
220
=head1 EXPORT
221

            
222
A list of functions that can be exported.  You can delete this section
223
if you don't export anything, such as for a purely object-oriented module.
224

            
225
=head1 FUNCTIONS
226

            
227
=head2 function1
228

            
229
=cut
230

            
231
sub function1 {
232
}
233

            
234
=head2 function2
235

            
236
=cut
237

            
238
sub function2 {
239
}
240

            
241
=head1 AUTHOR
242

            
243
Yuki Kimoto, C<< <kimoto.yuki at gmail.com> >>
244

            
245
=head1 BUGS
246

            
247
Please report any bugs or feature requests to C<bug-dbi-custom at rt.cpan.org>, or through
248
the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=DBI-Custom>.  I will be notified, and then you'll
249
automatically be notified of progress on your bug as I make changes.
250

            
251

            
252

            
253

            
254
=head1 SUPPORT
255

            
256
You can find documentation for this module with the perldoc command.
257

            
258
    perldoc DBI::Custom
259

            
260

            
261
You can also look for information at:
262

            
263
=over 4
264

            
265
=item * RT: CPAN's request tracker
266

            
267
L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=DBI-Custom>
268

            
269
=item * AnnoCPAN: Annotated CPAN documentation
270

            
271
L<http://annocpan.org/dist/DBI-Custom>
272

            
273
=item * CPAN Ratings
274

            
275
L<http://cpanratings.perl.org/d/DBI-Custom>
276

            
277
=item * Search CPAN
278

            
279
L<http://search.cpan.org/dist/DBI-Custom/>
280

            
281
=back
282

            
283

            
284
=head1 ACKNOWLEDGEMENTS
285

            
286

            
287
=head1 COPYRIGHT & LICENSE
288

            
289
Copyright 2009 Yuki Kimoto, all rights reserved.
290

            
291
This program is free software; you can redistribute it and/or modify it
292
under the same terms as Perl itself.
293

            
294

            
295
=cut
296

            
297
1; # End of DBI::Custom