DBIx-Custom / lib / DBI / Custom.pm /
Newer Older
226 lines | 4.215kb
first commit
yuki-kimoto authored on 2009-10-13
1
package DBI::Custom;
2
use Object::Simple;
add test
yuki-kimoto authored on 2009-10-16
3

            
4
our $VERSION = '0.0101';
5

            
6
use Carp 'croak';
add some method
yuki-kimoto authored on 2009-10-14
7
use DBI;
first commit
yuki-kimoto authored on 2009-10-13
8

            
cleanup
yuki-kimoto authored on 2009-10-15
9
# Model
10
sub model : ClassAttr { auto_build => \&_inherit_model }
first commit
yuki-kimoto authored on 2009-10-13
11

            
cleanup
yuki-kimoto authored on 2009-10-15
12
# Inherit super class model
13
sub _inherit_model {
add test
yuki-kimoto authored on 2009-10-16
14
    my $class = shift;
cleanup
yuki-kimoto authored on 2009-10-15
15
    my $super = do {
16
        no strict 'refs';
17
        ${"${class}::ISA"}[0];
18
    };
19
    my $model = eval{$super->can('model')}
20
                         ? $super->model->clone
21
                         : $class->Object::Simple::new;
cleanup
yuki-kimoto authored on 2009-10-14
22
    
23
    $class->model($model);
first commit
yuki-kimoto authored on 2009-10-13
24
}
25

            
cleanup
yuki-kimoto authored on 2009-10-15
26
# New
27
sub new {
28
    my $self = shift->Object::Simple::new(@_);
29
    my $class = ref $self;
30
    return bless {%{$class->model->clone}, %{$self}}, $class;
first commit
yuki-kimoto authored on 2009-10-13
31
}
32

            
cleanup
yuki-kimoto authored on 2009-10-15
33
# Initialize modle
34
sub initialize_model {
35
    my ($class, $callback) = @_;
first commit
yuki-kimoto authored on 2009-10-13
36
    
cleanup
yuki-kimoto authored on 2009-10-15
37
    # Callback to initialize model
38
    $callback->($class->model);
first commit
yuki-kimoto authored on 2009-10-13
39
}
40

            
cleanup
yuki-kimoto authored on 2009-10-15
41
# Clone
42
sub clone {
cleanup
yuki-kimoto authored on 2009-10-14
43
    my $self = shift;
cleanup
yuki-kimoto authored on 2009-10-15
44
    my $new = $self->Object::Simple::new;
add test
yuki-kimoto authored on 2009-10-16
45
    $new->connect_info(%{$self->connect_info || {}});
cleanup
yuki-kimoto authored on 2009-10-15
46
    $new->filters(%{$self->filters || {}});
add test
yuki-kimoto authored on 2009-10-16
47
    $new->bind_filter($self->bind_filter);
48
    $new->fetch_filter($self->fetch_filter);
cleanup
yuki-kimoto authored on 2009-10-14
49
}
50

            
cleanup
yuki-kimoto authored on 2009-10-15
51
# Attribute
52
sub connect_info       : Attr { type => 'hash',  auto_build => sub { shift->connect_info({}) } }
cleanup
yuki-kimoto authored on 2009-10-15
53

            
add test
yuki-kimoto authored on 2009-10-16
54
sub bind_filter : Attr {}
55
sub fetch_filter : Attr {}
cleanup
yuki-kimoto authored on 2009-10-15
56

            
add test
yuki-kimoto authored on 2009-10-16
57
sub filters : Attr { type => 'hash', deref => 1, auto_build => sub { shift->filters({}) } }
cleanup
yuki-kimoto authored on 2009-10-15
58
sub add_filter { shift->filters(@_) }
59

            
cleanup
yuki-kimoto authored on 2009-10-15
60
sub dbh          : Attr { auto_build => sub { shift->connect } }
add test
yuki-kimoto authored on 2009-10-17
61
sub sql_template : Attr { auto_build => sub { shift->sql_template(DBI::Custom::SQLTemplate->new) } }
add test
yuki-kimoto authored on 2009-10-16
62

            
63
our %VALID_CONNECT_INFO = map {$_ => 1} qw/data_source user password options/;
cleanup
yuki-kimoto authored on 2009-10-14
64

            
add some method
yuki-kimoto authored on 2009-10-14
65
sub connect {
66
    my $self = shift;
67
    my $connect_info = $self->connect_info;
68
    
add test
yuki-kimoto authored on 2009-10-16
69
    foreach my $key (keys %{$self->connect_info}) {
add test
yuki-kimoto authored on 2009-10-17
70
        croak("connect_info '$key' is invald")
71
          unless $VALID_CONNECT_INFO{$key};
add test
yuki-kimoto authored on 2009-10-16
72
    }
73
    
add some method
yuki-kimoto authored on 2009-10-14
74
    my $dbh = DBI->connect(
add test
yuki-kimoto authored on 2009-10-16
75
        $connect_info->{data_source},
add some method
yuki-kimoto authored on 2009-10-14
76
        $connect_info->{user},
77
        $connect_info->{password},
78
        {
79
            RaiseError => 1,
80
            PrintError => 0,
81
            AutoCommit => 1,
82
            %{$connect_info->{options} || {} }
83
        }
84
    );
85
    
86
    $self->dbh($dbh);
87
}
first commit
yuki-kimoto authored on 2009-10-13
88

            
add test
yuki-kimoto authored on 2009-10-17
89
sub create_sql {
90
    my $self = shift;
91
    
92
    my ($sql, @bind) = $self->sql_template->create_sql(@_);
93
    
94
    return ($sql, @bind);
95
}
96

            
add some method
yuki-kimoto authored on 2009-10-14
97
sub query {
add test
yuki-kimoto authored on 2009-10-17
98
    my $self = shift;
99
    my ($sql, @bind) = $self->creqte_sql(@_);
100
    $self->prepare($sql);
101
    $self->execute(@bind);
102
}
103

            
104
sub query_raw_sql {
105
    my ($self, $sql, @bind) = @_;
106
    $self->prepare($sql);
107
    $self->execute(@bind);
108
}
109

            
110
Object::Simple->build_class;
111

            
112
package DBI::Custom::SQLTemplate;
113
use Object::Simple;
114

            
115
sub create_sql {
first commit
yuki-kimoto authored on 2009-10-13
116
    
117
}
118

            
add test
yuki-kimoto authored on 2009-10-17
119

            
120

            
121

            
first commit
yuki-kimoto authored on 2009-10-13
122
Object::Simple->build_class;
123

            
124
=head1 NAME
125

            
add test
yuki-kimoto authored on 2009-10-17
126
DBI::Custom - Customizable simple DBI
first commit
yuki-kimoto authored on 2009-10-13
127

            
128
=head1 VERSION
129

            
add test
yuki-kimoto authored on 2009-10-16
130
Version 0.0101
first commit
yuki-kimoto authored on 2009-10-13
131

            
132
=cut
133

            
134
=head1 SYNOPSIS
135

            
add test
yuki-kimoto authored on 2009-10-16
136
  my $dbi = DBI::Custom->new;
