| DBIx-Class-Loader documentation | Contained in the DBIx-Class-Loader distribution. |
DBIx::Class::Loader::Generic - Generic DBIx::Class::Loader Implementation.
Available constructor options are:
List of additional base classes your table classes will use.
List of additional base classes, that need to be leftmost.
List of additional classes which your table classes will use.
Only load tables matching regex.
Exclude tables matching regex.
Enable debug messages.
DBI Data Source Name.
Namespace under which your table classes will be initialized.
Password.
Try to automatically detect/setup has_a and has_many relationships.
An hashref, which contains exceptions to Lingua::EN::Inflect::PL(). Useful for foreign language column names.
Username.
Not intended to be called directly. This is used internally by the
new() method in DBIx::Class::Loader.
Returns a tables class.
my $class = $loader->find_class($table);
Returns a sorted list of classes.
my $@classes = $loader->classes;
Overload to enable debug messages.
Returns a sorted list of tables.
my @tables = $loader->tables;
| DBIx-Class-Loader documentation | Contained in the DBIx-Class-Loader distribution. |
package DBIx::Class::Loader::Generic; use strict; use base 'DBIx::Class::Componentised'; use Carp; use Lingua::EN::Inflect; use UNIVERSAL::require; require DBIx::Class::DB; require DBIx::Class::Core;
sub new { my ( $class, %args ) = @_; if ( $args{debug} ) { no strict 'refs'; *{"$class\::debug"} = sub { 1 }; } my $additional = $args{additional_classes} || []; $additional = [$additional] unless ref $additional eq 'ARRAY'; my $additional_base = $args{additional_base_classes} || []; $additional_base = [$additional_base] unless ref $additional_base eq 'ARRAY'; my $left_base = $args{left_base_classes} || []; $left_base = [$left_base] unless ref $left_base eq 'ARRAY'; my $self = bless { _datasource => [ $args{dsn}, $args{user}, $args{password}, $args{options} ], _namespace => $args{namespace}, _additional => $additional, _additional_base => $additional_base, _left_base => $left_base, _constraint => $args{constraint} || '.*', _exclude => $args{exclude}, _relationships => $args{relationships}, _inflect => $args{inflect}, _schema => $args{schema} ||'', _dropschema => $args{dropschema}, CLASSES => {}, }, $class; warn qq/\### START DBIx::Class::Loader dump ###\n/ if $self->debug; my $dbclass = $self->_load_classes; $self->_relationships if $self->{_relationships}; warn qq/\### END DBIx::Class::Loader dump ###\n/ if $self->debug; $dbclass->storage->dbh->disconnect; $self; }
sub find_class { my ( $self, $table ) = @_; return $self->{CLASSES}->{$table}; }
sub classes { my $self = shift; return sort values %{ $self->{CLASSES} }; }
sub debug { 0 }
sub tables { my $self = shift; return sort keys %{ $self->{CLASSES} }; } # Overload in your driver class sub _db_classes { croak "ABSTRACT METHOD" } # Setup has_a and has_many relationships sub _belongs_to_many { my ( $self, $table, $column, $other, $other_column ) = @_; my $table_class = $self->find_class($table); my $other_class = $self->find_class($other); warn qq/\# Belongs_to relationship\n/ if $self->debug; if($other_column) { warn qq/$table_class->belongs_to( '$column' => '$other_class',/ . qq/ { "foreign.$other_column" => "self.$column" },/ . qq/ { accessor => 'filter' });\n\n/ if $self->debug; $table_class->belongs_to( $column => $other_class, { "foreign.$other_column" => "self.$column" }, { accessor => 'filter' } ); } else { warn qq/$table_class->belongs_to( '$column' => '$other_class' );\n\n/ if $self->debug; $table_class->belongs_to( $column => $other_class ); } my ($table_class_base) = $table_class =~ /.*::(.+)/; my $plural = Lingua::EN::Inflect::PL( lc $table_class_base ); $plural = $self->{_inflect}->{ lc $table_class_base } if $self->{_inflect} and exists $self->{_inflect}->{ lc $table_class_base }; warn qq/\# Has_many relationship\n/ if $self->debug; if($other_column) { warn qq/$other_class->has_many( '$plural' => '$table_class',/ . qq/ { "foreign.$column" => "self.$other_column" } );\n\n/ if $self->debug; $other_class->has_many( $plural => $table_class, { "foreign.$column" => "self.$other_column" } ); } else { warn qq/$other_class->has_many( '$plural' => '$table_class',/ . qq/'$other_column' );\n\n/ if $self->debug; $other_class->has_many( $plural => $table_class, $column ); } } # Load and setup classes sub _load_classes { my $self = shift; my @schema = ('schema' => $self->{_schema}) if($self->{_schema}); my @db_classes = $self->_db_classes(); my $additional = join '', map "use $_;\n", @{ $self->{_additional} }; my $additional_base = join '', map "use base '$_';\n", @{ $self->{_additional_base} }; my $left_base = join '', map "use base '$_';\n", @{ $self->{_left_base} }; my $constraint = $self->{_constraint}; my $exclude = $self->{_exclude}; my $namespace = $self->{_namespace}; my $dbclass = "$namespace\::_db"; $self->inject_base( $dbclass, 'DBIx::Class::DB' ); $dbclass->connection( @{ $self->{_datasource} } ); $self->{storage} = $dbclass->storage; my @tables = $self->_tables(@schema); foreach my $table (@tables) { next unless $table =~ /$constraint/; next if ( defined $exclude && $table =~ /$exclude/ ); my ($schema, $tbl) = split /\./, $table; my $tablename = lc $table; if($tbl) { $tablename = $self->{_dropschema} ? $tbl : lc $table; } my $class = $self->_table2class($schema, $tbl); $self->inject_base( $class, $dbclass, 'DBIx::Class::Core' ); $_->require for @db_classes; $self->inject_base( $class, $_ ) for @db_classes; my $code = "package $class;\n$additional_base$additional$left_base"; eval $code; croak qq/Couldn't load additional classes "$@"/ if $@; # force a C3 re-init via inject_base, for the above new bases $self->inject_base( $class ); warn qq/\# Initializing table "$table" as "$class"\n/ if $self->debug; $class->table(lc $tablename); my ( $cols, $pks ) = $self->_table_info($table); carp("$table has no primary key") unless @$pks; $class->add_columns(@$cols); $class->set_primary_key(@$pks) if @$pks; $self->{CLASSES}->{lc $tablename} = $class; warn qq/$class->table('$tablename');\n/ if $self->debug; my $columns = join "', '", @$cols; warn qq/$class->add_columns('$columns')\n/ if $self->debug; my $primaries = join "', '", @$pks; warn qq/$class->set_primary_key('$primaries')\n/ if $self->debug && @$pks; } return $dbclass; } # Find and setup relationships sub _relationships { my $self = shift; foreach my $table ( $self->tables ) { my $dbh = $self->{storage}->dbh; my $quoter = $dbh->get_info(29) || q{"}; if ( my $sth = $dbh->foreign_key_info( '', $self->{schema}, '', '', '', $table ) ) { for my $res ( @{ $sth->fetchall_arrayref( {} ) } ) { my $column = lc $res->{FK_COLUMN_NAME}; my $other = lc $res->{UK_TABLE_NAME}; my $other_column = lc $res->{UK_COLUMN_NAME}; $column =~ s/$quoter//g; $other =~ s/$quoter//g; $other_column =~ s/$quoter//g; eval { $self->_belongs_to_many( $table, $column, $other, $other_column ) }; warn qq/\# belongs_to_many failed "$@"\n\n/ if $@ && $self->debug; } } } } # Make a class from a table sub _table2class { my ( $self, $schema, $table ) = @_; my $namespace = $self->{_namespace} || ""; $namespace =~ s/(.*)::$/$1/; if($table) { $schema = ucfirst lc $schema; $namespace .= "::$schema" if(!$self->{_dropschema}); } else { $table = $schema; } my $subclass = join '', map ucfirst, split /[\W_]+/, lc $table; my $class = $namespace ? "$namespace\::" . $subclass : $subclass; } # Overload in driver class sub _tables { croak "ABSTRACT METHOD" } sub _table_info { croak "ABSTRACT METHOD" }
1;