root/branches/release-26/lib/MT/ObjectDriver/Driver/DBD/Pg.pm @ 1174

Revision 1174, 3.8 kB (checked in by bchoate, 23 months ago)

Updated copyright year for source.

  • Property svn:keywords set to Id Revision
Line 
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
7package MT::ObjectDriver::Driver::DBD::Pg;
8
9use strict;
10use warnings;
11
12use base qw(
13    MT::ObjectDriver::Driver::DBD::Legacy
14    Data::ObjectDriver::Driver::DBD::Pg
15    MT::ErrorHandler
16);
17
18sub sql_class {
19    require MT::ObjectDriver::SQL::Pg;
20    return 'MT::ObjectDriver::SQL::Pg';
21}
22
23sub ddl_class {
24    require MT::ObjectDriver::DDL::Pg;
25    return 'MT::ObjectDriver::DDL::Pg';
26}
27
28sub 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
38sub 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
44sub db2ts {
45    my $ts = $_[1];
46    $ts =~ s/(?:\+|-)\d{2}$//;
47    $ts =~ tr/\- ://d;
48    return $ts;
49}
50
51sub 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
60sub 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
88sub _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
126sub 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
141sub 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
1521;
Note: See TracBrowser for help on using the browser.