blob: a87c73e7601d2b1eaf8b8ee3bf5621c49c2dbf3c (
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
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
|
#-*- perl -*-
#
# Copyright (C) 2000,2001 Ken'ichi Fukamachi
# All rights reserved.
#
# $FML$
#
package IO::Adapter::DBI;
use strict;
use vars qw(@ISA @EXPORT @EXPORT_OK $AUTOLOAD);
use Carp;
use IO::Adapter::ErrorStatus 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
other modules in such as C<SQL::Schema::> class.
Each model name is specified at $args->{ schema } in new($args).
=head1 METHODS
=head2 C<make_dsn($args)>
prepare C<dsn>.
=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)>
connected to SQL server specified by C<dsn>.
=head2 C<close($args)>
close connection to SQL server specified by C<dsn>.
=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 };
}
=head1 AUTHOR
Ken'ichi Fukamachi
=head1 COPYRIGHT
Copyright (C) 2001 Ken'ichi Fukamachi
All rights reserved. This program is free software; you can
redistribute it and/or modify it under the same terms as Perl itself.
=head1 HISTORY
IO::Adapter::Array appeared in fml5 mailing list driver package.
See C<http://www.fml.org/> for more details.
=cut
1;
|
