lib/DBIx/Class/Schema/Loader/DBI/ODBC/Firebird.pm

   1 package DBIx::Class::Schema::Loader::DBI::ODBC::Firebird;
   2
   3 use strict;
   4 use warnings;
   5 use base qw/
   6     DBIx::Class::Schema::Loader::DBI::ODBC
   7     DBIx::Class::Schema::Loader::DBI::InterBase
   8 /;
   9 use Carp::Clan qw/^DBIx::Class/;
  10 use mro 'c3';
  11
  12 our $VERSION = '0.07010';
  13
  14 =head1 NAME
  15
  16 DBIx::Class::Schema::Loader::DBI::ODBC::Firebird - ODBC wrapper for
  17 L<DBIx::Class::Schema::Loader::DBI::InterBase>
  18
  19 =head1 DESCRIPTION
  20
  21 Proxy for L<DBIx::Class::Schema::Loader::DBI::InterBase> when using L<DBD::ODBC>.
  22
  23 See L<DBIx::Class::Schema::Loader::Base> for usage information.
  24
  25 =cut
  26
  27 # Some (current) versions of the ODBC driver have a bug where ->type_info breaks
  28 # with "data truncated". This "fixes" it, but some type names are truncated.
  29 sub _dbh_type_info_type_name {
  30     my ($self, $type_num) = @_;
  31
  32     my $dbh = $self->schema->storage->dbh;
  33
  34     local $dbh->{LongReadLen} = 100_000;
  35     local $dbh->{LongTruncOk} = 1;
  36
  37     my $type_info = $dbh->type_info($type_num);
  38
  39     return undef if not $type_info;
  40
  41     my $type_name = $type_info->{TYPE_NAME};
  42
  43     # fix up truncated type names
  44     if ($type_name eq "VARCHAR(x) CHARACTER SET UNICODE_\0") {
  45         return 'VARCHAR(x) CHARACTER SET UNICODE_FSS';
  46     }
  47     elsif ($type_name eq "BLOB SUB_TYPE TEXT CHARACTER SET \0") {
  48         return 'BLOB SUB_TYPE TEXT CHARACTER SET UNICODE_FSS';
  49     }
  50
  51     return $type_name;
  52 }
  53
  54 =head1 SEE ALSO
  55
  56 L<DBIx::Class::Schema::Loader::DBI::InterBase>,
  57 L<DBIx::Class::Schema::Loader>, L<DBIx::Class::Schema::Loader::Base>,
  58 L<DBIx::Class::Schema::Loader::DBI>
  59
  60 =head1 AUTHOR
  61
  62 See L<DBIx::Class::Schema::Loader/AUTHOR> and L<DBIx::Class::Schema::Loader/CONTRIBUTORS>.
  63
  64 =head1 LICENSE
  65
  66 This library is free software; you can redistribute it and/or modify it under
  67 the same terms as Perl itself.
  68
  69 =cut
  70
  71 1;