first commit
yuki-kimoto authored on 2009-10-13
137

            
add test
yuki-kimoto authored on 2009-10-16
138
=head1 METHODS
first commit
yuki-kimoto authored on 2009-10-13
139

            
add test
yuki-kimoto authored on 2009-10-16
140
=head2 add_filter
first commit
yuki-kimoto authored on 2009-10-13
141

            
add test
yuki-kimoto authored on 2009-10-16
142
=head2 bind_filter
first commit
yuki-kimoto authored on 2009-10-13
143

            
add test
yuki-kimoto authored on 2009-10-16
144
=head2 clone
first commit
yuki-kimoto authored on 2009-10-13
145

            
add test
yuki-kimoto authored on 2009-10-16
146
=head2 connect
first commit
yuki-kimoto authored on 2009-10-13
147

            
add test
yuki-kimoto authored on 2009-10-16
148
=head2 connect_info
first commit
yuki-kimoto authored on 2009-10-13
149

            
add test
yuki-kimoto authored on 2009-10-16
150
=head2 dbh
first commit
yuki-kimoto authored on 2009-10-13
151

            
add test
yuki-kimoto authored on 2009-10-16
152
=head2 fetch_filter
first commit
yuki-kimoto authored on 2009-10-13
153

            
add test
yuki-kimoto authored on 2009-10-16
154
=head2 filters
first commit
yuki-kimoto authored on 2009-10-13
155

            
add test
yuki-kimoto authored on 2009-10-16
156
=head2 initialize_model
first commit
yuki-kimoto authored on 2009-10-13
157

            
add test
yuki-kimoto authored on 2009-10-16
158
=head2 model
first commit
yuki-kimoto authored on 2009-10-13
159

            
add test
yuki-kimoto authored on 2009-10-16
160
=head2 new
161

            
162
=head2 query
first commit
yuki-kimoto authored on 2009-10-13
163

            
add test
yuki-kimoto authored on 2009-10-17
164
=head2 create_sql
165

            
166
=head2 query_raw_sql
167

            
168
=head2 sql_template
169

            
first commit
yuki-kimoto authored on 2009-10-13
170
=head1 AUTHOR
171

            
172
Yuki Kimoto, C<< <kimoto.yuki at gmail.com> >>
173

            
174
=head1 BUGS
175

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

            
180

            
181

            
182

            
183
=head1 SUPPORT
184

            
185
You can find documentation for this module with the perldoc command.
186

            
187
    perldoc DBI::Custom
188

            
189

            
190
You can also look for information at:
191

            
192
=over 4
193

            
194
=item * RT: CPAN's request tracker
195

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

            
198
=item * AnnoCPAN: Annotated CPAN documentation
199

            
200
L<http://annocpan.org/dist/DBI-Custom>
201

            
202
=item * CPAN Ratings
203

            
204
L<http://cpanratings.perl.org/d/DBI-Custom>
205

            
206
=item * Search CPAN
207

            
208
L<http://search.cpan.org/dist/DBI-Custom/>
209

            
210
=back
211

            
212

            
213
=head1 ACKNOWLEDGEMENTS
214

            
215

            
216
=head1 COPYRIGHT & LICENSE
217

            
218
Copyright 2009 Yuki Kimoto, all rights reserved.
219

            
220
This program is free software; you can redistribute it and/or modify it
221
under the same terms as Perl itself.
222

            
223

            
224
=cut
225

            
226
1; # End of DBI::Custom