mysql map can work.

IO::MapAdapter->new() accpets two parameters, $map and the parameters
$map_params.
my $obj = new IO::MapAdapter ('mysql:toymodel', $map_params);
where $map_params = { config => {},  query => {} };

2 files changed, 106 insertions, 65 deletions

diff --git a/fml/lib/IO/Adapter/MySQL.pm b/fml/lib/IO/Adapter/MySQL.pm
index fc34a57b..8614f35b 100644
--- a/fml/lib/IO/Adapter/MySQL.pm
+++ b/fml/lib/IO/Adapter/MySQL.pm
@@ -9,61 +9,66 @@
 
 package IO::Adapter::MySQL;
 
-
 use strict;
 use vars qw(@ISA @EXPORT @EXPORT_OK $AUTOLOAD);
 use Carp;
 
 =head1 NAME
 
-IO::Adapter::MySQL - IO by SQL
+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
+(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
 
 =head2 C<new($args)>
 
-   $args->{
-       ml_name,
-       db
-       mysql_toymodel_getline_query => ''
-   }
-
 =cut
 
-sub new
+sub configure
 {
-    my ($self, $args) = @_;
-    my ($type) = ref($self) || $self;
-    my $me     = {};
+    my ($self, $me, $args) = @_;
+    my $map    = $me->{ _map };
+    my $config = $args->{ $map }->{ config };
+    my $query  = $args->{ $map }->{ query };
+
+    # import basic DBMS parameters
+    $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, {
+	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 || '';
+}
 
-    $me->{ _ml_name }          = $args->{ ml_name }    || '';
-    $me->{ _databse }          = $args->{ database }   || 'fml';
-    $me->{ _table }            = $args->{ table }      || 'ml';
-    $me->{ _sql_server }       = $args->{ sql_server } || 'localhost';
-    $me->{ _sql_user }         = $args->{ sql_user }   || 'fml';
-    $me->{ _sql_user_password} = $args->{ sql_user_password } || '';
 
-    # load model dependent module specified by $args->{ schema };
-    if (defined $args->{ schema }) {
-	my $schema = $args->{ schema };
-	my $pkg    = "SQL::Schema::${schema}";
-	my $obj    = '';
-	eval qq{ require $pkg; $pkg->import(); \$obj = $pkg->new(); };
-	unless ($@) {
-	    $me->{ _schema } = $obj;
-	} 
-	else {
-	    print $@;
-	    error_reason($me, $@);
-	    return undef;
-	}
-    }
+sub _get_dsn
+{
+    my ($self, $args) = @_;
+    my $driver   = $args->{ driver };
+    my $database = $args->{ database };
+    my $host     = $args->{ host };
 
-    return bless $me, $type;
+    return "DBI:$driver:$database:$host";
 }
 
 
@@ -85,15 +90,11 @@ sub open
     use DBI;
     use DBD::mysql;
 
-    my $driver   = 'mysql';
-    my $database = $args->{database}   || $self->{_databse} || 'fml';
-    my $table    = $args->{table}      || $self->{_table}   || 'ml';
-    my $host     = $args->{sql_server} || $self->{_sql_server} || 'localhost';
-    my $user     = $args->{sql_user}   || $self->{ _sql_user } || 'fml';
-    my $password = 
-	$args->{sql_user_password} || $self->{_sql_user_password} || '';
+    my $dsn      = $self->{ _dsn };
+    my $user     = $self->{ _user }        || 'fml';
+    my $password = $self->{_user_password} || '';
 
-    my $dsn = "DBI:$driver:$database:$host";
+    # try to connect
     my $dbh = DBI->connect($dsn, $user, $password);
     unless (defined $dbh) { 
 	$self->error_reason( $DBI::errstr );
@@ -119,6 +120,32 @@ sub close
 }
 
 
+=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<getline()>
 
 return the next address.
@@ -130,20 +157,16 @@ same as C<getline()> now.
 =cut
 
 
-sub _res_configure
+sub _schema_configure
 {
-    my ($self, $args) = @_;
+    my ($self, $query_type) = @_;
+    my $query  = $self->{ _query }->{ $query_type };
 
-    unless ($self->{ _res }) {
-	my $ml    = $self->{ _ml_name };
-	my $file  = $self->{ _file } || 'members';
-	my $query = "select address from ml ";
-	$query   .= "where ml='$ml' and file='$file' ";
-	$self->execute({ query => $query });
+    if (ref($query) eq 'CODE') {
+	$query = &$query();
     }
     else {
-	$self->error_reason( $DBI::errstr );
-	return undef;
+	$query;
     }
 }
 
@@ -151,8 +174,19 @@ sub _res_configure
 sub getline
 {
     my ($self, $args) = @_;
+    $self->get_next_value($args);
+}
+
+
+sub get_next_value
+{
+    my ($self, $args) = @_;
+
+    unless ($self->{ _res }) {
+	my $query = $self->_schema_configure('get_next_value');
+	$self->execute({ query => $query });
+    }
 
-    $self->_res_configure($args) unless $self->{ _res };
     if ($self->{ _res }) {
 	my @row = $self->{ _res }->fetchrow_array;
 	join(" ", @row);
@@ -164,13 +198,6 @@ sub getline
 }
 
 
-sub get_next_value
-{
-    my ($self, $args) = @_;
-    $self->getline($args);
-}
-
-
 =head2 C<execute($args)>
 
 execute sql query.
diff --git a/fml/lib/IO/MapAdapter.pm b/fml/lib/IO/MapAdapter.pm
index 2179cb2e..1688b910 100644
--- a/fml/lib/IO/MapAdapter.pm
+++ b/fml/lib/IO/MapAdapter.pm
@@ -23,11 +23,25 @@ IO::MapAdapter - adapter for several IO interfaces
 =head1 SYNOPSIS
 
     use IO::MapAdapter;
-    $obj = new IO::MapAdapter $map;
+    $obj = new IO::MapAdapter ($map, $map_params);
     $obj->open || croak("cannot open $map");
     while ($x = $obj->getline) { ... }
     $obj->close;
 
+where C<$map_params> is map specific parametes used for C<RDBMS>.
+For example, C<$map_params> is:
+
+    $map_params = {
+	'mysql:toymodel' => {
+	    getline        => "select ... ",
+	    get_next_value => "select ... ",
+	    add            => "insert ... ",
+	    delete         => "delete ... ",
+	    replace        => "set address = 'value' where ... ",
+	},
+    };
+
+
 =head1 DESCRIPTION
 
 This is "Adapter" (or "Wrapper") C<design pattern>.
@@ -96,7 +110,7 @@ sub new
 {
     my ($self, $map, $args) = @_;
     my ($type) = ref($self) || $self;
-    my ($me)   = {};
+    my ($me)   = { _map => $map };
     my $pkg;
 
     if (ref($map) eq 'ARRAY') {
@@ -125,7 +139,7 @@ sub new
 	    $me->{_schema} = $2;
 	    $me->{_params} = $args;
 	    $me->{_type}   =~ tr/A-Z/a-z/; # lowercase the '_type' syntax
-	    $pkg           = 'IO::Adapter::RDBMS';
+	    $pkg           = 'IO::Adapter::MySQL';
 	}
 	elsif ($map =~ /(ldap):(\S+)/i) {
 	    $me->{_type}   = $1;
@@ -145,7 +159,7 @@ sub new
     @ISA      = ($pkg, @ORIG_ISA);
 
     eval qq{ require $pkg; $pkg->import();};
-    $pkg->configure($me) if $pkg->can('configure');
+    $pkg->configure($me, $args) if $pkg->can('configure');
     _error_reason($me, $@) if $@;
 
     return bless $me, $type;
@@ -184,7 +198,7 @@ sub open
 	$self->SUPER::open( { flag => $flag } );
     }
     elsif ($self->{'_type'} =~ /^(ldap|mysql|postgresql)$/o) {
-	return undef;
+	$self->SUPER::open( { flag => $flag } );
     }
     else {
 	$self->_error_reason("Error: type=$self->{_type} is unknown type.");