lib/DBIx/Class/Schema/Loader/DBI/Sybase/Common.pm

   1 package DBIx::Class::Schema::Loader::DBI::Sybase::Common;
   2
   3 use strict;
   4 use warnings;
   5 use base 'DBIx::Class::Schema::Loader::DBI';
   6 use Carp::Clan qw/^DBIx::Class/;
   7 use mro 'c3';
   8
   9 our $VERSION = '0.07001';
  10
  11 =head1 NAME
  12
  13 DBIx::Class::Schema::Loader::DBI::Sybase::Common - Common methods for Sybase
  14 and MSSQL
  15
  16 =head1 DESCRIPTION
  17
  18 See L<DBIx::Class::Schema::Loader> and L<DBIx::Class::Schema::Loader::Base>.
  19
  20 =cut
  21
  22 # DBD::Sybase doesn't implement get_info properly
  23 sub _build_quoter  { '"' }
  24 sub _build_namesep { '.' }
  25
  26 sub _setup {
  27     my $self = shift;
  28
  29     $self->next::method(@_);
  30
  31     $self->schema->storage->sql_maker->quote_char([qw/[ ]/]);
  32     $self->schema->storage->sql_maker->name_sep('.');
  33     $self->{db_schema} ||= $self->_build_db_schema;
  34 }
  35
  36 sub _build_db_schema {
  37     my $self = shift;
  38     my $dbh  = $self->schema->storage->dbh;
  39
  40     local $dbh->{FetchHashKeyName} = 'NAME_lc';
  41
  42     my $test_table = "_loader_test_$$";
  43
  44     my $db_schema = 'dbo'; # default
  45
  46     eval {
  47         $dbh->do("create table $test_table (id integer)");
  48         my $sth = $dbh->prepare('sp_tables');
  49         $sth->execute;
  50         while (my $row = $sth->fetchrow_hashref) {
  51             next unless $row->{table_name} eq $test_table;
  52
  53             $db_schema = $row->{table_owner};
  54             last;
  55         }
  56         $sth->finish;
  57         $dbh->do("drop table $test_table");
  58     };
  59     my $exception = $@;
  60     eval { $dbh->do("drop table $test_table") };
  61     carp "Could not determine db_schema, defaulting to $db_schema : $exception"
  62         if $exception;
  63
  64     return $db_schema;
  65 }
  66
  67 # remove 'IDENTITY' from column data_type
  68 sub _columns_info_for {
  69     my $self   = shift;
  70     my $result = $self->next::method(@_);
  71
  72     foreach my $col (keys %$result) {
  73         $result->{$col}->{data_type} =~ s/\s* identity \s*//ix;
  74     }
  75
  76     return $result;
  77 }
  78
  79 =head1 SEE ALSO
  80
  81 L<DBIx::Class::Schema::Loader::DBI::Sybase>,
  82 L<DBIx::Class::Schema::Loader::DBI::MSSQL>,
  83 L<DBIx::Class::Schema::Loader::DBI::ODBC::Microsoft_SQL_Server>,
  84 L<DBIx::Class::Schema::Loader::DBI::Sybase::Microsoft_SQL_Server>,
  85 L<DBIx::Class::Schema::Loader::DBI>
  86 L<DBIx::Class::Schema::Loader>, L<DBIx::Class::Schema::Loader::Base>,
  87
  88 =head1 AUTHOR
  89
  90 See L<DBIx::Class::Schema::Loader/AUTHOR> and L<DBIx::Class::Schema::Loader/CONTRIBUTORS>.
  91
  92 =head1 LICENSE
  93
  94 This library is free software; you can redistribute it and/or modify it under
  95 the same terms as Perl itself.
  96
  97 =cut
  98
  99 1;