fix MySQL tests without InnoDB, use my variables instead of "use constant"
[dbsrgits/DBIx-Class-Schema-Loader.git] / lib / DBIx / Class / Schema / Loader / Base.pm
index 08a685f..2ab55bd 100644 (file)
@@ -3,6 +3,7 @@ package DBIx::Class::Schema::Loader::Base;
 use strict;
 use warnings;
 use base qw/Class::Accessor::Grouped Class::C3::Componentised/;
+use namespace::autoclean;
 use Class::C3;
 use Carp::Clan qw/^DBIx::Class/;
 use DBIx::Class::Schema::Loader::RelBuilder;
@@ -15,9 +16,11 @@ use Lingua::EN::Inflect::Number qw//;
 use File::Temp qw//;
 use Class::Unload;
 use Class::Inspector ();
+use Data::Dumper::Concise;
+use Scalar::Util 'looks_like_number';
 require DBIx::Class;
 
-our $VERSION = '0.05002';
+our $VERSION = '0.05003';
 
 __PACKAGE__->mk_group_ro_accessors('simple', qw/
                                 schema
@@ -33,6 +36,7 @@ __PACKAGE__->mk_group_ro_accessors('simple', qw/
                                 skip_relationships
                                 skip_load_external
                                 moniker_map
+                                custom_column_info
                                 inflect_singular
                                 inflect_plural
                                 debug
@@ -54,6 +58,8 @@ __PACKAGE__->mk_group_ro_accessors('simple', qw/
                                 monikers
                                 dynamic
                                 naming
+                                datetime_timezone
+                                datetime_locale
 /);
 
 
@@ -379,17 +385,49 @@ made to Loader-generated code.
 Again, you should be using version control on your schema classes.  Be
 careful with this option.
 
+=head2 custom_column_info
+
+Hook for adding extra attributes to the
+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.
+
+For example:
+
+  custom_column_info => sub {
+      my ($table_name, $column_name, $column_info) = @_;
+
+      if ($column_name eq 'dog' && $column_info->{default_value} eq 'snoopy') {
+          return { is_snoopy => 1 };
+      }
+  },
+
+This attribute can also be used to set C<inflate_datetime> on a non-datetime
+column so it also receives the L</datetime_timezone> and/or L</datetime_locale>.
+
+=head2 datetime_timezone
+
+Sets the timezone attribute for L<DBIx::Class::InflateColumn::DateTime> for all
+columns with the DATE/DATETIME/TIMESTAMP data_types.
+
+=head2 datetime_locale
+
+Sets the locale attribute for L<DBIx::Class::InflateColumn::DateTime> for all
+columns with the DATE/DATETIME/TIMESTAMP data_types.
+
 =head1 METHODS
 
 None of these methods are intended for direct invocation by regular
-users of L<DBIx::Class::Schema::Loader>.  Anything you can find here
-can also be found via standard L<DBIx::Class::Schema> methods somehow.
+users of L<DBIx::Class::Schema::Loader>. Some are proxied via
+L<DBIx::Class::Schema::Loader>.
 
 =cut
 
-use constant CURRENT_V  => 'v5';
+my $CURRENT_V = 'v5';
 
-use constant CLASS_ARGS => qw(
+my @CLASS_ARGS = qw(
     schema_base_class result_base_class additional_base_classes
     left_base_classes additional_classes components resultset_components
 );
@@ -464,11 +502,15 @@ sub new {
 
     if ($self->naming) {
         for (values %{ $self->naming }) {
-            $_ = CURRENT_V if $_ eq 'current';
+            $_ = $CURRENT_V if $_ eq 'current';
         }
     }
     $self->{naming} ||= {};
 
+    if ($self->custom_column_info && ref $self->custom_column_info ne 'CODE') {
+        croak 'custom_column_info must be a CODE ref';
+    }
+
     $self->_check_back_compat;
 
     $self->use_namespaces(1) unless defined $self->use_namespaces;
@@ -574,7 +616,7 @@ EOF
             my ($v) = $real_ver =~ /([1-9])/;
             $v = "v$v";
 
-            last if $v eq CURRENT_V || $real_ver =~ /^0\.\d\d999/;
+            last if $v eq $CURRENT_V || $real_ver =~ /^0\.\d\d999/;
 
             if (not %{ $self->naming }) {
                 warn <<"EOF" unless $ENV{SCHEMA_LOADER_BACKCOMPAT};
@@ -608,7 +650,7 @@ sub _validate_class_args {
     my $self = shift;
     my $args = shift;
     
-    foreach my $k (CLASS_ARGS) {
+    foreach my $k (@CLASS_ARGS) {
         next unless $self->$k;
 
         my @classes = ref $self->$k eq 'ARRAY' ? @{ $self->$k } : $self->$k;
@@ -1312,7 +1354,7 @@ sub _setup_src_meta {
 
     my $cols = $self->_table_columns($table);
     my $col_info;
-    eval { $col_info = $self->_columns_info_for($table) };
+    eval { $col_info = $self->__columns_info_for($table) };
     if($@) {
         $self->_dbic_stmt($table_class,'add_columns',@$cols);
     }
@@ -1356,6 +1398,21 @@ sub _setup_src_meta {
 
 }
 
+sub __columns_info_for {
+    my ($self, $table) = @_;
+
+    my $result = $self->_columns_info_for($table);
+
+    while (my ($col, $info) = each %$result) {
+        $info = { %$info, %{ $self->_custom_column_info  ($table, $col, $info) } };
+        $info = { %$info, %{ $self->_datetime_column_info($table, $col, $info) } };
+
+        $result->{$col} = $info;
+    }
+
+    return $result;
+}
+
 =head2 tables
 
 Returns a sorted list of loaded tables, using the original database table
@@ -1496,8 +1553,15 @@ sub _make_pod {
                             my $s = $attrs->{$_};
                             $s = !defined $s         ? 'undef'          :
                                   length($s) == 0     ? '(empty string)' :
-                                  ref($s) eq 'SCALAR' ? $$s              :
-                                                        $s
+                                  ref($s) eq 'SCALAR' ? $$s :
+                                  ref($s)             ? do {
+                                                        my $dd = Dumper;
+                                                        $dd->Indent(0);
+                                                        $dd->Values([$s]);
+                                                        $dd->Dump;
+                                                      } :
+                                  looks_like_number($s) ? $s :
+                                                        qq{'$s'}
                                   ;
 
                             "  $_: $s"
@@ -1561,6 +1625,27 @@ sub _quote_table_name {
 
 sub _is_case_sensitive { 0 }
 
+sub _custom_column_info {
+    my ( $self, $table_name, $column_name, $column_info ) = @_;
+
+    if (my $code = $self->custom_column_info) {
+        return $code->($table_name, $column_name, $column_info) || {};
+    }
+    return {};
+}
+
+sub _datetime_column_info {
+    my ( $self, $table_name, $column_name, $column_info ) = @_;
+    my $result = {};
+    my $type = $column_info->{data_type} || '';
+    if ((grep $_, @{ $column_info }{map "inflate_$_", qw/date datetime timestamp/})
+            or ($type =~ /date|timestamp/i)) {
+        $result->{timezone} = $self->datetime_timezone if $self->datetime_timezone;
+        $result->{locale}   = $self->datetime_locale   if $self->datetime_locale;
+    }
+    return $result;
+}
+
 # remove the dump dir from @INC on destruction
 sub DESTROY {
     my $self = shift;