0.02002 release, added moniker_map and inflect_map args

diff --git a/Changes b/Changes
index d63c584..8dbdd06 100644 (file)
--- a/Changes
+++ b/Changes
@@ -1,5 +1,8 @@
 Revision history for Perl extension DBIx::Class::Schema::Loader
 
+0.02002 Sat Feb 18 19:53:12 UTC 2006
+        - Added moniker_map and inflect_map
+
 0.02001 Fri Feb 17 20:25:40 UTC 2006
         - tests fixed up a bit
         - auto-loading of on-disk class definitions layered on top

diff --git a/META.yml b/META.yml
index dddc392..dbec74e 100644 (file)
--- a/META.yml
+++ b/META.yml
@@ -1,6 +1,6 @@
 ---
 name: DBIx-Class-Schema-Loader
-version: 0.02001
+version: 0.02002
 author:
   - 'Brandon Black, C<blblack@gmail.com>'
 abstract: Dynamic definition of a DBIx::Class::Schema
@@ -20,7 +20,7 @@ build_requires:
 provides:
   DBIx::Class::Schema::Loader:
     file: lib/DBIx/Class/Schema/Loader.pm
-    version: 0.02001
+    version: 0.02002
   DBIx::Class::Schema::Loader::DB2:
     file: lib/DBIx/Class/Schema/Loader/DB2.pm
   DBIx::Class::Schema::Loader::Generic:

diff --git a/README b/README
index 99ac7dd..ef4f9a9 100644 (file)
--- a/README
+++ b/README
@@ -6,6 +6,12 @@ SYNOPSIS
       package My::Schema;
       use base qw/DBIx::Class::Schema::Loader/;
 
+      sub _monikerize {
+          my $name = shift;
+          $name = join '', map ucfirst, split /[\W_]+/, lc $name;
+          $name;
+      }
+
       __PACKAGE__->load_from_connection(
         dsn                     => "dbi:mysql:dbname",
         user                    => "root",
@@ -18,7 +24,8 @@ SYNOPSIS
         constraint              => '^foo.*',
         relationships           => 1,
         options                 => { AutoCommit => 1 }, 
-        inflect                 => { child => 'children' },
+        inflect_map             => { child => 'children' },
+        moniker_map             => \&_monikerize,
         debug                   => 1,
       );
 

diff --git a/lib/DBIx/Class/Schema/Loader.pm b/lib/DBIx/Class/Schema/Loader.pm
index b43b316..633c34f 100644 (file)
--- a/lib/DBIx/Class/Schema/Loader.pm
+++ b/lib/DBIx/Class/Schema/Loader.pm
@@ -10,7 +10,7 @@ use UNIVERSAL::require;
 # Always remember to do all digits for the version even if they're 0
 # i.e. first release of 0.XX *must* be 0.XX000. This avoids fBSD ports
 # brain damage and presumably various other packaging systems too
-our $VERSION = '0.02001';
+our $VERSION = '0.02002';
 
 __PACKAGE__->mk_classaccessor('loader');
 
@@ -23,6 +23,12 @@ DBIx::Class::Schema::Loader - Dynamic definition of a DBIx::Class::Schema
   package My::Schema;
   use base qw/DBIx::Class::Schema::Loader/;
 
+  sub _monikerize {
+      my $name = shift;
+      $name = join '', map ucfirst, split /[\W_]+/, lc $name;
+      $name;
+  }
+
   __PACKAGE__->load_from_connection(
     dsn                     => "dbi:mysql:dbname",
     user                    => "root",
@@ -35,7 +41,8 @@ DBIx::Class::Schema::Loader - Dynamic definition of a DBIx::Class::Schema
     constraint              => '^foo.*',
     relationships           => 1,
     options                 => { AutoCommit => 1 }, 
-    inflect                 => { child => 'children' },
+    inflect_map             => { child => 'children' },
+    moniker_map             => \&_monikerize,
     debug                   => 1,
   );
 

