| ... | ... |
@@ -19,6 +19,8 @@ sub data_source : ClassObjectAttr { initialize => {clone => 'scalar'} }
|
| 19 | 19 |
sub dbi_options : ClassObjectAttr { initialize => {clone => 'hash',
|
| 20 | 20 |
default => sub { {} } } }
|
| 21 | 21 |
sub database : ClassObjectAttr { initialize => {clone => 'scalar'} }
|
| 22 |
+sub host : ClassObjectAttr { initialize => {clone => 'scalar'} }
|
|
| 23 |
+sub port : ClassObjectAttr { initialize => {clone => 'scalar'} }
|
|
| 22 | 24 |
|
| 23 | 25 |
sub bind_filter : ClassObjectAttr { initialize => {clone => 'scalar'} }
|
| 24 | 26 |
sub fetch_filter : ClassObjectAttr { initialize => {clone => 'scalar'} }
|
| ... | ... |
@@ -812,6 +814,18 @@ Please tell me bug if you find |
| 812 | 814 |
$self = $dbi->database($database); |
| 813 | 815 |
$database = $dbi->database; |
| 814 | 816 |
|
| 817 |
+=head2 host |
|
| 818 |
+ |
|
| 819 |
+ # Set and get host name |
|
| 820 |
+ $self = $dbi->host($host); |
|
| 821 |
+ $host = $dbi->host; |
|
| 822 |
+ |
|
| 823 |
+=head2 port |
|
| 824 |
+ |
|
| 825 |
+ # Set and get port |
|
| 826 |
+ $self = $dbi->port($port); |
|
| 827 |
+ $port = $dbi->port; |
|
| 828 |
+ |
|
| 815 | 829 |
This method will be used in subclass connect method. |
| 816 | 830 |
|
| 817 | 831 |
=head2 dbi_options |
| ... | ... |
@@ -17,8 +17,19 @@ $class->add_format( |
| 17 | 17 |
sub connect {
|
| 18 | 18 |
my $self = shift; |
| 19 | 19 |
|
| 20 |
- if (!$self->data_source && (my $database = $self->database)) {
|
|
| 21 |
- $self->data_source("dbi:mysql:dbname=$database");
|
|
| 20 |
+ if (!$self->data_source) {
|
|
| 21 |
+ my $database = $self->database; |
|
| 22 |
+ my $host = $self->host; |
|
| 23 |
+ my $port = $self->port; |
|
| 24 |
+ |
|
| 25 |
+ my $data_source = "dbi:mysql:"; |
|
| 26 |
+ my $data_source_original = $data_source; |
|
| 27 |
+ $data_source .= "database=$database;" if $database; |
|
| 28 |
+ $data_source .= "host=$host;" if $host; |
|
| 29 |
+ $data_source .= "port=$port;" if $port; |
|
| 30 |
+ |
|
| 31 |
+ $data_source =~ s/:$// if $data_source eq $data_source_original; |
|
| 32 |
+ $self->data_source($data_source); |
|
| 22 | 33 |
} |
| 23 | 34 |
|
| 24 | 35 |
return $self->SUPER::connect; |
| ... | ... |
@@ -10,8 +10,19 @@ my $class = __PACKAGE__; |
| 10 | 10 |
sub connect {
|
| 11 | 11 |
my $self = shift; |
| 12 | 12 |
|
| 13 |
- if (!$self->data_source && (my $database = $self->database)) {
|
|
| 14 |
- $self->data_source("dbi:Pg:dbname=$database");
|
|
| 13 |
+ if (!$self->data_source) {
|
|
| 14 |
+ my $database = $self->database; |
|
| 15 |
+ my $host = $self->host; |
|
| 16 |
+ my $port = $self->port; |
|
| 17 |
+ |
|
| 18 |
+ my $data_source = "dbi:Pg:"; |
|
| 19 |
+ my $data_source_original = $data_source; |
|
| 20 |
+ $data_source .= "dbname=$database;" if $database; |
|
| 21 |
+ $data_source .= "host=$host;" if $host; |
|
| 22 |
+ $data_source .= "port=$port;" if $port; |
|
| 23 |
+ |
|
| 24 |
+ $data_source =~ s/:$// if $data_source eq $data_source_original; |
|
| 25 |
+ $self->data_source($data_source); |
|
| 15 | 26 |
} |
| 16 | 27 |
|
| 17 | 28 |
return $self->SUPER::connect; |