support for unicode Firebird data types

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

diff --git a/lib/DBIx/Class/Schema/Loader/DBI/InterBase.pm b/lib/DBIx/Class/Schema/Loader/DBI/InterBase.pm
index c5cfb2a..8490859 100644 (file)
--- a/lib/DBIx/Class/Schema/Loader/DBI/InterBase.pm
+++ b/lib/DBIx/Class/Schema/Loader/DBI/InterBase.pm
@@ -2,13 +2,13 @@ package DBIx::Class::Schema::Loader::DBI::InterBase;
 
 use strict;
 use warnings;
-use namespace::autoclean;
-use Class::C3;
+use mro 'c3';
 use base qw/DBIx::Class::Schema::Loader::DBI/;
 use Carp::Clan qw/^DBIx::Class/;
 use List::Util 'first';
+use namespace::clean;
 
-our $VERSION = '0.07000';
+our $VERSION = '0.07010';
 
 =head1 NAME
 
@@ -192,7 +192,7 @@ EOF
 
 # fix up types
         $sth = $dbh->prepare(<<'EOF');
-SELECT f.rdb$field_precision, f.rdb$field_scale, f.rdb$field_type, f.rdb$field_sub_type, t.rdb$type_name, st.rdb$type_name
+SELECT f.rdb$field_precision, f.rdb$field_scale, f.rdb$field_type, f.rdb$field_sub_type, f.rdb$character_set_id, f.rdb$character_length, t.rdb$type_name, st.rdb$type_name
 FROM rdb$fields f
 JOIN rdb$relation_fields rf ON rf.rdb$field_source = f.rdb$field_name
 LEFT JOIN rdb$types t  ON f.rdb$field_type     = t.rdb$type  AND t.rdb$field_name  = 'RDB$FIELD_TYPE'
@@ -201,7 +201,7 @@ WHERE rf.rdb$relation_name = ?
     AND rf.rdb$field_name  = ?
 EOF
         $sth->execute($table, $self->_uc($column));
-        my ($precision, $scale, $type_num, $sub_type_num, $type_name, $sub_type_name) = $sth->fetchrow_array;
+        my ($precision, $scale, $type_num, $sub_type_num, $char_set_id, $char_length, $type_name, $sub_type_name) = $sth->fetchrow_array;
         $scale = -$scale if $scale && $scale < 0;
 
         if ($type_name && $sub_type_name) {
@@ -225,7 +225,12 @@ EOF
                     $info->{data_type} = 'blob';
                 }
                 elsif ($sub_type_name eq 'TEXT') {
-                    $info->{data_type} = 'blob sub_type text';
+                    if ($char_set_id == 3) {
+                        $info->{data_type} = 'blob sub_type text character set unicode_fss';
+                    }
+                    else {
+                        $info->{data_type} = 'blob sub_type text';
+                    }
                 }
             }
         }
@@ -254,16 +259,22 @@ EOF
         elsif ($info->{data_type} eq 'character') {
             $info->{data_type} = 'char';
         }
+        elsif ($info->{data_type} eq 'float') {
+            $info->{data_type} = 'real';
+        }
         elsif ($info->{data_type} eq 'int64' || $info->{data_type} eq '-9581') {
             # the constant is just in case, the query should pick up the type
             $info->{data_type} = 'bigint';
         }
 
-        # DBD::InterBase sets scale to '0' for some reason for char types
-        if ($info->{data_type} =~ /^(?:char|varchar)\z/ && ref($info->{size}) eq 'ARRAY') {
-            $info->{size} = $info->{size}[0];
+        if ($info->{data_type} =~ /^(?:char|varchar)\z/) {
+            $info->{size} = $char_length;
+
+            if ($char_set_id == 3) {
+                $info->{data_type} .= '(x) character set unicode_fss';
+            }
         }
-        elsif ($info->{data_type} !~ /^(?:char|varchar|numeric|decimal)\z/) {
+        elsif ($info->{data_type} !~ /^(?:numeric|decimal)\z/) {
             delete $info->{size};
         }
 
@@ -284,7 +295,7 @@ EOF
                 $info->{default_value} = $quoted;
             }
             else {
-                $info->{default_value} = $def =~ /^\d/ ? $def : \$def;
+                $info->{default_value} = $def =~ /^-?\d/ ? $def : \$def;
             }
         }