| 1 | # Movable Type (r) Open Source (C) 2001-2008 Six Apart, Ltd. |
|---|
| 2 | # This program is distributed under the terms of the |
|---|
| 3 | # GNU General Public License, version 2. |
|---|
| 4 | # |
|---|
| 5 | # $Id$ |
|---|
| 6 | |
|---|
| 7 | package MT::ObjectDriver::Driver::DBD::Pg; |
|---|
| 8 | |
|---|
| 9 | use strict; |
|---|
| 10 | use warnings; |
|---|
| 11 | |
|---|
| 12 | use base qw( |
|---|
| 13 | MT::ObjectDriver::Driver::DBD::Legacy |
|---|
| 14 | Data::ObjectDriver::Driver::DBD::Pg |
|---|
| 15 | MT::ErrorHandler |
|---|
| 16 | ); |
|---|
| 17 | |
|---|
| 18 | sub sql_class { |
|---|
| 19 | require MT::ObjectDriver::SQL::Pg; |
|---|
| 20 | return 'MT::ObjectDriver::SQL::Pg'; |
|---|
| 21 | } |
|---|
| 22 | |
|---|
| 23 | sub ddl_class { |
|---|
| 24 | require MT::ObjectDriver::DDL::Pg; |
|---|
| 25 | return 'MT::ObjectDriver::DDL::Pg'; |
|---|
| 26 | } |
|---|
| 27 | |
|---|
| 28 | sub dsn_from_config { |
|---|
| 29 | my $dbd = shift; |
|---|
| 30 | my $dsn = $dbd->SUPER::dsn_from_config(@_); |
|---|
| 31 | my ($cfg) = @_; |
|---|
| 32 | $dsn .= ':dbname=' . $cfg->Database; |
|---|
| 33 | $dsn .= ';host=' . $cfg->DBHost if $cfg->DBHost; |
|---|
| 34 | $dsn .= ';port=' . $cfg->DBPort if $cfg->DBPort; |
|---|
| 35 | return $dsn; |
|---|
| 36 | } |
|---|
| 37 | |
|---|
| 38 | sub ts2db { |
|---|
| 39 | my $ts = sprintf '%04d-%02d-%02d %02d:%02d:%02d', unpack 'A4A2A2A2A2A2', $_[1]; |
|---|
| 40 | $ts = undef if $ts eq '0000-00-00 00:00:00'; |
|---|
| 41 | return $ts; |
|---|
| 42 | } |
|---|
| 43 | |
|---|
| 44 | sub db2ts { |
|---|
| 45 | my $ts = $_[1]; |
|---|
| 46 | $ts =~ s/(?:\+|-)\d{2}$//; |
|---|
| 47 | $ts =~ tr/\- ://d; |
|---|
| 48 | return $ts; |
|---|
| 49 | } |
|---|
| 50 | |
|---|
| 51 | sub configure { |
|---|
| 52 | my $dbd = shift; |
|---|
| 53 | my ($driver) = @_; |
|---|
| 54 | $dbd->_set_names($driver); |
|---|
| 55 | $driver->pk_generator(\&pk_generator); |
|---|
| 56 | |
|---|
| 57 | return $dbd; |
|---|
| 58 | } |
|---|
| 59 | |
|---|
| 60 | sub pk_generator { |
|---|
| 61 | my $obj = shift; # not a method |
|---|
| 62 | my $driver = UNIVERSAL::isa($obj, 'MT::Object') |
|---|
| 63 | ? $obj->driver |
|---|
| 64 | : MT::Object->driver; |
|---|
| 65 | my $seq = $driver->dbd->sequence_name(ref $obj); |
|---|
| 66 | my $dbh = $driver->rw_handle; |
|---|
| 67 | my $sth = $dbh->prepare("SELECT NEXTVAL('$seq')") |
|---|
| 68 | or die UNIVERSAL::isa($obj, 'MT::ErrorHandler') |
|---|
| 69 | ? $obj->error($dbh->errstr) |
|---|
| 70 | : $dbh->errstr; |
|---|
| 71 | $sth->execute |
|---|
| 72 | or die UNIVERSAL::isa($obj, 'MT::ErrorHandler') |
|---|
| 73 | ? $obj->error($dbh->errstr) |
|---|
| 74 | : $dbh->errstr; |
|---|
| 75 | $sth->bind_columns(undef, \my($id)); |
|---|
| 76 | $sth->fetch; |
|---|
| 77 | $sth->finish; |
|---|
| 78 | |
|---|
| 79 | my $col = $obj->properties->{primary_key}; |
|---|
| 80 | ## If it's a complex primary key, use the second half. |
|---|
| 81 | if(ref $col) { |
|---|
| 82 | $col = $col->[1]; |
|---|
| 83 | } |
|---|
| 84 | $obj->$col($id); |
|---|
| 85 | return $id; |
|---|
| 86 | } |
|---|
| 87 | |
|---|
| 88 | sub _set_names { |
|---|
| 89 | my $dbd = shift; |
|---|
| 90 | my ($driver) = @_; |
|---|
| 91 | my $dbh = $driver->r_handle; |
|---|
| 92 | return 1 if exists $driver->{set_names}; |
|---|
| 93 | |
|---|
| 94 | my $cfg = MT->config; |
|---|
| 95 | my $set_names = $cfg->SQLSetNames; |
|---|
| 96 | $driver->{set_names} = 1; |
|---|
| 97 | return 1 if (defined $set_names) && !$set_names; |
|---|
| 98 | |
|---|
| 99 | my $c = lc $cfg->PublishCharset; |
|---|
| 100 | my %Charset = ( 'utf-8' => 'UNICODE', |
|---|
| 101 | 'shift_jis' => 'SJIS', |
|---|
| 102 | 'euc-jp' => 'EUC_JP', |
|---|
| 103 | #'iso-8859-1' => 'LATIN1' |
|---|
| 104 | ); |
|---|
| 105 | $c = $Charset{$c} ? $Charset{$c} : $c; |
|---|
| 106 | eval { |
|---|
| 107 | local $@; |
|---|
| 108 | if (!$dbh->do("SET NAMES '" . $c . "'")) { |
|---|
| 109 | # 'set names' command isn't working for this verison of mysql, |
|---|
| 110 | # assign SQLSetNames to 0 to prevent further errors. |
|---|
| 111 | $cfg->SQLSetNames(0, 1); |
|---|
| 112 | $cfg->save_config; |
|---|
| 113 | return 0; |
|---|
| 114 | } else { |
|---|
| 115 | if (!defined $set_names) { |
|---|
| 116 | # SQLSetNames has never been assigned; we had a successful |
|---|
| 117 | # 'SET NAMES' command, so it's safe to SET NAMES in the future. |
|---|
| 118 | $cfg->SQLSetNames(1, 1); |
|---|
| 119 | $cfg->save_config; |
|---|
| 120 | } |
|---|
| 121 | } |
|---|
| 122 | }; |
|---|
| 123 | return 1; |
|---|
| 124 | } |
|---|
| 125 | |
|---|
| 126 | sub sequence_name { |
|---|
| 127 | my $dbd = shift; |
|---|
| 128 | my($class) = @_; |
|---|
| 129 | |
|---|
| 130 | my $key = $class->properties->{primary_key}; |
|---|
| 131 | ## If it's a complex primary key, use the second half. |
|---|
| 132 | if(ref $key) { |
|---|
| 133 | $key = $key->[1]; |
|---|
| 134 | } |
|---|
| 135 | |
|---|
| 136 | # mt_tablename_columnname |
|---|
| 137 | return join '_', 'mt', |
|---|
| 138 | $dbd->db_column_name(MT::Object->driver->table_for($class), $key); |
|---|
| 139 | } |
|---|
| 140 | |
|---|
| 141 | sub bind_param_attributes { |
|---|
| 142 | my ($dbd, $data_type) = @_; |
|---|
| 143 | my $t = ref($data_type) eq 'HASH' |
|---|
| 144 | ? $data_type->{type} |
|---|
| 145 | : $data_type; |
|---|
| 146 | if ($t eq 'blob') { |
|---|
| 147 | return { pg_type => DBD::Pg::PG_BYTEA() }; |
|---|
| 148 | } |
|---|
| 149 | return; |
|---|
| 150 | } |
|---|
| 151 | |
|---|
| 152 | 1; |
|---|