Merge branch 'master' into custom_column_info

[dbsrgits/DBIx-Class-Schema-Loader.git] / lib / DBIx / Class / Schema / Loader / Base.pm

diff --git a/lib/DBIx/Class/Schema/Loader/Base.pm b/lib/DBIx/Class/Schema/Loader/Base.pm
index 75b1459..4f57523 100644 (file)
--- a/lib/DBIx/Class/Schema/Loader/Base.pm
+++ b/lib/DBIx/Class/Schema/Loader/Base.pm
@@ -14,9 +14,10 @@ use Digest::MD5 qw//;
 use Lingua::EN::Inflect::Number qw//;
 use File::Temp qw//;
 use Class::Unload;
+use Class::Inspector ();
 require DBIx::Class;
 
-our $VERSION = '0.04999_14';
+our $VERSION = '0.05002';
 
 __PACKAGE__->mk_group_ro_accessors('simple', qw/
                                 schema
@@ -32,6 +33,7 @@ __PACKAGE__->mk_group_ro_accessors('simple', qw/
                                 skip_relationships
                                 skip_load_external
                                 moniker_map
+                                custom_column_info
                                 inflect_singular
                                 inflect_plural
                                 debug
@@ -53,6 +55,8 @@ __PACKAGE__->mk_group_ro_accessors('simple', qw/
                                 monikers
                                 dynamic
                                 naming
+                                datetime_timezone
+                                datetime_locale
 /);
 
 
@@ -378,6 +382,54 @@ 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
+
+Must be a coderef, returing a hashref with the custom column informations.
+
+Example:
+
+    custom_column_info => sub {
+        my $info = shift;
+        # Example from $info hashref:
+        # $info = {
+        #           'DECIMAL_DIGITS' => undef,
+        #           'COLUMN_DEF' => undef,
+        #           'TABLE_CAT' => undef,
+        #           'NUM_PREC_RADIX' => undef,
+        #           'TABLE_SCHEM' => 'TESTS',
+        #           'BUFFER_LENGTH' => '8',
+        #           'CHAR_OCTET_LENGTH' => undef,
+        #           'IS_NULLABLE' => 'NO',
+        #           'REMARKS' => undef,
+        #           'COLUMN_SIZE' => '8',
+        #           'ORDINAL_POSITION' => '1',
+        #           'COLUMN_NAME' => 'LOADER_TEST9',
+        #           'TYPE_NAME' => 'VARCHAR2',
+        #           'NULLABLE' => '0',
+        #           'DATA_TYPE' => '12',
+        #           'TABLE_NAME' => 'LOADER_TEST9',
+        #           'SQL_DATA_TYPE' => '12',
+        #           'SQL_DATETIME_SUB' => undef
+        #         };
+        
+        if ( $info->{TYPE_NAME} eq 'DATE' ){
+            return { timezone => "Europe/Berlin" };
+        }
+        return;
+    }
+
+Add to all columns with type DATE the attribute timezone => "Europe/Berlin". 
+
+=head2 datetime_timezone
+
+Set timezone attribute for L<DBIx::Class::InflateColumn::DateTime> 
+to all columns with the type DATE.
+
+=head2 datetime_locale
+
+Set local attribute for L<DBIx::Class::InflateColumn::DateTime> 
+to all columns with the type DATE.
+
 =head1 METHODS
 
 None of these methods are intended for direct invocation by regular
@@ -386,7 +438,12 @@ can also be found via standard L<DBIx::Class::Schema> methods somehow.
 
 =cut
 
-use constant CURRENT_V => 'v5';
+use constant CURRENT_V  => 'v5';
+
+use constant CLASS_ARGS => qw(
+    schema_base_class result_base_class additional_base_classes
+    left_base_classes additional_classes components resultset_components
+);
 
 # ensure that a peice of object data is a valid arrayref, creating
 # an empty one or encapsulating whatever's there.
@@ -421,6 +478,8 @@ sub new {
                                resultset_components
                               /);
 
+    $self->_validate_class_args;
+
     push(@{$self->{components}}, 'ResultSetManager')
         if @{$self->{resultset_components}};
 
@@ -596,14 +655,43 @@ EOF
     close $fh;
 }
 
+sub _validate_class_args {
+    my $self = shift;
+    my $args = shift;
+    
+    foreach my $k (CLASS_ARGS) {
+        next unless $self->$k;
+
+        my @classes = ref $self->$k eq 'ARRAY' ? @{ $self->$k } : $self->$k;
+        foreach my $c (@classes) {
+            # components default to being under the DBIx::Class namespace unless they
+            # are preceeded with a '+'
+            if ( $k =~ m/components$/ && $c !~ s/^\+// ) {
+                $c = 'DBIx::Class::' . $c;
+            }
+
+            # 1 == installed, 0 == not installed, undef == invalid classname
+            my $installed = Class::Inspector->installed($c);
+            if ( defined($installed) ) {
+                if ( $installed == 0 ) {
+                    croak qq/$c, as specified in the loader option "$k", is not installed/;
+                }
+            } else {
+                croak qq/$c, as specified in the loader option "$k", is an invalid class name/;
+            }
+        }
+    }
+}
+
 sub _find_file_in_inc {
     my ($self, $file) = @_;
 
     foreach my $prefix (@INC) {
         my $fullpath = File::Spec->catfile($prefix, $file);
         return $fullpath if -f $fullpath
-            and Cwd::abs_path($fullpath) ne
-               (Cwd::abs_path(File::Spec->catfile($self->dump_directory, $file)) || '');
+            # abs_path throws on Windows for nonexistant files
+            and eval { Cwd::abs_path($fullpath) } ne
+               (eval { Cwd::abs_path(File::Spec->catfile($self->dump_directory, $file)) } || '');
     }
 
     return;
@@ -1457,9 +1545,11 @@ sub _make_pod {
            $self->_pod( $class,
                         join "\n", map {
                             my $s = $attrs->{$_};
-                            $s = !defined $s      ? 'undef'          :
-                                 length($s) == 0  ? '(empty string)' :
-                                                     $s;
+                            $s = !defined $s         ? 'undef'          :
+                                  length($s) == 0     ? '(empty string)' :
+                                  ref($s) eq 'SCALAR' ? $$s              :
+                                                        $s
+                                  ;
 
                             "  $_: $s"
                         } sort keys %$attrs,
@@ -1522,6 +1612,32 @@ sub _quote_table_name {
 
 sub _is_case_sensitive { 0 }
 
+sub _custom_column_info {
+    my ( $self, $table_name, $column_name, $column_info ) = @_;
+
+    if( ref $self->custom_column_info eq 'CODE' ) {
+        return $self->custom_column_info->( $table_name, $column_name, $column_info );
+    }
+    return {};
+}
+
+sub _datetime_column_info {
+    my ( $self, $table_name, $column_name, $column_info ) = @_;
+    my $return = {};
+    my $type = lc ( $column_info->{data_type} );
+    if (
+        ( defined $column_info->{inflate_datetime} and $column_info->{inflate_datetime} )
+        or ( defined $column_info->{inflate_date} and $column_info->{inflate_date} )
+        or ( $type eq 'date')
+        or ( $type eq 'datetime')
+        or ( $type eq 'timestamp')
+    ){
+        $return->{timezone} = $self->datetime_timezone if $self->datetime_timezone;
+        $return->{locale}   = $self->datetime_locale if $self->datetime_locale;
+    }
+    return $return;
+}
+
 # remove the dump dir from @INC on destruction
 sub DESTROY {
     my $self = shift;