use Class::Unload;
use Class::Inspector ();
use Scalar::Util 'looks_like_number';
-use DBIx::Class::Schema::Loader::Utils qw/split_name dumper_squashed eval_package_without_redefine_warnings class_path slurp_file/;
+use DBIx::Class::Schema::Loader::Utils qw/split_name dumper_squashed eval_package_without_redefine_warnings class_path slurp_file sigwarn_silencer/;
use DBIx::Class::Schema::Loader::Optional::Dependencies ();
use Try::Tiny;
use DBIx::Class ();
use File::Temp 'tempfile';
use namespace::clean;
-our $VERSION = '0.07036';
+our $VERSION = '0.07036_04';
__PACKAGE__->mk_group_ro_accessors('simple', qw/
schema
qualify_objects
moniker_parts
moniker_part_separator
+ moniker_part_map
/);
my $CURRENT_V = 'v7';
=head2 constraint
-Only load tables matching regex. Best specified as a qr// regex.
+Only load matching tables.
=head2 exclude
-Exclude tables matching regex. Best specified as a qr// regex.
+Exclude matching tables.
+
+These can be specified either as a regex (preferrably on the C<qr//>
+form), or as an arrayref of arrayrefs. Regexes are matched against
+the (unqualified) table name, while arrayrefs are matched according to
+L</moniker_parts>.
+
+For example:
+
+ db_schema => [qw(some_schema other_schema)],
+ moniker_parts => [qw(schema name)],
+ constraint => [
+ [ qr/\Asome_schema\z/ => qr/\A(?:foo|bar)\z/ ],
+ [ qr/\Aother_schema\z/ => qr/\Abaz\z/ ],
+ ],
+
+In this case only the tables C<foo> and C<bar> in C<some_schema> and
+C<baz> in C<other_schema> will be dumped.
=head2 moniker_map
-Overrides the default table name to moniker translation. Can be either a
-hashref of table keys and moniker values, or a coderef for a translator
-function taking a L<table object|DBIx::Class::Schema::Loader::Table> argument
-(which stringifies to the unqualified table name) and returning a scalar
-moniker. If the hash entry does not exist, or the function returns a false
+Overrides the default table name to moniker translation. Either
+
+=over
+
+=item *
+
+a nested hashref, which will be traversed according to L</moniker_parts>
+
+For example:
+
+ moniker_parts => [qw(schema name)],
+ moniker_map => {
+ foo => {
+ bar => "FooishBar",
+ },
+ },
+
+In which case the table C<bar> in the C<foo> schema would get the moniker
+C<FooishBar>.
+
+=item *
+
+a hashref of unqualified table name keys and moniker values
+
+=item *
+
+a coderef for a translator function taking a L<table
+object|DBIx::Class::Schema::Loader::Table> argument (which stringifies to the
+unqualified table name) and returning a scalar moniker
+
+=back
+
+If the hash entry does not exist, or the function returns a false
value, the code falls back to default behavior for that table name.
The default behavior is to split on case transition and non-alphanumeric
stations_visited | StationVisited
routeChange | RouteChange
+=head2 moniker_part_map
+
+Map for overriding the monikerization of individual L</moniker_parts>.
+The keys are the moniker part to override, the value is either a
+hashref of coderef for mapping the corresponding part of the
+moniker. If a coderef is used, it gets called with the moniker part
+and the hash key the code ref was found under.
+
+For example:
+
+ moniker_part_map => {
+ schema => sub { ... },
+ },
+
+Given the table C<foo.bar>, the code ref would be called with the
+arguments C<foo> and C<schema>.
+
+L</moniker_map> takes precedence over this.
+
=head2 col_accessor_map
Same as moniker_map, but for column accessor names. If a coderef is
if (not defined $self->moniker_part_separator) {
$self->moniker_part_separator('');
}
+ if (not defined $self->moniker_part_map) {
+ $self->moniker_part_map({}),
+ }
return $self;
}
foreach my $prefix (@INC) {
my $fullpath = File::Spec->catfile($prefix, $file);
+ # abs_path pure-perl fallback warns for non-existent files
+ local $SIG{__WARN__} = sigwarn_silencer(qr/^stat\(.*\Q$file\E\)/);
return $fullpath if -f $fullpath
# abs_path throws on Windows for nonexistent files
and (try { Cwd::abs_path($fullpath) }) ne
my $default_ident = $default_code->( $ident, @extra );
my $new_ident;
if( $map && ref $map eq 'HASH' ) {
- $new_ident = $map->{ $ident };
+ if (my @parts = try{ @{ $ident } }) {
+ my $part_map = $map;
+ while (@parts) {
+ my $part = shift @parts;
+ last unless exists $part_map->{ $part };
+ if ( !ref $part_map->{ $part } && !@parts ) {
+ $new_ident = $part_map->{ $part };
+ last;
+ }
+ elsif ( ref $part_map->{ $part } eq 'HASH' ) {
+ $part_map = $part_map->{ $part };
+ }
+ }
+ }
+ if( !$new_ident && !ref $map->{ $ident } ) {
+ $new_ident = $map->{ $ident };
+ }
}
elsif( $map && ref $map eq 'CODE' ) {
$new_ident = $map->( $ident, $default_ident, @extra );
return $accessor;
}
+sub _table_is_view {
+ #my ($self, $table) = @_;
+ return 0;
+}
+
# Set up metadata (cols, pks, etc)
sub _setup_src_meta {
my ($self, $table) = @_;
my $table_class = $self->classes->{$table->sql_name};
my $table_moniker = $self->monikers->{$table->sql_name};
+ $self->_dbic_stmt($table_class, 'table_class', 'DBIx::Class::ResultSource::View')
+ if $self->_table_is_view($table);
+
$self->_dbic_stmt($table_class, 'table', $table->dbic_name);
my $cols = $self->_table_columns($table);
my $v = $self->_get_naming_v('monikers');
- my @name_parts = map $table->$_, @{ $self->moniker_parts };
+ my @moniker_parts = @{ $self->moniker_parts };
+ my @name_parts = map $table->$_, @moniker_parts;
my $name_idx = firstidx { $_ eq 'name' } @{ $self->moniker_parts };
foreach my $i (0 .. $#name_parts) {
my $part = $name_parts[$i];
+ my $moniker_part = $self->_run_user_map(
+ $self->moniker_part_map->{$moniker_parts[$i]},
+ sub { '' },
+ $part, $moniker_parts[$i],
+ );
+ if (length $moniker_part) {
+ push @all_parts, $moniker_part;
+ next;
+ }
+
if ($i != $name_idx || $v >= 8) {
$part = $self->_to_identifier('monikers', $part, '_', 1);
}
projects / dbsrgits/DBIx-Class-Schema-Loader.git / blobdiff