From 2ffa0e8cb666b1826df83483c5259010db6358d9 Mon Sep 17 00:00:00 2001 From: fukachan Date: Thu, 15 Mar 2001 15:24:23 +0000 Subject: implemente primitive getline() call to MySQL and the cheker of it. fix the name to toymode.pm not .pl TODO is things not yet imported from fml 4.0. --- fml/lib/IO/Adapter/MySQL/TODO | 364 ++++++++++++++++++++++++++ fml/lib/IO/Adapter/MySQL/toymodel.pl | 478 ----------------------------------- fml/lib/IO/Adapter/MySQL/toymodel.pm | 140 ++++++++++ regress/base/mysql_io.pl | 15 ++ 4 files changed, 519 insertions(+), 478 deletions(-) create mode 100644 fml/lib/IO/Adapter/MySQL/TODO delete mode 100644 fml/lib/IO/Adapter/MySQL/toymodel.pl create mode 100644 fml/lib/IO/Adapter/MySQL/toymodel.pm create mode 100755 regress/base/mysql_io.pl diff --git a/fml/lib/IO/Adapter/MySQL/TODO b/fml/lib/IO/Adapter/MySQL/TODO new file mode 100644 index 00000000..1fc250aa --- /dev/null +++ b/fml/lib/IO/Adapter/MySQL/TODO @@ -0,0 +1,364 @@ + + +##################################################################### + + + +sub DataBases::Execute +{ + my ($e, $mib, $result, $misc) = @_; + + if ($main::debug) { + while (($k, $v) = each %$mib) { print "MySQL: $k => $v\n";} + } + + if ($mib->{'_action'}) { + # initialize + &Init($mib); + if ($mib->{'error'}) { + &Log("ERROR: MySQL::Init() fails"); + &Log("ERROR: MySQL: $mib->{'error'}"); + return 0; + } + + &MySQL::Connect($mib); + if ($mib->{'error'}) { + &Log("ERROR: MySQL: $mib->{'error'}"); + return 0; + } + + if ($mib->{'_action'} eq 'get_status') { + &Status($mib); + } + elsif ($mib->{'_action'} eq 'num_active') { + &Count($mib, 'actives'); + } + elsif ($mib->{'_action'} eq 'num_member') { + &Count($mib, 'members'); + } + elsif ($mib->{'_action'} eq 'get_active_list' || + $mib->{'_action'} eq 'dump_active_list') { + &GetActiveList($mib); + } + elsif ($mib->{'_action'} eq 'get_member_list' || + $mib->{'_action'} eq 'dump_member_list') { + &GetMemberList($mib); + } + elsif ($mib->{'_action'} eq 'active_p') { + $mib->{'_result'} = &ActiveP($mib, $mib->{'_address'}); + } + elsif ($mib->{'_action'} eq 'member_p') { + $mib->{'_result'} = &MemberP($mib, $mib->{'_address'}); + } + elsif ($mib->{'_action'} eq 'admin_member_p') { + $mib->{'_result'} = &AdminMemberP($mib, $mib->{'_address'}); + } + elsif ($mib->{'_action'} eq 'add' || + $mib->{'_action'} eq 'bye' || + $mib->{'_action'} eq 'subscribe' || + $mib->{'_action'} eq 'unsubscribe' || + $mib->{'_action'} eq 'on' || + $mib->{'_action'} eq 'off' || + $mib->{'_action'} eq 'chaddr' || + $mib->{'_action'} eq 'digest' || + $mib->{'_action'} eq 'matome' || + $mib->{'_action'} eq 'addadmin' || + $mib->{'_action'} eq 'byeadmin' ) { + &__ListCtl($mib); + } + elsif ($mib->{'_action'} eq 'store_article') { + # &Distribute() calls this function after saving article + # at spool/$ID + # If you store ML articles to DB, please write the code here. + ; + } + elsif ($mib->{'_action'} eq 'store_subscribe_mail') { + # &AutoRegist() calls this function after subscribe the address + # If you store the request mail to DB, please write the code here. + ; + } + else { + &Log("ERROR: MySQL: unkown ACTION $mib->{'_action'}"); + } + + if ($mib->{'error'}) { + &Log("ERROR: MySQL: $mib->{'error'}"); + return 0; + } + + &Close; + if ($mib->{'error'}) { + &Log("ERROR: MySQL: $mib->{'error'}"); + return 0; + } + + # O.K. + return 1; + } + else { + &Log("ERROR: MySQL: no given action to do"); + } +} + + +### ***-predicate() ### + + +sub __MemberP +{ + my ($mib, $file, $addr) = @_; + my ($query, $res, $ml, @row); + + $addr = &main::LowerDomain($addr); + $ml = $mib->{'_ml_acct'}; + $query = "select address from ml "; + $query .= " where ml = '$ml' "; + $query .= " and file = '$file' "; + $query .= " and address = '$addr' "; + + ($res = &__Execute($mib, $query)) || return $NULL; + + @row = $res->fetchrow_array; + &Log("row: @row") if $debug; + + $row[0] eq $addr ? 1 : 0; +} + + +### dump lists ### + +sub GetActiveList { my($mib) = @_; &__DumpList($mib, 'actives', 1);} +sub GetMemberList { my($mib) = @_; &__DumpList($mib, 'members', 0);} +sub __DumpList +{ + my ($mib, $file, $ignore_off) = @_; + my ($max, $orgf, $newf, $ml); + my ($query); + + $ml = $mib->{'_ml_acct'}; + $query = " select address from ml "; + $query .= " where ml = '$ml' "; + $query .= " and file = '$file' "; + if ($ignore_off) { + $query .= " and off != '1' "; + } + + # cache file to dump in + $orgf = $mib->{'_cache_file'}; + $newf = $mib->{'_cache_file'}.".new.$$"; + + if (open(OUT, "> $newf")) { + my ($res, @row); + + ($res = &__Execute($mib, $query)) || do { + close(OUT); + return $NULL; + }; + + while (@row = $res->fetchrow_array) { + print OUT $row[0], "\n"; + } + close(OUT); + + if (! rename($newf, $orgf)) { + &Log("ERROR: MySQL: cannot rename $newf $orgf"); + $mib->{'error'} = "ERROR: MySQL: cannot rename $newf $orgf"; + } + } + else { + &Log("ERROR: MySQL: cannot open $newf"); + $mib->{'error'} = "ERROR: MySQL: cannot open $orgf"; + } +} + + +### amctl ### +# subscribe unsubscribe +sub __ListCtl +{ + my ($mib, $addr) = @_; + my ($status); + my ($ml, $query, $res); + + $addr = $addr || $mib->{'_address'}; + $addr = &main::LowerDomain($addr); + $ml = $mib->{'_ml_acct'}; + + &main::Log("$mib->{'_action'} $addr"); + + if ($mib->{'_action'} eq 'subscribe' || + $mib->{'_action'} eq 'add') { + + $query = " insert into ml "; + $query .= " values ('$ml', 'actives', '$addr', 0, '$NULL') "; + &__Execute($mib, $query) || return $NULL; + + $query = " insert into ml "; + $query .= " values ('$ml', 'members', '$addr', 0, '$NULL') "; + &__Execute($mib, $query) || return $NULL; + + } + elsif ($mib->{'_action'} eq 'add2actives' || + $mib->{'_action'} eq 'addactives') { + + $query = " insert into ml "; + $query .= " values ('$ml', 'actives', '$addr', 0, '$NULL') "; + &__Execute($mib, $query) || return $NULL; + + } + elsif ($mib->{'_action'} eq 'add2members' || + $mib->{'_action'} eq 'addmembers') { + + $query = " insert into ml "; + $query .= " values ('$ml', 'members', '$addr', 0, '$NULL') "; + &__Execute($mib, $query) || return $NULL; + + } + elsif ($mib->{'_action'} eq 'unsubscribe' || + $mib->{'_action'} eq 'bye') { + + $query = " delete from ml "; + $query .= " where ml = '$ml' "; + $query .= " and address = '$addr' "; + &__Execute($mib, $query) || return $NULL; + + } + elsif ($mib->{'_action'} eq 'off') { + + $query = " update ml "; + $query .= " set off = '1' "; + $query .= " where ml = '$ml' "; + $query .= " and file = 'actives' "; + $query .= " and address = '$addr' "; + &__Execute($mib, $query) || return $NULL; + + } + elsif ($mib->{'_action'} eq 'on') { + + $query = " update ml "; + $query .= " set off = '0' "; + $query .= " where ml = '$ml' "; + $query .= " and file = 'actives' "; + $query .= " and address = '$addr' "; + &__Execute($mib, $query) || return $NULL; + + } + elsif ($mib->{'_action'} eq 'chaddr') { + + my ($old_addr) = $addr; + my ($new_addr) = $mib->{'_value'}; + $new_addr = &main::LowerDomain($new_addr); + + for $file ('actives', 'members') { + $query = " update ml "; + $query .= " set address = '$new_addr' "; + $query .= " where ml = '$ml' "; + $query .= " and file = '$file' "; + $query .= " and address = '$old_addr' "; + &__Execute($mib, $query) || return $NULL; + } + } + elsif ($mib->{'_action'} eq 'digest' || + $mib->{'_action'} eq 'matome') { + + my ($opt) = $mib->{'_value'}; + $query = " update ml "; + $query .= " set options = '$opt' "; + $query .= " where ml = '$ml' "; + $query .= " and file = 'actives' "; + $query .= " and address = '$addr' "; + &__Execute($mib, $query) || return $NULL; + + } + elsif ($mib->{'_action'} eq 'addadmin') { + + $query = " insert into ml "; + $query .= " values ('$ml', 'members-admin', '$addr', 0, '$NULL') "; + &__Execute($mib, $query) || return $NULL; + + } + elsif ($mib->{'_action'} eq 'byeadmin') { + + $query = " delete from ml "; + $query .= " where ml = '$ml' "; + $query .= " and file = 'members-admin' "; + $query .= " and address = '$addr' "; + &__Execute($mib, $query) || return $NULL; + + } + else { + &Log("ERROR: MySQL: unknown ACTION $mib->{'_action'}"); + } + + if ($mib->{'error'}) { return $NULL;} +} + + +sub Count +{ + my ($mib, $file) = @_; + my ($mll, $query, $res); + + $ml = $mib->{'_ml_acct'}; + $query = " select count(address) from ml "; + $query .= " where file = '$file' "; + $query .= " and ml = '$ml' "; + ($res = &__Execute($mib, $query)) || return $NULL; + + &Log($query) if $debug; + @row = $res->fetchrow_array; + $mib->{'_result'} = $row[0]; +} + + +sub Status +{ + my ($mib, $file) = @_; + my ($mll, $query, $res, $addr); + + $addr = $mib->{'_address'}; + $addr = &main::LowerDomain($addr); + $ml = $mib->{'_ml_acct'}; + $query = " select address,off,options from ml "; + $query .= " where file = 'actives' "; + $query .= " and ml = '$ml' "; + $query .= " and address = '$addr' "; + ($res = &__Execute($mib, $query)) || return $NULL; + + &Log($query) if $debug; + my ($a, $off, $option) = $res->fetchrow_array; + + $mib->{'_result'} .= "off " if $off; + $mib->{'_result'} .= $option if $option; +} + + +sub __Error +{ + my ($s) = @_; + $mib->{'error'} = $s; +} + + +# for debug +sub RemoveAll +{ + my ($mib) = @_; + &__Execute($mib, "drop table ml"); +} + + +sub Dump +{ + my ($mib) = @_; + my ($res); + my (@row); + + print "---- table ml -----\n"; + $res = &__Execute($mib, "select * from ml order by file") || + return $NULL; + while (@row = $res->fetchrow_array) { + printf "%-10s %-10s %-40s %-3d %s\n", @row; + } + print "--- end\n"; +} diff --git a/fml/lib/IO/Adapter/MySQL/toymodel.pl b/fml/lib/IO/Adapter/MySQL/toymodel.pl deleted file mode 100644 index 78a58b2e..00000000 --- a/fml/lib/IO/Adapter/MySQL/toymodel.pl +++ /dev/null @@ -1,478 +0,0 @@ -#-*- perl -*- -# -# Copyright (C) 2000 Ken'ichi Fukamachi -# All rights reserved. -# -# $Id$ -# - - -package IO::Adapter::MySQL::toymodel; - - -use strict; -use vars qw(@ISA @EXPORT @EXPORT_OK $AUTOLOAD); -use Carp; - -=head1 NAME - -IO::Adapter::MySQL::toymodel - toymodel with SQL - -=head1 SYNOPSIS - -=head1 DESCRIPTION - -=head1 METHODS - -=head2 C - -=head2 C - -=cut - - -# Descriptions: -# Arguments: $self $args -# Side Effects: -# Return Value: none -sub open -{ - my ($self, $args) = @_; - - use DBI; - use DBD::mysql; - - my $driver = 'mysql'; - my $database = $args->{ database_name } || 'fml'; - my $host = $args->{ sql_server } || 'localhost'; - my $dsn = "DBI:$driver:$database:$host"; - my $user = $args->{ sql_user } || 'fml' || ''; - my $password = $args->{ sql_user_password} || ''; - - my $dbh = DBI->connect($dsn, $user, $password); - unless (defined $dbh) { - $args->{'error'} = $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; -} - - -=head2 C{ - query => sql_query_statment, - }; - -=cut - -sub execute -{ - my ($self, $args) = @_; - my $dhb = $self->{ _dbh }; - - if (defined $dbh) { - my $res = $dbh->prepare($query); - $res->execute; - - unless (defined $res) { - $self->error_reason( $DBI::errstr ); - return undef; - } - else { - return $res; - } - } - else { - return undef; - } -} - - - - - - -##################################################################### - - - -sub DataBases::Execute -{ - my ($e, $mib, $result, $misc) = @_; - - if ($main::debug) { - while (($k, $v) = each %$mib) { print "MySQL: $k => $v\n";} - } - - if ($mib->{'_action'}) { - # initialize - &Init($mib); - if ($mib->{'error'}) { - &Log("ERROR: MySQL::Init() fails"); - &Log("ERROR: MySQL: $mib->{'error'}"); - return 0; - } - - &MySQL::Connect($mib); - if ($mib->{'error'}) { - &Log("ERROR: MySQL: $mib->{'error'}"); - return 0; - } - - if ($mib->{'_action'} eq 'get_status') { - &Status($mib); - } - elsif ($mib->{'_action'} eq 'num_active') { - &Count($mib, 'actives'); - } - elsif ($mib->{'_action'} eq 'num_member') { - &Count($mib, 'members'); - } - elsif ($mib->{'_action'} eq 'get_active_list' || - $mib->{'_action'} eq 'dump_active_list') { - &GetActiveList($mib); - } - elsif ($mib->{'_action'} eq 'get_member_list' || - $mib->{'_action'} eq 'dump_member_list') { - &GetMemberList($mib); - } - elsif ($mib->{'_action'} eq 'active_p') { - $mib->{'_result'} = &ActiveP($mib, $mib->{'_address'}); - } - elsif ($mib->{'_action'} eq 'member_p') { - $mib->{'_result'} = &MemberP($mib, $mib->{'_address'}); - } - elsif ($mib->{'_action'} eq 'admin_member_p') { - $mib->{'_result'} = &AdminMemberP($mib, $mib->{'_address'}); - } - elsif ($mib->{'_action'} eq 'add' || - $mib->{'_action'} eq 'bye' || - $mib->{'_action'} eq 'subscribe' || - $mib->{'_action'} eq 'unsubscribe' || - $mib->{'_action'} eq 'on' || - $mib->{'_action'} eq 'off' || - $mib->{'_action'} eq 'chaddr' || - $mib->{'_action'} eq 'digest' || - $mib->{'_action'} eq 'matome' || - $mib->{'_action'} eq 'addadmin' || - $mib->{'_action'} eq 'byeadmin' ) { - &__ListCtl($mib); - } - elsif ($mib->{'_action'} eq 'store_article') { - # &Distribute() calls this function after saving article - # at spool/$ID - # If you store ML articles to DB, please write the code here. - ; - } - elsif ($mib->{'_action'} eq 'store_subscribe_mail') { - # &AutoRegist() calls this function after subscribe the address - # If you store the request mail to DB, please write the code here. - ; - } - else { - &Log("ERROR: MySQL: unkown ACTION $mib->{'_action'}"); - } - - if ($mib->{'error'}) { - &Log("ERROR: MySQL: $mib->{'error'}"); - return 0; - } - - &Close; - if ($mib->{'error'}) { - &Log("ERROR: MySQL: $mib->{'error'}"); - return 0; - } - - # O.K. - return 1; - } - else { - &Log("ERROR: MySQL: no given action to do"); - } -} - - -### ***-predicate() ### - - -sub __MemberP -{ - my ($mib, $file, $addr) = @_; - my ($query, $res, $ml, @row); - - $addr = &main::LowerDomain($addr); - $ml = $mib->{'_ml_acct'}; - $query = "select address from ml "; - $query .= " where ml = '$ml' "; - $query .= " and file = '$file' "; - $query .= " and address = '$addr' "; - - ($res = &__Execute($mib, $query)) || return $NULL; - - @row = $res->fetchrow_array; - &Log("row: @row") if $debug; - - $row[0] eq $addr ? 1 : 0; -} - - -### dump lists ### - -sub GetActiveList { my($mib) = @_; &__DumpList($mib, 'actives', 1);} -sub GetMemberList { my($mib) = @_; &__DumpList($mib, 'members', 0);} -sub __DumpList -{ - my ($mib, $file, $ignore_off) = @_; - my ($max, $orgf, $newf, $ml); - my ($query); - - $ml = $mib->{'_ml_acct'}; - $query = " select address from ml "; - $query .= " where ml = '$ml' "; - $query .= " and file = '$file' "; - if ($ignore_off) { - $query .= " and off != '1' "; - } - - # cache file to dump in - $orgf = $mib->{'_cache_file'}; - $newf = $mib->{'_cache_file'}.".new.$$"; - - if (open(OUT, "> $newf")) { - my ($res, @row); - - ($res = &__Execute($mib, $query)) || do { - close(OUT); - return $NULL; - }; - - while (@row = $res->fetchrow_array) { - print OUT $row[0], "\n"; - } - close(OUT); - - if (! rename($newf, $orgf)) { - &Log("ERROR: MySQL: cannot rename $newf $orgf"); - $mib->{'error'} = "ERROR: MySQL: cannot rename $newf $orgf"; - } - } - else { - &Log("ERROR: MySQL: cannot open $newf"); - $mib->{'error'} = "ERROR: MySQL: cannot open $orgf"; - } -} - - -### amctl ### -# subscribe unsubscribe -sub __ListCtl -{ - my ($mib, $addr) = @_; - my ($status); - my ($ml, $query, $res); - - $addr = $addr || $mib->{'_address'}; - $addr = &main::LowerDomain($addr); - $ml = $mib->{'_ml_acct'}; - - &main::Log("$mib->{'_action'} $addr"); - - if ($mib->{'_action'} eq 'subscribe' || - $mib->{'_action'} eq 'add') { - - $query = " insert into ml "; - $query .= " values ('$ml', 'actives', '$addr', 0, '$NULL') "; - &__Execute($mib, $query) || return $NULL; - - $query = " insert into ml "; - $query .= " values ('$ml', 'members', '$addr', 0, '$NULL') "; - &__Execute($mib, $query) || return $NULL; - - } - elsif ($mib->{'_action'} eq 'add2actives' || - $mib->{'_action'} eq 'addactives') { - - $query = " insert into ml "; - $query .= " values ('$ml', 'actives', '$addr', 0, '$NULL') "; - &__Execute($mib, $query) || return $NULL; - - } - elsif ($mib->{'_action'} eq 'add2members' || - $mib->{'_action'} eq 'addmembers') { - - $query = " insert into ml "; - $query .= " values ('$ml', 'members', '$addr', 0, '$NULL') "; - &__Execute($mib, $query) || return $NULL; - - } - elsif ($mib->{'_action'} eq 'unsubscribe' || - $mib->{'_action'} eq 'bye') { - - $query = " delete from ml "; - $query .= " where ml = '$ml' "; - $query .= " and address = '$addr' "; - &__Execute($mib, $query) || return $NULL; - - } - elsif ($mib->{'_action'} eq 'off') { - - $query = " update ml "; - $query .= " set off = '1' "; - $query .= " where ml = '$ml' "; - $query .= " and file = 'actives' "; - $query .= " and address = '$addr' "; - &__Execute($mib, $query) || return $NULL; - - } - elsif ($mib->{'_action'} eq 'on') { - - $query = " update ml "; - $query .= " set off = '0' "; - $query .= " where ml = '$ml' "; - $query .= " and file = 'actives' "; - $query .= " and address = '$addr' "; - &__Execute($mib, $query) || return $NULL; - - } - elsif ($mib->{'_action'} eq 'chaddr') { - - my ($old_addr) = $addr; - my ($new_addr) = $mib->{'_value'}; - $new_addr = &main::LowerDomain($new_addr); - - for $file ('actives', 'members') { - $query = " update ml "; - $query .= " set address = '$new_addr' "; - $query .= " where ml = '$ml' "; - $query .= " and file = '$file' "; - $query .= " and address = '$old_addr' "; - &__Execute($mib, $query) || return $NULL; - } - } - elsif ($mib->{'_action'} eq 'digest' || - $mib->{'_action'} eq 'matome') { - - my ($opt) = $mib->{'_value'}; - $query = " update ml "; - $query .= " set options = '$opt' "; - $query .= " where ml = '$ml' "; - $query .= " and file = 'actives' "; - $query .= " and address = '$addr' "; - &__Execute($mib, $query) || return $NULL; - - } - elsif ($mib->{'_action'} eq 'addadmin') { - - $query = " insert into ml "; - $query .= " values ('$ml', 'members-admin', '$addr', 0, '$NULL') "; - &__Execute($mib, $query) || return $NULL; - - } - elsif ($mib->{'_action'} eq 'byeadmin') { - - $query = " delete from ml "; - $query .= " where ml = '$ml' "; - $query .= " and file = 'members-admin' "; - $query .= " and address = '$addr' "; - &__Execute($mib, $query) || return $NULL; - - } - else { - &Log("ERROR: MySQL: unknown ACTION $mib->{'_action'}"); - } - - if ($mib->{'error'}) { return $NULL;} -} - - -sub Count -{ - my ($mib, $file) = @_; - my ($mll, $query, $res); - - $ml = $mib->{'_ml_acct'}; - $query = " select count(address) from ml "; - $query .= " where file = '$file' "; - $query .= " and ml = '$ml' "; - ($res = &__Execute($mib, $query)) || return $NULL; - - &Log($query) if $debug; - @row = $res->fetchrow_array; - $mib->{'_result'} = $row[0]; -} - - -sub Status -{ - my ($mib, $file) = @_; - my ($mll, $query, $res, $addr); - - $addr = $mib->{'_address'}; - $addr = &main::LowerDomain($addr); - $ml = $mib->{'_ml_acct'}; - $query = " select address,off,options from ml "; - $query .= " where file = 'actives' "; - $query .= " and ml = '$ml' "; - $query .= " and address = '$addr' "; - ($res = &__Execute($mib, $query)) || return $NULL; - - &Log($query) if $debug; - my ($a, $off, $option) = $res->fetchrow_array; - - $mib->{'_result'} .= "off " if $off; - $mib->{'_result'} .= $option if $option; -} - - -sub __Error -{ - my ($s) = @_; - $mib->{'error'} = $s; -} - - -# for debug -sub RemoveAll -{ - my ($mib) = @_; - &__Execute($mib, "drop table ml"); -} - - -sub Dump -{ - my ($mib) = @_; - my ($res); - my (@row); - - print "---- table ml -----\n"; - $res = &__Execute($mib, "select * from ml order by file") || - return $NULL; - while (@row = $res->fetchrow_array) { - printf "%-10s %-10s %-40s %-3d %s\n", @row; - } - print "--- end\n"; -} - - -1; diff --git a/fml/lib/IO/Adapter/MySQL/toymodel.pm b/fml/lib/IO/Adapter/MySQL/toymodel.pm new file mode 100644 index 00000000..dbf4bfdf --- /dev/null +++ b/fml/lib/IO/Adapter/MySQL/toymodel.pm @@ -0,0 +1,140 @@ +#-*- perl -*- +# +# Copyright (C) 2000 Ken'ichi Fukamachi +# All rights reserved. +# +# $Id$ +# + + +package IO::Adapter::MySQL::toymodel; + + +use strict; +use vars qw(@ISA @EXPORT @EXPORT_OK $AUTOLOAD); +use Carp; + +=head1 NAME + +IO::Adapter::MySQL::toymodel - toymodel with SQL + +=head1 SYNOPSIS + +=head1 DESCRIPTION + +=head1 METHODS + +=cut + +sub new +{ + my ($self) = @_; + my ($type) = ref($self) || $self; + my $me = {}; + return bless $me, $type; +} + + +=head2 C + +=head2 C + +=cut + + +# Descriptions: +# Arguments: $self $args +# Side Effects: +# Return Value: none +sub open +{ + my ($self, $args) = @_; + + use DBI; + use DBD::mysql; + + my $driver = 'mysql'; + my $database = $args->{ database_name } || 'fml'; + my $host = $args->{ sql_server } || 'localhost'; + my $dsn = "DBI:$driver:$database:$host"; + my $user = $args->{ sql_user } || 'fml' || ''; + my $password = $args->{ sql_user_password} || ''; + + my $dbh = DBI->connect($dsn, $user, $password); + unless (defined $dbh) { + $args->{'error'} = $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; +} + + +=head2 C + +=cut + +sub getline +{ + my ($self, $args) = @_; + + unless ($self->{ _res }) { + $self->execute( { query => 'select address from ml' } ); + } + + my @row = $self->{ _res }->fetchrow_array; + $row[0]; +} + + +=head2 C{ + 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); + $res->execute; + + unless (defined $res) { + $self->error_reason( $DBI::errstr ); + return undef; + } + else { + $self->{ _res } = $res; + return $res; + } + } + else { + return undef; + } +} + + +1; diff --git a/regress/base/mysql_io.pl b/regress/base/mysql_io.pl new file mode 100755 index 00000000..1339e65b --- /dev/null +++ b/regress/base/mysql_io.pl @@ -0,0 +1,15 @@ +use IO::Adapter::MySQL::toymodel; + +my $obj = new IO::Adapter::MySQL::toymodel; + +$obj->open({ + sql_user => 'fukachan', + sql_user_password => '', +}); + +while ($_ = $obj->getline) { + print $_, "\n"; +} + +$obj->close; + -- cgit v1.2.1