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 | |
3385ac62 |
13 | __PACKAGE__->mk_classdata('_loader_data'); |
14 | __PACKAGE__->mk_classdata('_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}, |
109 | relationships => $args{relationships}, |
110 | inflect => $args{inflect}, |
111 | db_schema => $args{db_schema} || '', |
112 | drop_db_schema => $args{drop_db_schema}, |
113 | TABLE_CLASSES => {}, |
114 | MONIKERS => {}, |
a4a19f3c |
115 | }); |
116 | |
3385ac62 |
117 | $class->connection(@{$class->_loader_data->{datasource}}); |
118 | warn qq/\### START DBIx::Class::Schema::Loader dump ###\n/ |
119 | if $class->_loader_debug; |
120 | $class->_loader_load_classes; |
121 | $class->_loader_relationships if $class->_loader_data->{relationships}; |
122 | warn qq/\### END DBIx::Class::Schema::Loader dump ###\n/ |
123 | if $class->_loader_debug; |
a4a19f3c |
124 | $class->storage->dbh->disconnect; # XXX this should be ->storage->disconnect later? |
125 | |
126 | 1; |
a78e3fed |
127 | } |
128 | |
af6c2665 |
129 | # The original table class name during Loader, |
3385ac62 |
130 | sub _loader_find_table_class { |
a4a19f3c |
131 | my ( $class, $table ) = @_; |
3385ac62 |
132 | return $class->_loader_data->{TABLE_CLASSES}->{$table}; |
a78e3fed |
133 | } |
134 | |
af6c2665 |
135 | # Returns the moniker for a given table name, |
136 | # for use in $conn->resultset($moniker) |
fbd83464 |
137 | |
138 | =head3 moniker |
139 | |
140 | Returns the moniker for a given literal table name. Used |
141 | as $schema->resultset($moniker), etc. |
142 | |
143 | =cut |
af6c2665 |
144 | sub moniker { |
a4a19f3c |
145 | my ( $class, $table ) = @_; |
3385ac62 |
146 | return $class->_loader_data->{MONIKERS}->{$table}; |
a78e3fed |
147 | } |
148 | |
a78e3fed |
149 | =head3 tables |
150 | |
151 | Returns a sorted list of tables. |
152 | |
153 | my @tables = $loader->tables; |
154 | |
155 | =cut |
156 | |
157 | sub tables { |
a4a19f3c |
158 | my $class = shift; |
3385ac62 |
159 | return sort keys %{ $class->_loader_data->{MONIKERS} }; |
a78e3fed |
160 | } |
161 | |
162 | # Overload in your driver class |
3385ac62 |
163 | sub _loader_db_classes { croak "ABSTRACT METHOD" } |
a78e3fed |
164 | |
165 | # Setup has_a and has_many relationships |
3385ac62 |
166 | sub _loader_make_relations { |
708c0939 |
167 | use Data::Dumper; |
168 | |
169 | my ( $class, $table, $other, $cond ) = @_; |
3385ac62 |
170 | my $table_class = $class->_loader_find_table_class($table); |
171 | my $other_class = $class->_loader_find_table_class($other); |
a78e3fed |
172 | |
708c0939 |
173 | my $table_relname = lc $table; |
174 | my $other_relname = lc $other; |
a78e3fed |
175 | |
3385ac62 |
176 | if(my $inflections = $class->_loader_data->{inflect}) { |
708c0939 |
177 | $table_relname = $inflections->{$table_relname} |
178 | if exists $inflections->{$table_relname}; |
a78e3fed |
179 | } |
180 | else { |
708c0939 |
181 | $table_relname = Lingua::EN::Inflect::PL($table_relname); |
182 | } |
183 | |
184 | # for single-column case, set the relname to the column name, |
185 | # to make filter accessors work |
186 | if(scalar keys %$cond == 1) { |
187 | my ($col) = keys %$cond; |
188 | $other_relname = $cond->{$col}; |
a78e3fed |
189 | } |
190 | |
708c0939 |
191 | my $rev_cond = { reverse %$cond }; |
192 | |
3385ac62 |
193 | warn qq/\# Belongs_to relationship\n/ if $class->_loader_debug; |
708c0939 |
194 | |
195 | warn qq/$table_class->belongs_to( '$other_relname' => '$other_class',/ |
196 | . Dumper($cond) |
197 | . qq/);\n\n/ |
3385ac62 |
198 | if $class->_loader_debug; |
708c0939 |
199 | |
200 | $table_class->belongs_to( $other_relname => $other_class, $cond); |
a78e3fed |
201 | |
3385ac62 |
202 | warn qq/\# Has_many relationship\n/ if $class->_loader_debug; |
a78e3fed |
203 | |
708c0939 |
204 | warn qq/$other_class->has_many( '$table_relname' => '$table_class',/ |
205 | . Dumper($rev_cond) |
206 | . qq/);\n\n/ |
3385ac62 |
207 | if $class->_loader_debug; |
708c0939 |
208 | |
209 | $other_class->has_many( $table_relname => $table_class, $rev_cond); |
a78e3fed |
210 | } |
211 | |
212 | # Load and setup classes |
3385ac62 |
213 | sub _loader_load_classes { |
a4a19f3c |
214 | my $class = shift; |
af6c2665 |
215 | |
3385ac62 |
216 | my @tables = $class->_loader_tables(); |
217 | my @db_classes = $class->_loader_db_classes(); |
218 | my $additional = join '', map "use $_;\n", @{ $class->_loader_data->{additional} }; |
a78e3fed |
219 | my $additional_base = join '', map "use base '$_';\n", |
3385ac62 |
220 | @{ $class->_loader_data->{additional_base} }; |
221 | my $left_base = join '', map "use base '$_';\n", @{ $class->_loader_data->{left_base} }; |
222 | my $constraint = $class->_loader_data->{constraint}; |
223 | my $exclude = $class->_loader_data->{exclude}; |
a78e3fed |
224 | |
a78e3fed |
225 | foreach my $table (@tables) { |
226 | next unless $table =~ /$constraint/; |
227 | next if ( defined $exclude && $table =~ /$exclude/ ); |
af6c2665 |
228 | |
af6c2665 |
229 | my ($db_schema, $tbl) = split /\./, $table; |
af96f52e |
230 | my $tablename = lc $table; |
a78e3fed |
231 | if($tbl) { |
3385ac62 |
232 | $tablename = $class->_loader_data->{drop_db_schema} ? $tbl : lc $table; |
af6c2665 |
233 | } |
234 | |
3385ac62 |
235 | my $table_moniker = $class->_loader_table2moniker($db_schema, $tbl); |
65644119 |
236 | my $table_class = "$class\::$table_moniker"; |
af6c2665 |
237 | |
a4a19f3c |
238 | $class->inject_base( $table_class, 'DBIx::Class::Core' ); |
a78e3fed |
239 | $_->require for @db_classes; |
a4a19f3c |
240 | $class->inject_base( $table_class, $_ ) for @db_classes; |
3385ac62 |
241 | warn qq/\# Initializing table "$tablename" as "$table_class"\n/ if $class->_loader_debug; |
af96f52e |
242 | $table_class->table(lc $tablename); |
af6c2665 |
243 | |
3385ac62 |
244 | my ( $cols, $pks ) = $class->_loader_table_info($table); |
a78e3fed |
245 | carp("$table has no primary key") unless @$pks; |
a4a19f3c |
246 | $table_class->add_columns(@$cols); |
247 | $table_class->set_primary_key(@$pks) if @$pks; |
af6c2665 |
248 | |
a4a19f3c |
249 | my $code = "package $table_class;\n$additional_base$additional$left_base"; |
3385ac62 |
250 | warn qq/$code/ if $class->_loader_debug; |
251 | warn qq/$table_class->table('$tablename');\n/ if $class->_loader_debug; |
a78e3fed |
252 | my $columns = join "', '", @$cols; |
3385ac62 |
253 | warn qq/$table_class->add_columns('$columns')\n/ if $class->_loader_debug; |
a78e3fed |
254 | my $primaries = join "', '", @$pks; |
3385ac62 |
255 | warn qq/$table_class->set_primary_key('$primaries')\n/ if $class->_loader_debug && @$pks; |
a78e3fed |
256 | eval $code; |
257 | croak qq/Couldn't load additional classes "$@"/ if $@; |
3385ac62 |
258 | unshift @{"$table_class\::ISA"}, $_ foreach ( @{ $class->_loader_data->{left_base} } ); |
af6c2665 |
259 | |
65644119 |
260 | $class->register_class($table_moniker, $table_class); |
3385ac62 |
261 | $class->_loader_data->{TABLE_CLASSES}->{lc $tablename} = $table_class; |
262 | $class->_loader_data->{MONIKERS}->{lc $tablename} = $table_moniker; |
a78e3fed |
263 | } |
264 | } |
265 | |
266 | # Find and setup relationships |
3385ac62 |
267 | sub _loader_relationships { |
a4a19f3c |
268 | my $class = shift; |
269 | my $dbh = $class->storage->dbh; |
708c0939 |
270 | my $quoter = $dbh->get_info(29) || q{"}; |
a4a19f3c |
271 | foreach my $table ( $class->tables ) { |
708c0939 |
272 | my $rels = {}; |
273 | my $sth = $dbh->foreign_key_info( '', |
3385ac62 |
274 | $class->_loader_data->{db_schema}, '', '', '', $table ); |
708c0939 |
275 | next if !$sth; |
276 | while(my $raw_rel = $sth->fetchrow_hashref) { |
277 | my $uk_tbl = lc $raw_rel->{UK_TABLE_NAME}; |
278 | my $uk_col = lc $raw_rel->{UK_COLUMN_NAME}; |
279 | my $fk_col = lc $raw_rel->{FK_COLUMN_NAME}; |
280 | $uk_tbl =~ s/$quoter//g; |
281 | $uk_col =~ s/$quoter//g; |
282 | $fk_col =~ s/$quoter//g; |
283 | $rels->{$uk_tbl}->{$uk_col} = $fk_col; |
284 | } |
285 | |
286 | foreach my $reltbl (keys %$rels) { |
287 | my $cond = $rels->{$reltbl}; |
3385ac62 |
288 | eval { $class->_loader_make_relations( $table, $reltbl, $cond ) }; |
708c0939 |
289 | warn qq/\# belongs_to_many failed "$@"\n\n/ |
3385ac62 |
290 | if $@ && $class->_loader_debug; |
a78e3fed |
291 | } |
292 | } |
293 | } |
294 | |
65644119 |
295 | # Make a moniker from a table |
3385ac62 |
296 | sub _loader_table2moniker { |
a4a19f3c |
297 | my ( $class, $db_schema, $table ) = @_; |
af6c2665 |
298 | |
af96f52e |
299 | my $db_schema_ns; |
af6c2665 |
300 | |
af96f52e |
301 | if($table) { |
302 | $db_schema = ucfirst lc $db_schema; |
3385ac62 |
303 | $db_schema_ns = $db_schema if(!$class->_loader_data->{drop_db_schema}); |
af96f52e |
304 | } else { |
305 | $table = $db_schema; |
a78e3fed |
306 | } |
af6c2665 |
307 | |
65644119 |
308 | my $moniker = join '', map ucfirst, split /[\W_]+/, lc $table; |
309 | $moniker = $db_schema_ns ? $db_schema_ns . $moniker : $moniker; |
af96f52e |
310 | |
65644119 |
311 | return $moniker; |
a78e3fed |
312 | } |
313 | |
314 | # Overload in driver class |
3385ac62 |
315 | sub _loader_tables { croak "ABSTRACT METHOD" } |
a78e3fed |
316 | |
3385ac62 |
317 | sub _loader_table_info { croak "ABSTRACT METHOD" } |
a78e3fed |
318 | |
319 | =head1 SEE ALSO |
320 | |
18fca96a |
321 | L<DBIx::Class::Schema::Loader> |
a78e3fed |
322 | |
323 | =cut |
324 | |
325 | 1; |