rename: $self->{ _driver } -> $self->{ _model_specific_driver }

dynamically load DBD:mysql

move replace(), getline() and get_nextvalue() to DBI.pm
since these functions are MI (Map Independent).

implement setpos(), getpos() and eof() in MySQL.pm
since these functions is dependent on map type (MD).

RDBMS.pm is not used now, so removed.

3 files changed, 143 insertions, 125 deletions

diff --git a/fml/lib/IO/Adapter/DBI.pm b/fml/lib/IO/Adapter/DBI.pm
index fa97de79..b7b63161 100644
--- a/fml/lib/IO/Adapter/DBI.pm
+++ b/fml/lib/IO/Adapter/DBI.pm
@@ -3,7 +3,7 @@
 # Copyright (C) 2000,2001 Ken'ichi Fukamachi
 #          All rights reserved. 
 #
-# $FML: DBI.pm,v 1.6 2001/06/17 08:57:10 fukachan Exp $
+# $FML: DBI.pm,v 1.7 2001/08/05 03:24:44 fukachan Exp $
 #
 
 package IO::Adapter::DBI;
@@ -65,6 +65,10 @@ sub execute
     my $dbh   = $self->{ _dbh };
     my $query = $args->{  query };
 
+    print STDERR "execute query={$query}\n" if $ENV{'debug'};
+
+    undef $self->{ _res };
+
     if (defined $dbh) {
 	my $res = $dbh->prepare($query);
 
@@ -104,13 +108,23 @@ sub open
 {
     my ($self, $args) = @_;
 
-    use DBI;
-    use DBD::mysql;
+    # save for restart
+    $self->{ _args } = $args;
 
+    # DSN parameters
     my $dsn      = $self->{ _dsn };
     my $user     = $self->{ _user }        || 'fml';
     my $password = $self->{_user_password} || '';
 
+    use DBI;
+    if ($dsn =~ /DBD:mysql/) {
+	eval q{ use DBD::mysql; };
+	if ($@) {
+	    $self->error_set( $@ );
+	    return undef;
+	}
+    }
+
     # try to connect
     my $dbh = DBI->connect($dsn, $user, $password);
     unless (defined $dbh) { 
@@ -139,6 +153,88 @@ sub close
 }
 
 
+=head2 C<getline()>
+
+return the next address.
+
+=head2 C<get_next_value()>
+
+same as C<getline()> now.
+
+=cut
+
+
+sub getline
+{
+    my ($self, $args) = @_;
+    $self->get_next_value($args);
+}
+
+
+sub get_next_value
+{
+    my ($self, $args) = @_;
+
+    # for the first time
+    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";
+	}
+    }
+
+    if ($self->{ _res }) {
+	# store the row size
+	unless (defined $self->{ _row_max }) {
+	    $self->{ _row_max } = $self->{ _res }->rows;
+	}
+
+	my @row = $self->{ _res }->fetchrow_array;
+	$self->{ _row_pos }++;
+	join(" ", @row);
+    }
+    else {
+	$self->error_set( $DBI::errstr );
+	undef;
+    }
+}
+
+
+=head2 C<replace($regexp, $value)>
+
+=cut
+
+sub replace
+{
+    my ($self, $regexp, $value) = @_;
+    my (@addr);
+
+    # firstly, get list matching /$regexp/i;
+    my $a = $self->find($regexp, { all => 1});
+
+    # secondarly double check: get list matchi /$regexp/;
+    for my $addr (@$a) {
+	push(@addr, $addr) if ($addr =~ /$regexp/);
+    }
+
+    # thirdly, replace it
+    for my $addr (@addr) {
+	$self->delete( $addr );
+	$self->add( $value );
+    }
+
+}
+
+
+=cut
+
+
 =head1 AUTHOR
 
 Ken'ichi Fukamachi
diff --git a/fml/lib/IO/Adapter/MySQL.pm b/fml/lib/IO/Adapter/MySQL.pm
index e425917f..d1eed9be 100644
--- a/fml/lib/IO/Adapter/MySQL.pm
+++ b/fml/lib/IO/Adapter/MySQL.pm
@@ -3,7 +3,7 @@
 # Copyright (C) 2000,2001 Ken'ichi Fukamachi
 #          All rights reserved. 
 #
-# $FML: MySQL.pm,v 1.14 2001/08/05 03:24:44 fukachan Exp $
+# $FML: MySQL.pm,v 1.15 2001/08/05 12:07:22 fukachan Exp $
 #
 
 
@@ -76,8 +76,8 @@ sub configure
     my $params = $config->{ params }; #
 
     # import basic DBMS parameters