diff --git a/lib/DBIx/Class/Schema/Loader/Generic.pm b/lib/DBIx/Class/Schema/Loader/Generic.pm
index cabe7ca..bdb5d95 100644 (file)
--- a/lib/DBIx/Class/Schema/Loader/Generic.pm
+++ b/lib/DBIx/Class/Schema/Loader/Generic.pm
@@ -26,7 +26,8 @@ __PACKAGE__->mk_ro_accessors(qw/
                                 components
                                 resultset_components
                                 relationships
-                                inflect
+                                inflect_map
+                                moniker_map
                                 db_schema
                                 drop_db_schema
                                 debug
@@ -100,10 +101,25 @@ Password.
 
 Try to automatically detect/setup has_a and has_many relationships.
 
+=head2 moniker_map
+
+Overrides the default tablename -> moniker translation.  Can be either
+a hashref of table => moniker names, or a coderef for a translator
+function taking a single scalar table name argument and returning
+a scalar moniker.  If the hash entry does not exist, or the function
+returns a false/undef value, the code falls back to default behavior
+for that table name.
+
+=head2 inflect_map
+
+Just like L</moniker_map> above, but for inflecting (pluralizing)
+relationship names.
+
 =head2 inflect
 
-An hashref, which contains exceptions to Lingua::EN::Inflect::PL().
-Useful for foreign language column names.
+Deprecated.  Equivalent to L</inflect_map>, but previously only took
+a hashref argument, not a coderef.  If you set C<inflect> to anything,
+that setting will be copied to L</inflect_map>.
 
 =head2 user
 
@@ -141,7 +157,6 @@ sub new {
 
     $self->{db_schema}  ||= '';
     $self->{constraint} ||= '.*';
-    $self->{inflect}    ||= {};
     $self->_ensure_arrayref(qw/additional_classes
                                additional_base_classes
                                left_base_classes
@@ -154,6 +169,9 @@ sub new {
     $self->{monikers} = {};
     $self->{classes} = {};
 
+    # Support deprecated argument name
+    $self->{inflect_map} ||= $self->{inflect};
+
     $self;
 }
 
@@ -187,11 +205,18 @@ sub load {
 sub _db_classes { croak "ABSTRACT METHOD" }
 
 # Inflect a relationship name
-#   XXX (should pluralize, but currently also tends to de-pluralize plurals)
 sub _inflect_relname {
     my ($self, $relname) = @_;
 
-    return $self->inflect->{$relname} if exists $self->inflect->{$relname};
+    if( ref $self->{inflect_map} eq 'HASH' ) {
+        return $self->inflect_map->{$relname}
+            if exists $self->inflect_map->{$relname};
+    }
+    elsif( ref $self->{inflect_map} eq 'CODE' ) {
+        my $inflected = $self->inflect_map->($relname);
+        return $inflected if $inflected;
+    }
+
     return Lingua::EN::Inflect::PL($relname);
 }
 
@@ -421,7 +446,17 @@ sub _table2moniker {
         $table = $db_schema;
     }
 
-    my $moniker = join '', map ucfirst, split /[\W_]+/, lc $table;
+    my $moniker;
+
+    if( ref $self->moniker_map eq 'HASH' ) {
+        $moniker = $self->moniker_map->{$table};
+    }
+    elsif( ref $self->moniker_map eq 'CODE' ) {
+        $moniker = $self->moniker_map->($table);
+    }
+
+    $moniker ||= join '', map ucfirst, split /[\W_]+/, lc $table;
+
     $moniker = $db_schema_ns ? $db_schema_ns . $moniker : $moniker;
 
     return $moniker;

diff --git a/t/lib/dbixcsl_common_tests.pm b/t/lib/dbixcsl_common_tests.pm
index d1d3d48..ca96d45 100644 (file)
--- a/t/lib/dbixcsl_common_tests.pm
+++ b/t/lib/dbixcsl_common_tests.pm
@@ -34,10 +34,16 @@ sub skip_tests {
     plan skip_all => $why;
 }
 
+sub _monikerize {
+    my $name = shift;
+    return 'LoaderTest2X' if $name =~ /^loader_test2$/i;
+    return undef;
+}
+
 sub run_tests {
     my $self = shift;
 
-    plan tests => 49;
+    plan tests => 50;
 
     $self->create();
 
@@ -56,6 +62,8 @@ sub run_tests {
         left_base_classes       => [ qw/TestLeftBase/ ],
         components              => [ qw/TestComponent/ ],
         resultset_components    => [ qw/TestRSComponent/ ],
+        inflect_map             => { loader_test4 => 'loader_test4zes' },
+        moniker_map             => \&_monikerize,
         debug                   => $debug,
     );
 
@@ -85,6 +93,8 @@ sub run_tests {
     isa_ok( $rsobj1, "DBIx::Class::ResultSet" );
     isa_ok( $rsobj2, "DBIx::Class::ResultSet" );
 
+    is($moniker2, 'LoaderTest2X', "moniker_map testing");
+
     {
         my ($skip_tab, $skip_tabo, $skip_taba, $skip_cmeth,
             $skip_rsmeth, $skip_tcomp, $skip_trscomp);
@@ -96,10 +106,10 @@ sub run_tests {
         can_ok( $rsobj1, 'dbix_class_testrscomponent' ) or $skip_trscomp = 1;
         can_ok( $class1, 'loader_test1_classmeth' ) or $skip_cmeth = 1;
 
-       TODO: {
-           local $TODO = "Not yet supported by ResultSetManger code";
+        TODO: {
+            local $TODO = "Not yet supported by ResultSetManger code";
             can_ok( $rsobj1, 'loader_test1_rsmeth' ) or $skip_rsmeth = 1;
-       }
+        }
 
         SKIP: {
             skip "Pre-requisite test failed", 1 if $skip_tab;
@@ -197,7 +207,7 @@ sub run_tests {
         isa_ok( $obj4->fkid, $class3);
 
         my $obj3 = $rsobj3->find(1);
-        my $rs_rel4 = $obj3->search_related('loader_test4s');
+        my $rs_rel4 = $obj3->search_related('loader_test4zes');
         isa_ok( $rs_rel4->first, $class4);
 
         # fk def in comments should not be parsed