reconstruct MySQL functions

o get_next_key() works now.
o disable some functions once.

3 files changed, 160 insertions, 66 deletions

diff --git a/fml/lib/IO/Adapter.pm b/fml/lib/IO/Adapter.pm
index c4765dca..3693891f 100644
--- a/fml/lib/IO/Adapter.pm
+++ b/fml/lib/IO/Adapter.pm
@@ -4,7 +4,7 @@
 #   All rights reserved. This program is free software; you can
 #   redistribute it and/or modify it under the same terms as Perl itself.
 #
-# $FML: Adapter.pm,v 1.16 2002/02/17 03:13:49 fukachan Exp $
+# $FML: Adapter.pm,v 1.17 2002/07/22 09:41:12 fukachan Exp $
 #
 
 package IO::Adapter;
@@ -148,7 +148,7 @@ sub new
     my ($self, $map, $args) = @_;
     my ($type) = ref($self) || $self;
     my ($me)   = { _map => $map };
-    my $pkg;
+    my ($pkg, @pkg);
 
     # 2002/07/22: accpet READ_ONLY($map).
     if ($map =~ /^READ_ONLY\(/) {
@@ -187,6 +187,7 @@ sub new
 	    $me->{_params} = $args;
 	    $me->{_type}   =~ tr/A-Z/a-z/; # lowercase the '_type' syntax
 	    $pkg           = 'IO::Adapter::MySQL';
+	    @pkg           = qw(IO::Adapter::DBI);
 	}
 	elsif ($map =~ /(ldap):(\S+)/i) {
 	    $me->{_type}   = $1;
@@ -203,10 +204,13 @@ sub new
 
     # save @ISA for further use, re-evaluate @ISA
     @ORIG_ISA = @ISA unless $FirstTime++;
-    @ISA      = ($pkg, @ORIG_ISA);
+    @ISA      = ($pkg, @pkg, @ORIG_ISA);
 
-    printf STDERR "%-20s %s\n", "IO::Adapter::ISA:", "@ISA" if $debug;
-    eval qq{ require $pkg; $pkg->import();};
+    if ($debug) {
+	printf STDERR "%-20s %s\n", "IO::Adapter::ISA:", "@ISA";
+	print STDERR "use $pkg\n";
+    }
+    eval qq{ use $pkg; };
     unless ($@) {
 	$pkg->configure($me, $args) if $pkg->can('configure');
     }
diff --git a/fml/lib/IO/Adapter/DBI.pm b/fml/lib/IO/Adapter/DBI.pm
index 94b1e154..3b018c5b 100644
--- a/fml/lib/IO/Adapter/DBI.pm
+++ b/fml/lib/IO/Adapter/DBI.pm
@@ -3,7 +3,7 @@
 # Copyright (C) 2000,2001,2002 Ken'ichi Fukamachi
 #          All rights reserved.
 #
-# $FML: DBI.pm,v 1.13 2002/01/27 13:11:58 fukachan Exp $
+# $FML: DBI.pm,v 1.14 2002/02/01 12:03:58 fukachan Exp $
 #
 
 package IO::Adapter::DBI;
@@ -72,8 +72,9 @@ execute sql query.
 sub execute
 {
     my ($self, $args) = @_;
-    my $dbh   = $self->{ _dbh };
-    my $query = $args->{  query };
+    my $dbh    = $self->{ _dbh };
+    my $query  = $args->{  query };
+    my $config = $self->{ _config };
 
     print STDERR "execute query={$query}\n" if $debug;
 
@@ -118,29 +119,28 @@ sub open
 {
     my ($self, $args) = @_;
 
+    print STDERR "DBI::open()\n" if $debug;
+
     # save for restart
     $self->{ _args } = $args;
 
     # DSN parameters
     my $dsn      = $self->{ _dsn };
-    my $user     = $self->{ _user }        || 'fml';
-    my $password = $self->{_user_password} || '';
+    my $user     = $self->{ _sql_user }    || 'fml';
+    my $password = $self->{ _sql_password} || '';
 
-    use DBI;
-    if ($dsn =~ /DBD:mysql/) {
-	eval q{ use DBD::mysql; };
-	if ($@) {
-	    $self->error_set( $@ );
-	    return undef;
-	}
-    }
+    print STDERR "open $dsn\n" if $debug;
 
     # try to connect
-    my $dbh = DBI->connect($dsn, $user, $password);
+    use DBI;
+    my $dbh = DBI->connect($dsn, $user, $password, { RaiseError => 1 } );
     unless (defined $dbh) {
 	$self->error_set( $DBI::errstr );
 	return undef;
     }
+    else {
+	print STDERR "connected to $dsn\n" if $debug;
+    }
 
     $self->{ _dbh } = $dbh;
 }
@@ -181,7 +181,7 @@ same as C<getline()> now.
 sub getline
 {
     my ($self, $args) = @_;
-    $self->get_next_key($args);
+    croak('getline() not implemented');
 }
 
 
@@ -192,7 +192,7 @@ sub getline
 sub get_next_key
 {
     my ($self, $args) = @_;
-    $self->_get_next_xxx($args, 'key');
+    $self->_get_data_from_cache($args, 'key');
 }
 
 
@@ -203,7 +203,7 @@ sub get_next_key
 sub get_next_value
 {
     my ($self, $args) = @_;
-    $self->_get_next_xxx($args, 'value');
+    croak('get_net_value() not implemented');
 }
 
 
@@ -211,22 +211,17 @@ sub get_next_value
 #    Arguments: OBJ($self) HASH_REF($args) STR($mode)
 # Side Effects: none
 # Return Value: STR
-sub _get_next_xxx
+sub _get_data_from_cache
 {
     my ($self, $args, $mode) = @_;
 
-    # for the first time
+    # for the first time, get the data and cache it for the later use.
     unless ($self->{ _res }) {
 	# reset row information
 	undef $self->{ _row_pos };
 	undef $self->{ _row_max };
 
-	if ( $self->can('fetch_all') ) {
-	    $self->fetch_all($args);
-	}
-	else {
-	    croak "cannot get next value\n";
-	}
+	$self->_fetch_all($args);
     }
 
     if ($self->{ _res }) {
@@ -238,14 +233,14 @@ sub _get_next_xxx
 	my @row = $self->{ _res }->fetchrow_array;
 	$self->{ _row_pos }++;
 	if ($mode eq 'key') {
-	    $row[0];
+	    return $row[0];
 	}
 	elsif ($mode eq 'value') {
 	    shift @row;
-	    join(" ", @row);
+	    return \@row;
 	}
 	else {
-	    warn("invalid option");
+	    warn("DBI: invalid option");
 	}
     }
     else {
@@ -255,6 +250,62 @@ sub _get_next_xxx
 }
 
 
+# Descriptions: get one entry from DBMS
+#               create an SQL query and exetute it
+#    Arguments: OBJ($self) HASH_REF($args)
+# Side Effects: update DB via SQL
+# Return Value: STR
+sub _fetch_all
+{
+    my ($self, $args) = @_;
+    my $config = $self->{ _config };
+    my $query  = $config->{ sql_get_next_key };
+
+    $self->execute({ query => $query });
+}
+
+
+=head2 add($addr)
+
+=head2 delete($addr)
+
+=cut
+
+
+# Descriptions: add $addr
+#               create an SQL query and exetute it
+#    Arguments: OBJ($self) STR($addr)
+# Side Effects: update DB via SQL
+# Return Value: STR
+sub add
+{
+    my ($self, $addr) = @_;
+    my $config = $self->{ _config };
+    my $query  = $config->{ sql_add };
+
+    $query =~ s/\&address/$addr/g;
+
+    $self->execute({ query => $query });
+}
+
+
+# Descriptions: delete $addr
+#               create an SQL query and exetute it
+#    Arguments: OBJ($self) STR($addr)
+# Side Effects: update DB via SQL
+# Return Value: STR
+sub delete
+{
+    my ($self, $addr) = @_;
+    my $config = $self->{ _config };
+    my $query  = $config->{ sql_delete };
+
+    $query =~ s/\&address/$addr/g;
+
+    $self->execute({ query => $query });
+}
+
+
 =head2 C<replace($regexp, $value)>
 
 =cut
@@ -286,6 +337,55 @@ sub replace
 }
 
 
+# Descriptions: search, md = map dependent
+#               create an SQL query and exetute it
+#    Arguments: OBJ($self) STR($regexp) HASH_REF($args)
+# Side Effects: update DB via SQL
+# Return Value: STR or ARRAY_REF
+sub md_find
+{
+    my ($self, $regexp, $args) = @_;
+    my $case_sensitive = $args->{ case_sensitive } ? 1 : 0;
+    my $show_all       = $args->{ all } ? 1 : 0;
+    my (@buf, $x);
+
+    my $query = $self->_build_sql_query({
+	query  => 'search',
+	regexp => $regexp,
+    });
+    $self->execute({ query => $query });
+
+    if (defined $self->{ _res }) {
+	my ($row);
+	while (defined ($row = $self->{ _res }->fetchrow_arrayref)) {
+	    $x = join(" ", @$row);
+
+	    if ($show_all) {
+		if ($case_sensitive) {
+		    push(@buf, $x) if $x =~ /$regexp/;
+		}
+		else {
+		    push(@buf, $x) if $x =~ /$regexp/i;
+		}
+	    }
+	    else {
+		if ($case_sensitive) {
+		    last if $x =~ /$regexp/;
+		}
+		else {
+		    last if $x =~ /$regexp/i;
+		}
+	    }
+	}
+    }
+    else {
+	return undef;
+    }
+
+   $show_all ? \@buf : $x;
+}
+
+
 =head1 AUTHOR
 
 Ken'ichi Fukamachi
diff --git a/fml/lib/IO/Adapter/MySQL.pm b/fml/lib/IO/Adapter/MySQL.pm
index 44d9b0b7..51f9afcf 100644
--- a/fml/lib/IO/Adapter/MySQL.pm
+++ b/fml/lib/IO/Adapter/MySQL.pm
@@ -3,7 +3,7 @@
 # Copyright (C) 2000,2001,2002 Ken'ichi Fukamachi
 #          All rights reserved.
 #
-# $FML: MySQL.pm,v 1.19 2002/01/27 13:11:58 fukachan Exp $
+# $FML: MySQL.pm,v 1.20 2002/02/01 12:03:59 fukachan Exp $
 #
 
 
@@ -16,7 +16,8 @@ use Carp;
 my $debug = 0;
 
 use IO::Adapter::DBI;
-@ISA = qw(IO::Adapter::DBI);
+push(@ISA, 'IO::Adapter::DBI');
+
 
 =head1 NAME
 
@@ -79,40 +80,29 @@ sub configure
 {
     my ($self, $me, $args) = @_;
     my $map    = $me->{ _map };       # e.g. "mysql:toymodel"
-    my $config = $args->{ $map };     # { add => 'insert into ..', }
-    my $params = $config->{ params }; #
-
-    # import basic DBMS parameters
-    $me->{ _config }        = $config                    || undef;
-    $me->{ _params }        = $params                    || undef;
-    $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}             = $self->SUPER::make_dsn( {
-	driver     =>  'mysql',
-	database   =>  $me->{ _database },
-	host       =>  $me->{ _sql_server },
-    });
-
-    # load model specific library
-    my $pkg = $config->{ driver } || 'IO::Adapter::SQL::toymodel';
-    eval qq{ require $pkg; $pkg->import();};
+    my $config = $args->{ "[$map]" };
+
+    # import variables
+    for my $key (qw(sql_server
+		    sql_database
+		    sql_table
+		    sql_user
+		    sql_password)) {
+	$me->{ "_$key" } = $config->{ $key };
+    }
 
-    # $self->{ _driver } is the $config->{ driver } object.
-    unless ($@) {
-	printf STDERR "%-20s %s\n", "loading", $pkg if $debug;
+    use IO::Adapter::DBI;
+    my $dsn = IO::Adapter::DBI->make_dsn( {
+	driver   => 'mysql',
+	database => $config->{ sql_database },
+	host     => $config->{ sql_server },
+    });
 
-	@ISA = ($pkg, @ISA);
-	$me->{ _model_specific_driver } = $pkg;
+    # save the current DSN
+    $me->{ _dsn } = $dsn;
 
-	printf STDERR "%-20s %s\n", "MySQL::ISA:", "@ISA" if $debug;
-    }
-    else {
-	error_set($self, $@);
-	return undef;
-    }
+    # save map specific configuration
+    $me->{ _config } = $config;
 }