-    $me->{ _config }        = $config;
-    $me->{ _params }        = $params;
+    $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';
@@ -98,7 +98,7 @@ sub configure
 	printf STDERR "%-20s %s\n", "loading", $pkg if $ENV{'debug'};
 
 	@ISA = ($pkg, @ISA);
-	$me->{ _driver } = $pkg;
+	$me->{ _model_specific_driver } = $pkg;
 
 	printf STDERR "%-20s %s\n", "MySQL::ISA:", "@ISA" if $ENV{'debug'};
     }
@@ -109,47 +109,58 @@ sub configure
 }
 
 
-=head2 C<getline()>
+=head2 C<setpos($pos)>
 
-return the next address.
+MySQL does not support rollack, so we close and open this transcation.
+After re-opening, we moved to the specified $pos.
 
-=head2 C<get_next_value()>
+=cut
+
+
+sub setpos
+{
+    my ($self, $pos) = @_;
+    my $i = 0;
+
+    # requested position $pos is later here
+    if ($pos > $self->{ _row_pos }) {
+	$i = $pos - $self->{ _row_pos } - 1;
+    }
+    else {
+	# hmm, rollback() is not supported on mysql.
+	# we need to restart this session.
+	my $args = $self->{ _args };
+	$self->close($args);
+	$self->open($args);
+	$i = $pos - 1;
+    }
+
+    # discard
+    while ($i-- > 0) { $self->get_next_value();}
+}
 
-same as C<getline()> now.
+
+=head2 C<getpos()>
 
 =cut
 
 
-sub getline
+sub getpos
 {
-    my ($self, $args) = @_;
-    $self->get_next_value($args);
+    my ($self) = @_;
+    return $self->{ _row_pos };
 }
 
 
-sub get_next_value
-{
-    my ($self, $args) = @_;
-
-    # for the first time
-    unless ($self->{ _res }) {
-	# $self->{ _driver } is the $config->{ driver } object.
-	if ( $self->can('fetch_and_cache_address_list') ) {
-	    $self->fetch_and_cache_address_list($args);
-	}
-	else {
-	    croak "cannot get next value\n";
-	}
-    }
+=head2 C<eof()>
 
-    if ($self->{ _res }) {
-	my @row = $self->{ _res }->fetchrow_array;
-	join(" ", @row);
-    }
-    else {
-	$self->error_set( $DBI::errstr );
-	undef;
-    }
+=cut
+
+
+sub eof
+{
+    my ($self) = @_;
+    $self->{ _row_pos } < $self->{ _row_max } ? 0 : 1;
 }
 
 
diff --git a/fml/lib/IO/Adapter/RDBMS.pm b/fml/lib/IO/Adapter/RDBMS.pm
deleted file mode 100644
index 80903a51..00000000
--- a/fml/lib/IO/Adapter/RDBMS.pm
+++ /dev/null
@@ -1,89 +0,0 @@
-#-*- perl -*-
-#
-#  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. 
-#
-# $FML: RDBMS.pm,v 1.10 2001/06/09 08:58:10 fukachan Exp $
-#
-
-package IO::Adapter::RDBMS;
-use strict;
-use vars qw(@ISA @EXPORT @EXPORT_OK $AUTOLOAD);
-use Carp;
-
-=head1 NAME
-
-IO::Adapter::RDBMS - talk with SQL servers
-
-=head1 SYNOPSIS
-
-   ... not yet ...
-
-=head1 DESCRIPTION
-
-   ... not yet ...
-
-=head1 METHODS
-
-=head2 C<configure($args)>
-
-Configure object for C<dsn>.
-
-    new({
-	driver => 'IO::Adapter::SQL::toymodel',
-    });
-
-It forwards the request to the specified driver, 
-which knows the sql statement how to add, delete and select.
-
-=cut
-
-
-# Descriptions: configure the detail between SQL servers
-#               all requests are forwarded to the specified sub-class.
-#    Arguments: $self $args
-# Side Effects: none
-# Return Value: subclass object
-sub configure
-{
-    my ($self, $args) = @_;
-    my $type   = $args->{ _type   };
-    my $schema = $args->{ _schema };
-
-    $type = 'MySQL'      if $type eq 'mysql';
-    $type = 'PostgreSQL' if $type eq 'postgresql';
-    my $driver = "IO::Adapter::SQL::${type}::${schema}";
-    print STDERR "driver = $driver\n" if defined $ENV{'debug'};
-
-    # forward the request to the specified subclass or DBI base class
-    eval qq{ require $driver; $driver->import();};
-    unless ($@) {
-	@ISA = ($driver);
-    }
-    else {
-	return undef;
-    }
-}
-
-
-=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::RDBMS appeared in fml5 mailing list driver package.
-See C<http://www.fml.org/> for more details.
-
-=cut
-
-
-1;