IO::Adapter::DBI -< IO::Adapter::MySQL

SQL::Schema::toymodel holds model specific functions and nuke
$args->{query} parameters.

5 files changed, 234 insertions, 181 deletions

diff --git a/fml/lib/IO/Adapter/DBI.pm b/fml/lib/IO/Adapter/DBI.pm
new file mode 100644
index 00000000..527e9529
--- /dev/null
+++ b/fml/lib/IO/Adapter/DBI.pm
@@ -0,0 +1,153 @@
+#-*- 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;
+
+=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_reason( $DBI::errstr );
+	    return undef;
+	}
+    }
+    else {
+	$self->error_reason( $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_reason( $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 };
+}
+
+
+=head2 C<error_reason($mesg)>
+
+=head2 C<error()>
+
+=cut
+
+sub error_reason
+{
+    my ($self, $mesg) = @_;
+    $self->{ _error } = $mesg;
+}
+
+
+sub error
+{
+    my ($self) = @_;
+    return $self->{ _error };
+}
+
+
+1;
diff --git a/fml/lib/IO/Adapter/MySQL.pm b/fml/lib/IO/Adapter/MySQL.pm
index 62d82bc8..686dc4b2 100644
--- a/fml/lib/IO/Adapter/MySQL.pm
+++ b/fml/lib/IO/Adapter/MySQL.pm
@@ -13,14 +13,15 @@ use strict;
 use vars qw(@ISA @EXPORT @EXPORT_OK $AUTOLOAD);
 use Carp;
 
+use IO::Adapter::DBI;
+@ISA = qw(IO::Adapter::DBI);
+
 =head1 NAME
 
 IO::Adapter::MySQL - interface to talk with a MySQL server
 
 =head1 SYNOPSIS
 
-
-
 =head1 DESCRIPTION
 
 This module is a top level driver to talk with a MySQL server in SQL
@@ -32,7 +33,7 @@ Each model name is specified at $args->{ schema } in new($args).
 
 =head1 METHODS
 
-=head2 C<new($args)>
+=head2 C<configure($me, $args)>
 
 =cut
 
@@ -41,171 +42,38 @@ sub configure
     my ($self, $me, $args) = @_;
     my $map    = $me->{ _map };
     my $config = $args->{ $map }->{ config };
-    my $query  = $args->{ $map }->{ query };
+    my $params = $args->{ $map }->{ params };
 
     # import basic DBMS parameters
+    $me->{ _config }        = $config;
+    $me->{ _params }        = $params;
     $me->{ _sql_server }    = $config->{ sql_server }    || 'localhost';
     $me->{ _database }      = $config->{ database }      || 'fml';
     $me->{ _table }         = $config->{ table }         || 'ml';
     $me->{ _user }          = $config->{ user }          || 'fml';
     $me->{ _user_password } = $config->{ user_password } || '';
-    $me->{_dsn}             = _get_dsn($me, {
+    $me->{_dsn}             = $self->SUPER::make_dsn( {
 	driver     =>  'mysql',
 	database   =>  $me->{ _database },
 	host       =>  $me->{ _sql_server },
     });
     
-    # we want to pass basic parameters from caller.
-    $me->{ _schema }        = $config->{ schema } || 'toymodel';
-    $me->{ _query }         = $query || '';
-}
-
-
-sub _get_dsn
-{
-    my ($self, $args) = @_;
-    my $driver   = $args->{ driver };
-    my $database = $args->{ database };
-    my $host     = $args->{ host };
-
-    return "DBI:$driver:$database:$host";
-}
-
-
-=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_reason( $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 };
-}
-
-
-=head2 C<load_schema($args)>
-
-=cut
-
-sub load_schema
-{
-    my ($self, $args) = @_;
-
-    # load model dependent module specified by $args->{ schema };
-    if (defined $self->{ schema }) {
-	my $schema = $self->{ schema };
-	my $pkg    = "SQL::Schema::${schema}";
-	my $obj    = '';
-	eval qq{ require $pkg; $pkg->import(); \$obj = $pkg->new(); };
-	unless ($@) {
-	    $self->{ _schema } = $obj;
-	} 
-	else {
-	    print $@;
-	    error_reason($self, $@);
-	    return undef;
-	}
-    }
-}
-
-
-=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_reason( $DBI::errstr );
-	    return undef;
-	}
+    # load model specific library
+    my $schema = $config->{ schema } || 'toymodel';
+    my $pkg    = "SQL::Schema::". $schema;
+    eval qq{ require $pkg; $pkg->import();};
+    print $@;
+    unless ($@) {
+	@ISA = ($pkg, @ISA);
+	$me->{ _schema } = $pkg;
     }
     else {
-	$self->error_reason( $DBI::errstr );
+	error_reason($self, $@);
 	return undef;
     }
 }
 
 
-
-=head2 C<error_reason($mesg)>
-
-=head2 C<error()>
-
-=cut
-
-sub error_reason
-{
-    my ($self, $mesg) = @_;
-    $self->{ _error } = $mesg;
-}
-
-
-sub error
-{
-    my ($self) = @_;
-    return $self->{ _error };
-}
-
-
 =head2 C<getline()>
 
 return the next address.
