first commit
|
1 |
package DBI::Custom; |
2 |
use Object::Simple; |
|
3 | ||
cleanup
|
4 |
sub new { |
5 |
my $self = shift->Object::Simple::new(@_); |
|
6 |
my $class = ref $self; |
|
7 |
return bless {%{$class->model}, %{$self}}, $class; |
|
first commit
|
8 |
} |
9 | ||
cleanup
|
10 |
sub create_model {shift->Object::Simple::new(@_); |
first commit
|
11 | |
cleanup
|
12 |
sub initialize_model { |
13 |
my ($class, $callback) = @_; |
|
14 |
|
|
15 |
my $model = $class->create_model; |
|
16 |
|
|
17 |
$callback->($model); |
|
18 |
|
|
19 |
$class->model($model); |
|
first commit
|
20 |
} |
21 | ||
22 |
# Class attribute |
|
cleanup
|
23 |
sub connect_info : Attr { type => 'hash' } |
24 |
sub table_infos : Attr { type => 'hash' } |
|
first commit
|
25 | |
26 |
sub column_info { |
|
cleanup
|
27 |
my ($self, $table, $column_name, $column_info) = @_; |
28 |
|
|
29 |
if (@_ > 3) { |
|
30 |
$self->table_infos->{$table}{column}{$column_name} = $column_info; |
|
31 |
return $self; |
|
32 |
} |
|
33 |
return $self->table_infos->{$table}{column}{$column_name}; |
|
first commit
|
34 |
} |
35 | ||
36 |
sub columns { |
|
cleanup
|
37 |
my ($self, $table) = @_; |
first commit
|
38 |
|
39 |
return sort { |
|
cleanup
|
40 |
$self->table_infos->{$table}{column}{$a}{pos} |
first commit
|
41 |
<=> |
cleanup
|
42 |
$self->table_infos->{$table}{column}{$b}{pos} |
43 |
} keys %{$self->table_info->{$table}{column}} |
|
first commit
|
44 |
} |
45 | ||
46 |
sub tables { |
|
cleanup
|
47 |
my $self = shift; |
first commit
|
48 |
return keys %{$self->table_info}; |
49 |
} |
|
50 | ||
cleanup
|
51 |
sub create_table { |
52 |
my ($self, $table, @row_infos) = @_; |
|
53 |
|
|
54 |
$self->table_infos->{$table} = {}; |
|
55 |
|
|
56 |
for (my $i = 0; $i < @columns; i++) { |
|
57 |
my $column = $columns[$i]; |
|
58 |
|
|
59 |
my $column_name = shift @$column; |
|
60 |
my $column_type = shift @$column; |
|
61 |
my %column_options = @$column; |
|
62 |
|
|
63 |
my $column_info = {}; |
|
64 |
|
|
65 |
$column_info->{pos} = $i; |
|
66 |
$column_info->{type} = $column_type; |
|
67 |
$column_info->{options} = \%column_options; |
|
68 |
|
|
69 |
$self->column_info($table, $column_name, $column_info); |
|
70 |
} |
|
71 |
} |
|
72 | ||
73 | ||
first commit
|
74 | |
75 | ||
76 | ||
77 | ||
78 |
sub insert { |
|
79 |
my $self = shift; |
|
80 |
|
|
81 |
|
|
82 |
|
|
83 |
} |
|
84 | ||
85 | ||
86 |
Object::Simple->build_class; |
|
87 | ||
88 |
=head1 NAME |
|
89 | ||
90 |
DBI::Custom - The great new DBI::Custom! |
|
91 | ||
92 |
=head1 VERSION |
|
93 | ||
94 |
Version 0.01 |
|
95 | ||
96 |
=cut |
|
97 | ||
98 |
our $VERSION = '0.01'; |
|
99 | ||
100 | ||
101 |
=head1 SYNOPSIS |
|
102 | ||
103 |
Quick summary of what the module does. |
|
104 | ||
105 |
Perhaps a little code snippet. |
|
106 | ||
107 |
use DBI::Custom; |
|
108 | ||
109 |
my $foo = DBI::Custom->new(); |
|
110 |
... |
|
111 | ||
112 |
=head1 EXPORT |
|
113 | ||
114 |
A list of functions that can be exported. You can delete this section |
|
115 |
if you don't export anything, such as for a purely object-oriented module. |
|
116 | ||
117 |
=head1 FUNCTIONS |
|
118 | ||
119 |
=head2 function1 |
|
120 | ||
121 |
=cut |
|
122 | ||
123 |
sub function1 { |
|
124 |
} |
|
125 | ||
126 |
=head2 function2 |
|
127 | ||
128 |
=cut |
|
129 | ||
130 |
sub function2 { |
|
131 |
} |
|
132 | ||
133 |
=head1 AUTHOR |
|
134 | ||
135 |
Yuki Kimoto, C<< <kimoto.yuki at gmail.com> >> |
|
136 | ||
137 |
=head1 BUGS |
|
138 | ||
139 |
Please report any bugs or feature requests to C<bug-dbi-custom at rt.cpan.org>, or through |
|
140 |
the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=DBI-Custom>. I will be notified, and then you'll |
|
141 |
automatically be notified of progress on your bug as I make changes. |
|
142 | ||
143 | ||
144 | ||
145 | ||
146 |
=head1 SUPPORT |
|
147 | ||
148 |
You can find documentation for this module with the perldoc command. |
|
149 | ||
150 |
perldoc DBI::Custom |
|
151 | ||
152 | ||
153 |
You can also look for information at: |
|
154 | ||
155 |
=over 4 |
|
156 | ||
157 |
=item * RT: CPAN's request tracker |
|
158 | ||
159 |
L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=DBI-Custom> |
|
160 | ||
161 |
=item * AnnoCPAN: Annotated CPAN documentation |
|
162 | ||
163 |
L<http://annocpan.org/dist/DBI-Custom> |
|
164 | ||
165 |
=item * CPAN Ratings |
|
166 | ||
167 |
L<http://cpanratings.perl.org/d/DBI-Custom> |
|
168 | ||
169 |
=item * Search CPAN |
|
170 | ||
171 |
L<http://search.cpan.org/dist/DBI-Custom/> |
|
172 | ||
173 |
=back |
|
174 | ||
175 | ||
176 |
=head1 ACKNOWLEDGEMENTS |
|
177 | ||
178 | ||
179 |
=head1 COPYRIGHT & LICENSE |
|
180 | ||
181 |
Copyright 2009 Yuki Kimoto, all rights reserved. |
|
182 | ||
183 |
This program is free software; you can redistribute it and/or modify it |
|
184 |
under the same terms as Perl itself. |
|
185 | ||
186 | ||
187 |
=cut |
|
188 | ||
189 |
1; # End of DBI::Custom |