blob: 80575a634c02883bb9a6d5a5955eba473dccd384 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
|
#-*- perl -*-
#
# Copyright (C) 2000 Ken'ichi Fukamachi
# All rights reserved.
#
# $Id$
#
package IO::Adapter::DBI;
use strict;
use vars qw(@ISA @EXPORT @EXPORT_OK $AUTOLOAD);
use Carp;
use ErrorMessages::Status qw(error_set error error_clear);
=head1 NAME
IO::Adapter::DBI - DBI
=head1 SYNOPSIS
=head1 DESCRIPTION
This module is a top level driver to talk with a DBI server in SQL
(Structured Query Language).
The model dependent SQL statement is expected to be holded in
C<SQL::Schema::> modules.
Each model name is specified at $args->{ schema } in new($args).
=head1 METHODS
=cut
sub make_dsn
{
my ($self, $args) = @_;
my $driver = $args->{ driver };
my $database = $args->{ database };
my $host = $args->{ host };
return "DBI:$driver:$database:$host";
}
=head2 C<execute($args)>
execute sql query.
$args->{
query => sql_query_statment,
};
=cut
sub execute
{
my ($self, $args) = @_;
my $dbh = $self->{ _dbh };
my $query = $args->{ query };
if (defined $dbh) {
my $res = $dbh->prepare($query);
if (defined $res) {
$res->execute;
$self->{ _res } = $res;
return $res;
}
else {
$self->error_set( $DBI::errstr );
return undef;
}
}
else {
$self->error_set( $DBI::errstr );
return undef;
}
}
=head2 C<open($args)>
=head2 C<close($args)>
=cut
# Descriptions:
# Arguments: $self $args
# Side Effects:
# Return Value: none
sub open
{
my ($self, $args) = @_;
use DBI;
use DBD::mysql;
my $dsn = $self->{ _dsn };
my $user = $self->{ _user } || 'fml';
my $password = $self->{_user_password} || '';
# try to connect
my $dbh = DBI->connect($dsn, $user, $password);
unless (defined $dbh) {
$self->error_set( $DBI::errstr );
return undef;
}
$self->{ _dbh } = $dbh;
}
# Descriptions:
# Arguments: $self $args
# Side Effects:
# Return Value: none
sub close
{
my ($self, $args) = @_;
my $res = $self->{ _res };
my $dbh = $self->{ _dbh };
$res->finish if defined $res;
$dbh->disconnect if defined $dbh;
delete $self->{ _res };
delete $self->{ _dbh };
}
1;
|