@@ -217,20 +85,6 @@ same as C<getline()> now.
 =cut
 
 
-sub _schema_configure
-{
-    my ($self, $query_type) = @_;
-    my $query  = $self->{ _query }->{ $query_type };
-
-    if (ref($query) eq 'CODE') {
-	$query = &$query();
-    }
-    else {
-	$query;
-    }
-}
-
-
 sub getline
 {
     my ($self, $args) = @_;
@@ -242,9 +96,17 @@ sub get_next_value
 {
     my ($self, $args) = @_;
 
+    # for the first time
     unless ($self->{ _res }) {
-	my $query = $self->_schema_configure('get_next_value');
-	$self->execute({ query => $query });
+	if ( $self->{ _schema }->can('get_next_value') ) {
+	    $self->{ _schema }->get_next_value($args);
+	}
+	else {
+	    my $query = $self->build_sql_query({ 
+		query   => 'get_next_value',
+	    });
+	    $self->execute({ query => $query });
+	}
     }
 
     if ($self->{ _res }) {
@@ -258,7 +120,9 @@ sub get_next_value
 }
 
 
-=head2 C<add()>
+=head2 C<add($addr)>
+
+=head2 C<delete($addr)>
 
 =cut
 
@@ -266,18 +130,34 @@ sub get_next_value
 sub add
 {
     my ($self, $addr) = @_;
-    my $query = $self->_schema_configure('add');
-    $query = sprintf($query, $addr);
-    $self->execute({ query => $query });
+
+    if ( $self->{ _schema }->can('add') ) {
+	$self->{ _schema }->add($addr);
+    }
+    else {
+	my $query = $self->build_sql_query({ 
+	    query   => 'add',
+	    address => $addr,
+	});
+	$self->execute({ query => $query });
+    }
 }
 
 
 sub delete
 {
     my ($self, $addr) = @_;
-    my $query = $self->_schema_configure('delete');
-    $query = sprintf($query, $addr);
-    $self->execute({ query => $query });
+
+    if ( $self->{ _schema }->can('delete') ) {
+	$self->{ _schema }->delete($addr);
+    }
+    else {
+	my $query = $self->build_sql_query({ 
+	    query   => 'delete',
+	    address => $addr,
+	});
+	$self->execute({ query => $query });
+    }
 }
 
 
diff --git a/fml/lib/IO/Adapter/index.ja.html b/fml/lib/IO/Adapter/index.ja.html
index 869d9d51..4a99cfcf 100644
--- a/fml/lib/IO/Adapter/index.ja.html
+++ b/fml/lib/IO/Adapter/index.ja.html
@@ -21,6 +21,13 @@ IO/Adapter::* classes
 <TD>
 <TR>
 <TD>
+ DBI.pm <TD>
+<A HREF="DBI.pm">[source]</A>
+<TD>
+<A HREF="@@doc/DBI.txt">[manual]</A>
+<TD>
+<TR>
+<TD>
  File.pm <TD>
 <A HREF="File.pm">[source]</A>
 <TD>
diff --git a/fml/lib/SQL/Schema/toymodel.pm b/fml/lib/SQL/Schema/toymodel.pm
index 5ae90645..0c15e750 100644
--- a/fml/lib/SQL/Schema/toymodel.pm
+++ b/fml/lib/SQL/Schema/toymodel.pm
@@ -31,8 +31,26 @@ model.
 
 =cut
 
-sub new
+
+sub build_sql_query
 {
+    my ($self, $args) = @_;
+    my $query   = $args->{ query };
+    my $ml_name = $self->{ _params }->{ ml_name };
+    my $file    = $self->{ _params }->{ file };
+    my $address = $args->{ address };
+    my $table   = $self->{ _table };
+
+    if ($query eq 'add') {
+	"insert into $table values ('$ml_name', '$file', '$address', 0, 0)";
+    }
+    elsif ($query eq 'delete') {
+	"delete from $table where ml='$ml_name' and address='$address'";
+    }
+    else {
+	"select address from $table where ml='$ml_name' and file='$file'";
+    }
 }
 
+
 1;
diff --git a/regress/mysql/getline.pl b/regress/mysql/getline.pl
index 1a746321..33746832 100755
--- a/regress/mysql/getline.pl
+++ b/regress/mysql/getline.pl
@@ -9,9 +9,6 @@ use IO::MapAdapter;
 
 my $map = 'mysql:toymodel';
 
-my $q_getline = "select address from ml where ml='elena' and file='members'";
-my $q_add     = "insert into ml values ('elena', 'members', '\%s', 0, 0)";
-my $q_delete  = "delete from ml where ml='elena' and address='\%s'";
 
 my $map_params = {
     $map => {
@@ -22,11 +19,9 @@ my $map_params = {
 	    database      => 'fml',
 	    table         => 'ml',
 	},
-	query  => {
-	    getline        => $q_getline,
-	    get_next_value => $q_getline,
-	    add            => $q_add,
-	    delete         => $q_delete,
+	params  => {
+	    ml_name       => 'elena',
+	    file          => 'members',
 	},
     },
 };