Allow coderef maps to call back into the hashref mapping code
[dbsrgits/DBIx-Class-Schema-Loader.git] / lib / DBIx / Class / Schema / Loader / Base.pm
index 87c62a4..1304c1c 100644 (file)
@@ -20,7 +20,7 @@ use File::Temp ();
 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 ();
@@ -29,7 +29,7 @@ use List::MoreUtils qw/all any firstidx uniq/;
 use File::Temp 'tempfile';
 use namespace::clean;
 
-our $VERSION = '0.07036_02';
+our $VERSION = '0.07037';
 
 __PACKAGE__->mk_group_ro_accessors('simple', qw/
                                 schema
@@ -110,6 +110,7 @@ __PACKAGE__->mk_group_accessors('simple', qw/
                                 qualify_objects
                                 moniker_parts
                                 moniker_part_separator
+                                moniker_part_map
 /);
 
 my $CURRENT_V = 'v7';
@@ -602,6 +603,11 @@ 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
 
+The function is also passed a coderef that can be called with either
+of the hashref forms to get the moniker mapped accordingly.  This is
+useful if you need to handle some monikers specially, but want to use
+the hashref form for the rest.
+
 =back
 
 If the hash entry does not exist, or the function returns a false
@@ -619,6 +625,26 @@ together. Examples:
     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>, plus a coderef similar to the one
+described in L</moniker_map>.
+
+L</moniker_map> takes precedence over this.
+
 =head2 col_accessor_map
 
 Same as moniker_map, but for column accessor names.  If a coderef is
@@ -634,6 +660,7 @@ passed, the code is called with arguments of
       schema_class    => name of the schema class we are building,
       column_info     => hashref of column info (data_type, is_nullable, etc),
    }
+   coderef ref that can be called with a hashref map
 
 the L<table object|DBIx::Class::Schema::Loader::Table> stringifies to the
 unqualified table name.
@@ -660,7 +687,7 @@ instance, you could have
 and relationships that would have been named C<bar> will now be named C<baz>
 except that in the table whose moniker is C<Foo> it will be named C<blat>.
 
-If it is a coderef, the argument passed will be a hashref of this form:
+If it is a coderef, it will be passed a hashref of this form:
 
     {
         name           => default relationship name,
@@ -677,6 +704,8 @@ If it is a coderef, the argument passed will be a hashref of this form:
         link_rel_name  => name of the relationship to the link table
     }
 
+In addition it is passed a coderef that can be called with a hashref map.
+
 DBICSL will try to use the value returned as the relationship name.
 
 =head2 inflect_plural
@@ -1229,6 +1258,9 @@ sub new {
     if (not defined $self->moniker_part_separator) {
         $self->moniker_part_separator('');
     }
+    if (not defined $self->moniker_part_map) {
+        $self->moniker_part_map({}),
+    }
 
     return $self;
 }
@@ -1421,6 +1453,8 @@ sub _find_file_in_inc {
 
     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
@@ -2419,7 +2453,13 @@ sub _run_user_map {
         }
     }
     elsif( $map && ref $map eq 'CODE' ) {
-        $new_ident = $map->( $ident, $default_ident, @extra );
+        my $cb = sub {
+            my ($cb_map) = @_;
+            croak "reentered map must be a hashref"
+                unless 'HASH' eq ref($cb_map);
+            return $self->_run_user_map($cb_map, $default_code, $ident, @extra);
+        };
+        $new_ident = $map->( $ident, $default_ident, @extra, $cb );
     }
 
     $new_ident ||= $default_ident;
@@ -2466,6 +2506,11 @@ sub _make_column_accessor_name {
     return $accessor;
 }
 
+sub _table_is_view {
+    #my ($self, $table) = @_;
+    return 0;
+}
+
 # Set up metadata (cols, pks, etc)
 sub _setup_src_meta {
     my ($self, $table) = @_;
@@ -2476,6 +2521,9 @@ sub _setup_src_meta {
     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);
@@ -2633,7 +2681,8 @@ sub _default_table2moniker {
 
     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 };
 
@@ -2642,6 +2691,16 @@ sub _default_table2moniker {
     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);
         }