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