Commit | Line | Data |
18fca96a |
1 | package DBIx::Class::Schema::Loader::Generic; |
a78e3fed |
2 | |
3 | use strict; |
a4a19f3c |
4 | use warnings; |
5 | |
a78e3fed |
6 | use Carp; |
7 | use Lingua::EN::Inflect; |
3980d69c |
8 | use base qw/Class::Accessor::Fast/; |
a4a19f3c |
9 | |
a78e3fed |
10 | require DBIx::Class::Core; |
a4a19f3c |
11 | |
3980d69c |
12 | # The first group are all arguments which are may be defaulted within, |
13 | # The last two (classes, monikers) are generated locally: |
14 | |
15 | __PACKAGE__->mk_ro_accessors(qw/ |
16 | schema |
17 | dsn |
18 | user |
19 | password |
20 | options |
21 | exclude |
22 | constraint |
23 | additional_classes |
24 | additional_base_classes |
25 | left_base_classes |
26 | relationships |
27 | inflect |
28 | db_schema |
29 | drop_db_schema |
30 | debug |
31 | |
32 | classes |
33 | monikers |
34 | /); |
a4a19f3c |
35 | |
a78e3fed |
36 | =head1 NAME |
37 | |
18fca96a |
38 | DBIx::Class::Schema::Loader::Generic - Generic DBIx::Class::Schema::Loader Implementation. |
a78e3fed |
39 | |
40 | =head1 SYNOPSIS |
41 | |
18fca96a |
42 | See L<DBIx::Class::Schema::Loader> |
a78e3fed |
43 | |
44 | =head1 DESCRIPTION |
45 | |
46 | =head2 OPTIONS |
47 | |
48 | Available constructor options are: |
49 | |
50 | =head3 additional_base_classes |
51 | |
52 | List of additional base classes your table classes will use. |
53 | |
54 | =head3 left_base_classes |
55 | |
56 | List of additional base classes, that need to be leftmost. |
57 | |
58 | =head3 additional_classes |
59 | |
60 | List of additional classes which your table classes will use. |
61 | |
62 | =head3 constraint |
63 | |
64 | Only load tables matching regex. |
65 | |
66 | =head3 exclude |
67 | |
68 | Exclude tables matching regex. |
69 | |
70 | =head3 debug |
71 | |
72 | Enable debug messages. |
73 | |
74 | =head3 dsn |
75 | |
76 | DBI Data Source Name. |
77 | |
a78e3fed |
78 | =head3 password |
79 | |
80 | Password. |
81 | |
82 | =head3 relationships |
83 | |
84 | Try to automatically detect/setup has_a and has_many relationships. |
85 | |
86 | =head3 inflect |
87 | |
88 | An hashref, which contains exceptions to Lingua::EN::Inflect::PL(). |
89 | Useful for foreign language column names. |
90 | |
91 | =head3 user |
92 | |
93 | Username. |
94 | |
95 | =head2 METHODS |
96 | |
97 | =cut |
98 | |
99 | =head3 new |
100 | |
3980d69c |
101 | Constructor for L<DBIx::Class::Schema::Loader::Generic>, used internally |
102 | by L<DBIx::Class::Schema::Loader>. |
a78e3fed |
103 | |
104 | =cut |
105 | |
3980d69c |
106 | # ensure that a peice of object data is a valid arrayref, creating |
107 | # an empty one or encapsulating whatever's there. |
108 | sub _ensure_arrayref { |
109 | my $self = shift; |
e26a4023 |
110 | |
3980d69c |
111 | foreach (@_) { |
112 | $self->{$_} ||= []; |
113 | $self->{$_} = [ $self->{$_} ] |
114 | unless ref $self->{$_} eq 'ARRAY'; |
115 | } |
a78e3fed |
116 | } |
117 | |
3980d69c |
118 | sub new { |
119 | my ( $class, %args ) = @_; |
a78e3fed |
120 | |
3980d69c |
121 | my $self = { %args }; |
fbd83464 |
122 | |
3980d69c |
123 | bless $self => $class; |
fbd83464 |
124 | |
3980d69c |
125 | $self->{db_schema} ||= ''; |
126 | $self->{constraint} ||= '.*'; |
127 | $self->{inflect} ||= {}; |
128 | $self->_ensure_arrayref(qw/additional_classes |
129 | additional_base_classes |
130 | left_base_classes/); |
fbd83464 |
131 | |
3980d69c |
132 | $self->{monikers} = {}; |
133 | $self->{classes} = {}; |
a78e3fed |
134 | |
3980d69c |
135 | $self->schema->connection($self->dsn, $self->user, |
136 | $self->password, $self->options); |
a78e3fed |
137 | |
3980d69c |
138 | warn qq/\### START DBIx::Class::Schema::Loader dump ###\n/ |
139 | if $self->debug; |
a78e3fed |
140 | |
3980d69c |
141 | $self->_load_classes; |
142 | $self->_load_relationships if $self->relationships; |
a78e3fed |
143 | |
3980d69c |
144 | warn qq/\### END DBIx::Class::Schema::Loader dump ###\n/ |
145 | if $self->debug; |
146 | $self->schema->storage->dbh->disconnect; # XXX this should be ->storage->disconnect later? |
a78e3fed |
147 | |
3980d69c |
148 | $self; |
a78e3fed |
149 | } |
150 | |
151 | # Overload in your driver class |
3980d69c |
152 | sub _db_classes { croak "ABSTRACT METHOD" } |
66742793 |
153 | |
16f6b6ac |
154 | # Inflect a relationship name |
155 | # XXX (should pluralize, but currently also tends to de-pluralize plurals) |
3980d69c |
156 | sub _inflect_relname { |
157 | my ($self, $relname) = @_; |
708c0939 |
158 | |
3980d69c |
159 | return $self->inflect->{$relname} if exists $self->inflect->{$relname}; |
160 | return Lingua::EN::Inflect::PL($relname); |
16f6b6ac |
161 | } |
a78e3fed |
162 | |
16f6b6ac |
163 | # Set up a simple relation with just a local col and foreign table |
3980d69c |
164 | sub _make_simple_rel { |
165 | my ($self, $table, $other, $col) = @_; |
708c0939 |
166 | |
3980d69c |
167 | my $table_class = $self->classes->{$table}; |
168 | my $other_class = $self->classes->{$other}; |
169 | my $table_relname = $self->_inflect_relname(lc $table); |
66742793 |
170 | |
3980d69c |
171 | warn qq/\# Belongs_to relationship\n/ if $self->debug; |
16f6b6ac |
172 | warn qq/$table_class->belongs_to( '$col' => '$other_class' );\n\n/ |
3980d69c |
173 | if $self->debug; |
16f6b6ac |
174 | $table_class->belongs_to( $col => $other_class ); |
708c0939 |
175 | |
3980d69c |
176 | warn qq/\# Has_many relationship\n/ if $self->debug; |
16f6b6ac |
177 | warn qq/$other_class->has_many( '$table_relname' => '$table_class',/ |
178 | . qq/$col);\n\n/ |
3980d69c |
179 | if $self->debug; |
708c0939 |
180 | |
16f6b6ac |
181 | $other_class->has_many( $table_relname => $table_class, $col); |
182 | } |
a78e3fed |
183 | |
3980d69c |
184 | # not a class method, just a helper for cond_rel XXX |
185 | sub _stringify_hash { |
186 | my $href = shift; |
187 | |
188 | return '{ ' . |
189 | join(q{, }, map("$_ => $href->{$_}", keys %$href)) |
190 | . ' }'; |
191 | } |
192 | |
16f6b6ac |
193 | # Set up a complex relation based on a hashref condition |
3980d69c |
194 | sub _make_cond_rel { |
195 | my ( $self, $table, $other, $cond ) = @_; |
a78e3fed |
196 | |
3980d69c |
197 | my $table_class = $self->classes->{$table}; |
198 | my $other_class = $self->classes->{$other}; |
199 | my $table_relname = $self->_inflect_relname(lc $table); |
16f6b6ac |
200 | my $other_relname = lc $other; |
708c0939 |
201 | |
16f6b6ac |
202 | # for single-column case, set the relname to the column name, |
203 | # to make filter accessors work |
204 | if(scalar keys %$cond == 1) { |
205 | my ($col) = keys %$cond; |
206 | $other_relname = $cond->{$col}; |
4ce22656 |
207 | } |
16f6b6ac |
208 | |
209 | my $rev_cond = { reverse %$cond }; |
210 | |
3980d69c |
211 | my $cond_printable = _stringify_hash($cond) |
212 | if $self->debug; |
213 | my $rev_cond_printable = _stringify_hash($rev_cond) |
214 | if $self->debug; |
16f6b6ac |
215 | |
3980d69c |
216 | warn qq/\# Belongs_to relationship\n/ if $self->debug; |
16f6b6ac |
217 | |
218 | warn qq/$table_class->belongs_to( '$other_relname' => '$other_class',/ |
219 | . qq/$cond_printable);\n\n/ |
3980d69c |
220 | if $self->debug; |
16f6b6ac |
221 | |
222 | $table_class->belongs_to( $other_relname => $other_class, $cond); |
223 | |
3980d69c |
224 | warn qq/\# Has_many relationship\n/ if $self->debug; |
16f6b6ac |
225 | |
226 | warn qq/$other_class->has_many( '$table_relname' => '$table_class',/ |
227 | . qq/$rev_cond_printable);\n\n/ |
228 | . qq/);\n\n/ |
3980d69c |
229 | if $self->debug; |
16f6b6ac |
230 | |
231 | $other_class->has_many( $table_relname => $table_class, $rev_cond); |
a78e3fed |
232 | } |
233 | |
42c0680e |
234 | sub _use { |
235 | my $self = shift; |
236 | my $target = shift; |
237 | |
238 | foreach (@_) { |
239 | $_->require or croak ($_ . "->require: $@"); |
240 | eval "package $target; use $_;"; |
241 | croak "use $_: $@" if $@; |
242 | } |
243 | } |
244 | |
245 | sub _inject { |
246 | my $self = shift; |
247 | my $target = shift; |
248 | my $schema = $self->schema; |
249 | |
250 | foreach (@_) { |
251 | $_->require or croak ($_ . "->require: $@"); |
252 | $schema->inject_base($target, $_); |
253 | } |
254 | } |
255 | |
a78e3fed |
256 | # Load and setup classes |
3980d69c |
257 | sub _load_classes { |
258 | my $self = shift; |
af6c2665 |
259 | |
3980d69c |
260 | my @tables = $self->_tables(); |
261 | my @db_classes = $self->_db_classes(); |
262 | my $schema = $self->schema; |
a78e3fed |
263 | |
a78e3fed |
264 | foreach my $table (@tables) { |
3980d69c |
265 | my $constraint = $self->constraint; |
266 | my $exclude = $self->exclude; |
267 | |
268 | next unless $table =~ /$constraint/; |
269 | next if defined $exclude && $table =~ /$exclude/; |
af6c2665 |
270 | |
af6c2665 |
271 | my ($db_schema, $tbl) = split /\./, $table; |
af96f52e |
272 | my $tablename = lc $table; |
a78e3fed |
273 | if($tbl) { |
3980d69c |
274 | $tablename = $self->drop_db_schema ? $tbl : lc $table; |
af6c2665 |
275 | } |
3980d69c |
276 | my $lc_tblname = lc $tablename; |
af6c2665 |
277 | |
3980d69c |
278 | my $table_moniker = $self->_table2moniker($db_schema, $tbl); |
279 | my $table_class = $schema . q{::} . $table_moniker; |
af6c2665 |
280 | |
42c0680e |
281 | $self->_inject($table_class, 'DBIx::Class::Core'); |
282 | $self->_inject($table_class, @db_classes); |
283 | $self->_inject($table_class, @{$self->additional_base_classes}); |
284 | $self->_use ($table_class, @{$self->additional_classes}); |
285 | $self->_inject($table_class, @{$self->left_base_classes}); |
3980d69c |
286 | |
287 | warn qq/\# Initializing table "$tablename" as "$table_class"\n/ |
288 | if $self->debug; |
e26a4023 |
289 | $table_class->table($lc_tblname); |
af6c2665 |
290 | |
3980d69c |
291 | my ( $cols, $pks ) = $self->_table_info($table); |
a78e3fed |
292 | carp("$table has no primary key") unless @$pks; |
a4a19f3c |
293 | $table_class->add_columns(@$cols); |
294 | $table_class->set_primary_key(@$pks) if @$pks; |
af6c2665 |
295 | |
3980d69c |
296 | warn qq/$table_class->table('$tablename');\n/ if $self->debug; |
a78e3fed |
297 | my $columns = join "', '", @$cols; |
3980d69c |
298 | warn qq/$table_class->add_columns('$columns')\n/ if $self->debug; |
a78e3fed |
299 | my $primaries = join "', '", @$pks; |
3980d69c |
300 | warn qq/$table_class->set_primary_key('$primaries')\n/ |
301 | if $self->debug && @$pks; |
af6c2665 |
302 | |
3980d69c |
303 | $schema->register_class($table_moniker, $table_class); |
304 | $self->classes->{$lc_tblname} = $table_class; |
305 | $self->monikers->{$lc_tblname} = $table_moniker; |
a78e3fed |
306 | } |
307 | } |
308 | |
3980d69c |
309 | =head3 tables |
310 | |
311 | Returns a sorted list of tables. |
312 | |
313 | my @tables = $loader->tables; |
314 | |
315 | =cut |
316 | |
317 | sub tables { |
318 | my $self = shift; |
319 | |
320 | return sort keys %{ $self->monikers }; |
321 | } |
322 | |
a78e3fed |
323 | # Find and setup relationships |
3980d69c |
324 | sub _load_relationships { |
325 | my $self = shift; |
326 | |
327 | my $dbh = $self->schema->storage->dbh; |
708c0939 |
328 | my $quoter = $dbh->get_info(29) || q{"}; |
3980d69c |
329 | foreach my $table ( $self->tables ) { |
708c0939 |
330 | my $rels = {}; |
331 | my $sth = $dbh->foreign_key_info( '', |
3980d69c |
332 | $self->db_schema, '', '', '', $table ); |
708c0939 |
333 | next if !$sth; |
334 | while(my $raw_rel = $sth->fetchrow_hashref) { |
335 | my $uk_tbl = lc $raw_rel->{UK_TABLE_NAME}; |
336 | my $uk_col = lc $raw_rel->{UK_COLUMN_NAME}; |
337 | my $fk_col = lc $raw_rel->{FK_COLUMN_NAME}; |
4ce22656 |
338 | my $relid = lc $raw_rel->{UK_NAME}; |
708c0939 |
339 | $uk_tbl =~ s/$quoter//g; |
340 | $uk_col =~ s/$quoter//g; |
341 | $fk_col =~ s/$quoter//g; |
4ce22656 |
342 | $relid =~ s/$quoter//g; |
343 | $rels->{$relid}->{tbl} = $uk_tbl; |
344 | $rels->{$relid}->{cols}->{$uk_col} = $fk_col; |
708c0939 |
345 | } |
346 | |
4ce22656 |
347 | foreach my $relid (keys %$rels) { |
348 | my $reltbl = $rels->{$relid}->{tbl}; |
349 | my $cond = $rels->{$relid}->{cols}; |
3980d69c |
350 | eval { $self->_make_cond_rel( $table, $reltbl, $cond ) }; |
708c0939 |
351 | warn qq/\# belongs_to_many failed "$@"\n\n/ |
3980d69c |
352 | if $@ && $self->debug; |
a78e3fed |
353 | } |
354 | } |
355 | } |
356 | |
65644119 |
357 | # Make a moniker from a table |
3980d69c |
358 | sub _table2moniker { |
359 | my ( $self, $db_schema, $table ) = @_; |
af6c2665 |
360 | |
af96f52e |
361 | my $db_schema_ns; |
af6c2665 |
362 | |
af96f52e |
363 | if($table) { |
364 | $db_schema = ucfirst lc $db_schema; |
3980d69c |
365 | $db_schema_ns = $db_schema if(!$self->drop_db_schema); |
af96f52e |
366 | } else { |
367 | $table = $db_schema; |
a78e3fed |
368 | } |
af6c2665 |
369 | |
65644119 |
370 | my $moniker = join '', map ucfirst, split /[\W_]+/, lc $table; |
371 | $moniker = $db_schema_ns ? $db_schema_ns . $moniker : $moniker; |
af96f52e |
372 | |
65644119 |
373 | return $moniker; |
a78e3fed |
374 | } |
375 | |
376 | # Overload in driver class |
3980d69c |
377 | sub _tables { croak "ABSTRACT METHOD" } |
a78e3fed |
378 | |
3980d69c |
379 | sub _table_info { croak "ABSTRACT METHOD" } |
a78e3fed |
380 | |
381 | =head1 SEE ALSO |
382 | |
18fca96a |
383 | L<DBIx::Class::Schema::Loader> |
a78e3fed |
384 | |
385 | =cut |
386 | |
387 | 1; |