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