Commit | Line | Data |
18fca96a |
1 | package DBIx::Class::Schema::Loader::Generic; |
a78e3fed |
2 | |
3 | use strict; |
a4a19f3c |
4 | use warnings; |
5 | |
6 | use base qw/DBIx::Class::Schema/; |
7 | |
a78e3fed |
8 | use Carp; |
9 | use Lingua::EN::Inflect; |
a4a19f3c |
10 | |
a78e3fed |
11 | require DBIx::Class::Core; |
a4a19f3c |
12 | |
66742793 |
13 | __PACKAGE__->mk_classaccessor('_loader_data'); |
14 | __PACKAGE__->mk_classaccessor('_loader_debug' => 0); |
a4a19f3c |
15 | |
a78e3fed |
16 | =head1 NAME |
17 | |
18fca96a |
18 | DBIx::Class::Schema::Loader::Generic - Generic DBIx::Class::Schema::Loader Implementation. |
a78e3fed |
19 | |
20 | =head1 SYNOPSIS |
21 | |
18fca96a |
22 | See L<DBIx::Class::Schema::Loader> |
a78e3fed |
23 | |
24 | =head1 DESCRIPTION |
25 | |
26 | =head2 OPTIONS |
27 | |
28 | Available constructor options are: |
29 | |
30 | =head3 additional_base_classes |
31 | |
32 | List of additional base classes your table classes will use. |
33 | |
34 | =head3 left_base_classes |
35 | |
36 | List of additional base classes, that need to be leftmost. |
37 | |
38 | =head3 additional_classes |
39 | |
40 | List of additional classes which your table classes will use. |
41 | |
42 | =head3 constraint |
43 | |
44 | Only load tables matching regex. |
45 | |
46 | =head3 exclude |
47 | |
48 | Exclude tables matching regex. |
49 | |
50 | =head3 debug |
51 | |
52 | Enable debug messages. |
53 | |
54 | =head3 dsn |
55 | |
56 | DBI Data Source Name. |
57 | |
a78e3fed |
58 | =head3 password |
59 | |
60 | Password. |
61 | |
62 | =head3 relationships |
63 | |
64 | Try to automatically detect/setup has_a and has_many relationships. |
65 | |
66 | =head3 inflect |
67 | |
68 | An hashref, which contains exceptions to Lingua::EN::Inflect::PL(). |
69 | Useful for foreign language column names. |
70 | |
71 | =head3 user |
72 | |
73 | Username. |
74 | |
75 | =head2 METHODS |
76 | |
77 | =cut |
78 | |
79 | =head3 new |
80 | |
81 | Not intended to be called directly. This is used internally by the |
18fca96a |
82 | C<new()> method in L<DBIx::Class::Schema::Loader>. |
a78e3fed |
83 | |
84 | =cut |
85 | |
a4a19f3c |
86 | sub _load_from_connection { |
a78e3fed |
87 | my ( $class, %args ) = @_; |
3385ac62 |
88 | |
89 | $class->_loader_debug( $args{debug} ? 1 : 0); |
90 | |
a78e3fed |
91 | my $additional = $args{additional_classes} || []; |
92 | $additional = [$additional] unless ref $additional eq 'ARRAY'; |
3385ac62 |
93 | |
a78e3fed |
94 | my $additional_base = $args{additional_base_classes} || []; |
95 | $additional_base = [$additional_base] |
96 | unless ref $additional_base eq 'ARRAY'; |
3385ac62 |
97 | |
a78e3fed |
98 | my $left_base = $args{left_base_classes} || []; |
99 | $left_base = [$left_base] unless ref $left_base eq 'ARRAY'; |
3385ac62 |
100 | |
101 | $class->_loader_data({ |
102 | datasource => |
a78e3fed |
103 | [ $args{dsn}, $args{user}, $args{password}, $args{options} ], |
3385ac62 |
104 | additional => $additional, |
105 | additional_base => $additional_base, |
106 | left_base => $left_base, |
107 | constraint => $args{constraint} || '.*', |
108 | exclude => $args{exclude}, |
3385ac62 |
109 | inflect => $args{inflect}, |
110 | db_schema => $args{db_schema} || '', |
111 | drop_db_schema => $args{drop_db_schema}, |
112 | TABLE_CLASSES => {}, |
113 | MONIKERS => {}, |
a4a19f3c |
114 | }); |
115 | |
3385ac62 |
116 | $class->connection(@{$class->_loader_data->{datasource}}); |
117 | warn qq/\### START DBIx::Class::Schema::Loader dump ###\n/ |
118 | if $class->_loader_debug; |
119 | $class->_loader_load_classes; |
66742793 |
120 | $class->_loader_relationships if $args{relationships}; |
3385ac62 |
121 | warn qq/\### END DBIx::Class::Schema::Loader dump ###\n/ |
122 | if $class->_loader_debug; |
a4a19f3c |
123 | $class->storage->dbh->disconnect; # XXX this should be ->storage->disconnect later? |
124 | |
125 | 1; |
a78e3fed |
126 | } |
127 | |
af6c2665 |
128 | # The original table class name during Loader, |
3385ac62 |
129 | sub _loader_find_table_class { |
a4a19f3c |
130 | my ( $class, $table ) = @_; |
3385ac62 |
131 | return $class->_loader_data->{TABLE_CLASSES}->{$table}; |
a78e3fed |
132 | } |
133 | |
af6c2665 |
134 | # Returns the moniker for a given table name, |
135 | # for use in $conn->resultset($moniker) |
fbd83464 |
136 | |
137 | =head3 moniker |
138 | |
139 | Returns the moniker for a given literal table name. Used |
140 | as $schema->resultset($moniker), etc. |
141 | |
142 | =cut |
af6c2665 |
143 | sub moniker { |
a4a19f3c |
144 | my ( $class, $table ) = @_; |
3385ac62 |
145 | return $class->_loader_data->{MONIKERS}->{$table}; |
a78e3fed |
146 | } |
147 | |
a78e3fed |
148 | =head3 tables |
149 | |
150 | Returns a sorted list of tables. |
151 | |
152 | my @tables = $loader->tables; |
153 | |
154 | =cut |
155 | |
156 | sub tables { |
a4a19f3c |
157 | my $class = shift; |
3385ac62 |
158 | return sort keys %{ $class->_loader_data->{MONIKERS} }; |
a78e3fed |
159 | } |
160 | |
161 | # Overload in your driver class |
3385ac62 |
162 | sub _loader_db_classes { croak "ABSTRACT METHOD" } |
a78e3fed |
163 | |
66742793 |
164 | # not a class method. |
165 | sub _loader_stringify_hash { |
166 | my $href = shift; |
167 | |
168 | return '{ ' . |
169 | join(q{, }, map("$_ => $href->{$_}", keys %$href)) |
170 | . ' }'; |
171 | } |
172 | |
a78e3fed |
173 | # Setup has_a and has_many relationships |
3385ac62 |
174 | sub _loader_make_relations { |
708c0939 |
175 | |
176 | my ( $class, $table, $other, $cond ) = @_; |
3385ac62 |
177 | my $table_class = $class->_loader_find_table_class($table); |
178 | my $other_class = $class->_loader_find_table_class($other); |
a78e3fed |
179 | |
708c0939 |
180 | my $table_relname = lc $table; |
181 | my $other_relname = lc $other; |
a78e3fed |
182 | |
3385ac62 |
183 | if(my $inflections = $class->_loader_data->{inflect}) { |
708c0939 |
184 | $table_relname = $inflections->{$table_relname} |
185 | if exists $inflections->{$table_relname}; |
a78e3fed |
186 | } |
187 | else { |
708c0939 |
188 | $table_relname = Lingua::EN::Inflect::PL($table_relname); |
189 | } |
190 | |
191 | # for single-column case, set the relname to the column name, |
192 | # to make filter accessors work |
193 | if(scalar keys %$cond == 1) { |
194 | my ($col) = keys %$cond; |
195 | $other_relname = $cond->{$col}; |
a78e3fed |
196 | } |
197 | |
708c0939 |
198 | my $rev_cond = { reverse %$cond }; |
199 | |
66742793 |
200 | my $cond_printable = _loader_stringify_hash($cond) |
201 | if $class->_loader_debug; |
202 | my $rev_cond_printable = _loader_stringify_hash($rev_cond) |
203 | if $class->_loader_debug; |
204 | |
3385ac62 |
205 | warn qq/\# Belongs_to relationship\n/ if $class->_loader_debug; |
708c0939 |
206 | |
207 | warn qq/$table_class->belongs_to( '$other_relname' => '$other_class',/ |
66742793 |
208 | . qq/$cond_printable);\n\n/ |
3385ac62 |
209 | if $class->_loader_debug; |
708c0939 |
210 | |
211 | $table_class->belongs_to( $other_relname => $other_class, $cond); |
a78e3fed |
212 | |
3385ac62 |
213 | warn qq/\# Has_many relationship\n/ if $class->_loader_debug; |
a78e3fed |
214 | |
708c0939 |
215 | warn qq/$other_class->has_many( '$table_relname' => '$table_class',/ |
66742793 |
216 | . qq/$rev_cond_printable);\n\n/ |
708c0939 |
217 | . qq/);\n\n/ |
3385ac62 |
218 | if $class->_loader_debug; |
708c0939 |
219 | |
220 | $other_class->has_many( $table_relname => $table_class, $rev_cond); |
a78e3fed |
221 | } |
222 | |
223 | # Load and setup classes |
3385ac62 |
224 | sub _loader_load_classes { |
a4a19f3c |
225 | my $class = shift; |
af6c2665 |
226 | |
3385ac62 |
227 | my @tables = $class->_loader_tables(); |
228 | my @db_classes = $class->_loader_db_classes(); |
229 | my $additional = join '', map "use $_;\n", @{ $class->_loader_data->{additional} }; |
a78e3fed |
230 | my $additional_base = join '', map "use base '$_';\n", |
3385ac62 |
231 | @{ $class->_loader_data->{additional_base} }; |
232 | my $left_base = join '', map "use base '$_';\n", @{ $class->_loader_data->{left_base} }; |
233 | my $constraint = $class->_loader_data->{constraint}; |
234 | my $exclude = $class->_loader_data->{exclude}; |
a78e3fed |
235 | |
a78e3fed |
236 | foreach my $table (@tables) { |
237 | next unless $table =~ /$constraint/; |
238 | next if ( defined $exclude && $table =~ /$exclude/ ); |
af6c2665 |
239 | |
af6c2665 |
240 | my ($db_schema, $tbl) = split /\./, $table; |
af96f52e |
241 | my $tablename = lc $table; |
a78e3fed |
242 | if($tbl) { |
3385ac62 |
243 | $tablename = $class->_loader_data->{drop_db_schema} ? $tbl : lc $table; |
af6c2665 |
244 | } |
245 | |
3385ac62 |
246 | my $table_moniker = $class->_loader_table2moniker($db_schema, $tbl); |
65644119 |
247 | my $table_class = "$class\::$table_moniker"; |
af6c2665 |
248 | |
a4a19f3c |
249 | $class->inject_base( $table_class, 'DBIx::Class::Core' ); |
a78e3fed |
250 | $_->require for @db_classes; |
a4a19f3c |
251 | $class->inject_base( $table_class, $_ ) for @db_classes; |
3385ac62 |
252 | warn qq/\# Initializing table "$tablename" as "$table_class"\n/ if $class->_loader_debug; |
af96f52e |
253 | $table_class->table(lc $tablename); |
af6c2665 |
254 | |
3385ac62 |
255 | my ( $cols, $pks ) = $class->_loader_table_info($table); |
a78e3fed |
256 | carp("$table has no primary key") unless @$pks; |
a4a19f3c |
257 | $table_class->add_columns(@$cols); |
258 | $table_class->set_primary_key(@$pks) if @$pks; |
af6c2665 |
259 | |
a4a19f3c |
260 | my $code = "package $table_class;\n$additional_base$additional$left_base"; |
3385ac62 |
261 | warn qq/$code/ if $class->_loader_debug; |
262 | warn qq/$table_class->table('$tablename');\n/ if $class->_loader_debug; |
a78e3fed |
263 | my $columns = join "', '", @$cols; |
3385ac62 |
264 | warn qq/$table_class->add_columns('$columns')\n/ if $class->_loader_debug; |
a78e3fed |
265 | my $primaries = join "', '", @$pks; |
3385ac62 |
266 | warn qq/$table_class->set_primary_key('$primaries')\n/ if $class->_loader_debug && @$pks; |
a78e3fed |
267 | eval $code; |
268 | croak qq/Couldn't load additional classes "$@"/ if $@; |
3385ac62 |
269 | unshift @{"$table_class\::ISA"}, $_ foreach ( @{ $class->_loader_data->{left_base} } ); |
af6c2665 |
270 | |
65644119 |
271 | $class->register_class($table_moniker, $table_class); |
3385ac62 |
272 | $class->_loader_data->{TABLE_CLASSES}->{lc $tablename} = $table_class; |
273 | $class->_loader_data->{MONIKERS}->{lc $tablename} = $table_moniker; |
a78e3fed |
274 | } |
275 | } |
276 | |
277 | # Find and setup relationships |
3385ac62 |
278 | sub _loader_relationships { |
a4a19f3c |
279 | my $class = shift; |
280 | my $dbh = $class->storage->dbh; |
708c0939 |
281 | my $quoter = $dbh->get_info(29) || q{"}; |
a4a19f3c |
282 | foreach my $table ( $class->tables ) { |
708c0939 |
283 | my $rels = {}; |
284 | my $sth = $dbh->foreign_key_info( '', |
3385ac62 |
285 | $class->_loader_data->{db_schema}, '', '', '', $table ); |
708c0939 |
286 | next if !$sth; |
287 | while(my $raw_rel = $sth->fetchrow_hashref) { |
288 | my $uk_tbl = lc $raw_rel->{UK_TABLE_NAME}; |
289 | my $uk_col = lc $raw_rel->{UK_COLUMN_NAME}; |
290 | my $fk_col = lc $raw_rel->{FK_COLUMN_NAME}; |
291 | $uk_tbl =~ s/$quoter//g; |
292 | $uk_col =~ s/$quoter//g; |
293 | $fk_col =~ s/$quoter//g; |
294 | $rels->{$uk_tbl}->{$uk_col} = $fk_col; |
295 | } |
296 | |
297 | foreach my $reltbl (keys %$rels) { |
298 | my $cond = $rels->{$reltbl}; |
3385ac62 |
299 | eval { $class->_loader_make_relations( $table, $reltbl, $cond ) }; |
708c0939 |
300 | warn qq/\# belongs_to_many failed "$@"\n\n/ |
3385ac62 |
301 | if $@ && $class->_loader_debug; |
a78e3fed |
302 | } |
303 | } |
304 | } |
305 | |
65644119 |
306 | # Make a moniker from a table |
3385ac62 |
307 | sub _loader_table2moniker { |
a4a19f3c |
308 | my ( $class, $db_schema, $table ) = @_; |
af6c2665 |
309 | |
af96f52e |
310 | my $db_schema_ns; |
af6c2665 |
311 | |
af96f52e |
312 | if($table) { |
313 | $db_schema = ucfirst lc $db_schema; |
3385ac62 |
314 | $db_schema_ns = $db_schema if(!$class->_loader_data->{drop_db_schema}); |
af96f52e |
315 | } else { |
316 | $table = $db_schema; |
a78e3fed |
317 | } |
af6c2665 |
318 | |
65644119 |
319 | my $moniker = join '', map ucfirst, split /[\W_]+/, lc $table; |
320 | $moniker = $db_schema_ns ? $db_schema_ns . $moniker : $moniker; |
af96f52e |
321 | |
65644119 |
322 | return $moniker; |
a78e3fed |
323 | } |
324 | |
325 | # Overload in driver class |
3385ac62 |
326 | sub _loader_tables { croak "ABSTRACT METHOD" } |
a78e3fed |
327 | |
3385ac62 |
328 | sub _loader_table_info { croak "ABSTRACT METHOD" } |
a78e3fed |
329 | |
330 | =head1 SEE ALSO |
331 | |
18fca96a |
332 | L<DBIx::Class::Schema::Loader> |
a78e3fed |
333 | |
334 | =cut |
335 | |
336 | 1; |