update docs for callbacks receiving table objects
[dbsrgits/DBIx-Class-Schema-Loader.git] / lib / DBIx / Class / Schema / Loader / Base.pm
index 3b74da4..31ba4ef 100644 (file)
@@ -25,11 +25,10 @@ use Try::Tiny;
 use DBIx::Class ();
 use Encode qw/encode decode/;
 use List::MoreUtils qw/all firstidx/;
-use IPC::Open2;
-use Symbol 'gensym';
+use File::Temp 'tempfile';
 use namespace::clean;
 
-our $VERSION = '0.07010';
+our $VERSION = '0.07011';
 
 __PACKAGE__->mk_group_ro_accessors('simple', qw/
                                 schema
@@ -59,6 +58,7 @@ __PACKAGE__->mk_group_ro_accessors('simple', qw/
                                 result_base_class
                                 result_roles
                                 use_moose
+                                only_autoclean
                                 overwrite_modifications
 
                                 relationship_attrs
@@ -262,9 +262,12 @@ L<String::ToIdentifier::EN::Unicode> or L<String::ToIdentifier::EN> if
 L</force_ascii> is set; this is only significant for names with non-C<\w>
 characters such as C<.>.
 
+CamelCase identifiers with words in all caps, e.g. C<VLANValidID> are supported
+correctly in this mode.
+
 For relationships, belongs_to accessors are made from column names by stripping
-postfixes other than C<_id> as well, just C<id>, C<_?ref>, C<_?cd>, C<_?code>
-and C<_num>.
+postfixes other than C<_id> as well, for example just C<Id>, C<_?ref>, C<_?cd>,
+C<_?code> and C<_?num>, case insensitively.
 
 =item preserve
 
@@ -457,12 +460,12 @@ Exclude tables matching regex.  Best specified as a qr// regex.
 
 =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 single scalar table name argument and returning
-a scalar moniker.  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.
+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
+and returning a scalar moniker.  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
 boundaries, singularize the resulting phrase, then join the titlecased words
@@ -486,7 +489,7 @@ passed, the code is called with arguments of
    {
       table_class     => name of the DBIC class we are building,
       table_moniker   => calculated moniker for this table (after moniker_map if present),
-      table_name      => name of the database table,
+      table           => table object of interface DBIx::Class::Schema::Loader::Table,
       full_table_name => schema-qualified name of the database table (RDBMS specific),
       schema_class    => name of the schema class we are building,
       column_info     => hashref of column info (data_type, is_nullable, etc),
@@ -681,12 +684,13 @@ L<column_info|DBIx::Class::ResultSource/column_info> for a column.
 
 Must be a coderef that returns a hashref with the extra attributes.
 
-Receives the table name, column name and column_info.
+Receives the L<table object|DBIx::Class::Schema::Loader::Table>, column name
+and column_info.
 
 For example:
 
   custom_column_info => sub {
-      my ($table_name, $column_name, $column_info) = @_;
+      my ($table, $column_name, $column_info) = @_;
 
       if ($column_name eq 'dog' && $column_info->{default_value} eq 'snoopy') {
           return { is_snoopy => 1 };
@@ -722,29 +726,48 @@ loader options.
 
 =head2 preserve_case
 
-Usually column names are lowercased, to make them easier to work with in
-L<DBIx::Class>. This option lets you turn this behavior off, if the driver
-supports it.
+Normally database names are lowercased and split by underscore, use this option
+if you have CamelCase database names.
 
 Drivers for case sensitive databases like Sybase ASE or MSSQL with a
 case-sensitive collation will turn this option on unconditionally.
 
-Currently the drivers for SQLite, mysql, MSSQL and Firebird/InterBase support
-setting this option.
+B<NOTE:> L</naming> = C<v8> is highly recommended with this option as the
+semantics of this mode are much improved for CamelCase database names.
+
+L</naming> = C<v7> or greater is required with this option.
 
 =head2 qualify_objects
 
 Set to true to prepend the L</db_schema> to table names for C<<
 __PACKAGE__->table >> calls, and to some other things like Oracle sequences.
 
+This attribute is automatically set to true for multi db_schema configurations.
+
 =head2 use_moose
 
 Creates Schema and Result classes that use L<Moose>, L<MooseX::NonMoose> and
-L<namespace::autoclean>. The default content after the md5 sum also makes the
-classes immutable.
+L<MooseX::MarkAsMethods> (or L<namespace::autoclean>, see below). The default
+content after the md5 sum also makes the classes immutable.
 
 It is safe to upgrade your existing Schema to this option.
 
+=head2 only_autoclean
+
+By default, we use L<MooseX::MarkAsMethods> to remove imported functions from
+your generated classes.  It uses L<namespace::autoclean> to do this, after
+telling your object's metaclass that any operator L<overload>s in your class
+are methods, which will cause namespace::autoclean to spare them from removal.
+
+This prevents the "Hey, where'd my overloads go?!" effect.
+
+If you don't care about operator overloads, enabling this option falls back to
+just using L<namespace::autoclean> itself.
+
+If none of the above made any sense, or you don't have some pressing need to
+only use L<namespace::autoclean>, leaving this set to the default is
+recommended.
+
 =head2 col_collision_map
 
 This option controls how accessors for column names which collide with perl
@@ -970,7 +993,7 @@ sub new {
 
     if ($self->naming) {
         foreach my $key (qw/relationships monikers column_accessors/) {
-            $self->naming->{$key} = $CURRENT_V if $self->naming->{$key} eq 'current';
+            $self->naming->{$key} = $CURRENT_V if ($self->naming->{$key}||'') eq 'current';
         }
     }
     $self->{naming} ||= {};
@@ -1649,8 +1672,15 @@ sub _dump_to_dir {
         . qq|# Created by DBIx::Class::Schema::Loader\n|
         . qq|# DO NOT MODIFY THE FIRST PART OF THIS FILE\n\n|;
 
+    my $autoclean
+        = $self->only_autoclean
+        ? 'namespace::autoclean'
+        : 'MooseX::MarkAsMethods autoclean => 1'
+        ;
+
     if ($self->use_moose) {
-        $schema_text.= qq|use Moose;\nuse namespace::autoclean;\nextends '$schema_base_class';\n\n|;
+
+        $schema_text.= qq|use Moose;\nuse $autoclean;\nextends '$schema_base_class';\n\n|;
     }
     else {
         $schema_text .= qq|use strict;\nuse warnings;\n\nuse base '$schema_base_class';\n\n|;
@@ -1708,7 +1738,7 @@ sub _dump_to_dir {
             unless $result_base_class eq 'DBIx::Class::Core';
 
         if ($self->use_moose) {
-            $src_text.= qq|use Moose;\nuse MooseX::NonMoose;\nuse namespace::autoclean;|;
+            $src_text.= qq|use Moose;\nuse MooseX::NonMoose;\nuse $autoclean;|;
 
             # these options 'use base' which is compile time
             if (@{ $self->left_base_classes } || @{ $self->additional_base_classes }) {
@@ -1775,17 +1805,13 @@ sub _write_classfile {
 
     my $custom_content = $old_custom || '';
 
-    # prepend extra custom content from a *renamed* class (singularization effect)
+    # Use custom content from a renamed class, the class names in it are
+    # rewritten below.
     if (my $renamed_class = $self->_upgrading_classes->{$class}) {
         my $old_filename = $self->_get_dump_filename($renamed_class);
 
         if (-f $old_filename) {
-            my $extra_custom = ($self->_parse_generated_file ($old_filename))[4];
-
-            $extra_custom =~ s/\n\n# You can replace.*\n1;\n//;
-
-            $custom_content = join ("\n", '', $extra_custom, $custom_content)
-                if $extra_custom;
+            $custom_content = ($self->_parse_generated_file ($old_filename))[4];
 
             unlink $old_filename;
         }
@@ -1830,23 +1856,26 @@ sub _write_classfile {
             );
         }
         else {
-            my ($out, $in) = (gensym, gensym);
+            my ($fh, $temp_file) = tempfile();
 
-            my $pid = open2($out, $in, $filter)
-                or croak "Could not open pipe to $filter: $!";
-
-            print $in $text;
+            binmode $fh, ':encoding(UTF-8)';
+            print $fh $text;
+            close $fh;
 
-            close $in;
+            open my $out, qq{$filter < "$temp_file"|}
+                or croak "Could not open pipe to $filter: $!";
 
             $text = decode('UTF-8', do { local $/; <$out> });
 
             $text =~ s/$CR?$LF/\n/g;
 
-            waitpid $pid, 0;
+            close $out;
 
             my $exit_code = $? >> 8;
 
+            unlink $temp_file
+                or croak "Could not remove temporary file '$temp_file': $!";
+
             if ($exit_code != 0) {
                 croak "filter '$filter' exited non-zero: $exit_code";
             }
@@ -2185,20 +2214,27 @@ sub _run_user_map {
 sub _default_column_accessor_name {
     my ( $self, $column_name ) = @_;
 
-    my $accessor_name = $self->_to_identifier('column_accessors', $column_name, '_');
+    my $preserve = ($self->naming->{column_accessors}||'') eq 'preserve';
+
+    my $v = $self->_get_naming_v('column_accessors');
+
+    my $accessor_name = $preserve ?
+        $self->_to_identifier('column_accessors', $column_name) # assume CamelCase
+        :
+        $self->_to_identifier('column_accessors', $column_name, '_');
 
     $accessor_name =~ s/\W+/_/g; # only if naming < v8, otherwise to_identifier
                                  # takes care of it
 
-    if ((($self->naming->{column_accessors}||'') =~ /(\d+)/ && $1 < 7) || (not $self->preserve_case)) {
+    if ($preserve) {
+        return $accessor_name;
+    }
+    elsif ($v < 7 || (not $self->preserve_case)) {
         # older naming just lc'd the col accessor and that's all.
         return lc $accessor_name;
     }
-    elsif (($self->naming->{column_accessors}||'') eq 'preserve') {
-        return $accessor_name;
-    }
 
-    return join '_', map lc, split_name $column_name;
+    return join '_', map lc, split_name $column_name, $v;
 }
 
 sub _make_column_accessor_name {
@@ -2347,23 +2383,38 @@ sub tables {
     return values %{$self->_tables};
 }
 
+sub _get_naming_v {
+    my ($self, $naming_key) = @_;
+
+    my $v;
+
+    if (($self->naming->{$naming_key}||'') =~ /^v(\d+)\z/) {
+        $v = $1;
+    }
+    else {
+        ($v) = $CURRENT_V =~ /^v(\d+)\z/;
+    }
+
+    return $v;
+}
+
 sub _to_identifier {
-    my ($self, $naming_key, $name, $sep_char) = @_;
+    my ($self, $naming_key, $name, $sep_char, $force) = @_;
 
-    my ($v) = ($self->naming->{$naming_key}||$CURRENT_V) =~ /^v(\d+)\z/;
+    my $v = $self->_get_naming_v($naming_key);
 
     my $to_identifier = $self->naming->{force_ascii} ?
         \&String::ToIdentifier::EN::to_identifier
         : \&String::ToIdentifier::EN::Unicode::to_identifier;
 
-    return $v >= 8 ? $to_identifier->($name, $sep_char) : $name;
+    return $v >= 8 || $force ? $to_identifier->($name, $sep_char) : $name;
 }
 
 # Make a moniker from a table
 sub _default_table2moniker {
     my ($self, $table) = @_;
 
-    my ($v) = ($self->naming->{monikers}||$CURRENT_V) =~ /^v(\d+)\z/;
+    my $v = $self->_get_naming_v('monikers');
 
     my @name_parts = map $table->$_, @{ $self->moniker_parts };
 
@@ -2375,14 +2426,17 @@ sub _default_table2moniker {
         my $part = $name_parts[$i];
 
         if ($i != $name_idx || $v >= 8) {
-            $part = $self->_to_identifier->('monikers', $part, '_');
+            $part = $self->_to_identifier('monikers', $part, '_', 1);
         }
 
         if ($i == $name_idx && $v == 5) {
             $part = Lingua::EN::Inflect::Number::to_S($part);
         }
 
-        my @part_parts = map lc, $v > 6 ? split_name $part : split /[\W_]+/, $part;
+        my @part_parts = map lc, $v > 6 ?
+            # use v8 semantics for all moniker parts except name
+            ($i == $name_idx ? split_name $part, $v : split_name $part)
+            : split /[\W_]+/, $part;
 
         if ($i == $name_idx && $v >= 6) {
             my $as_phrase = join ' ', @part_parts;
@@ -2765,7 +2819,7 @@ If you use the loader on a database with table and column names in a language
 other than English, you will want to turn off the English language specific
 heuristics.
 
-To do so, use something like this in your laoder options:
+To do so, use something like this in your loader options:
 
     naming           => { monikers => 'v4' },
     inflect_singular => sub { "$_[0]_rel" },
@@ -2800,7 +2854,7 @@ You can also control the renaming with the L</rel_collision_map> option.
 
 =head1 SEE ALSO
 
-L<DBIx::Class::Schema::Loader>
+L<DBIx::Class::Schema::Loader>, L<dbicdump>
 
 =head1 AUTHOR