mysql toymodelsnap-20010311

1 files changed, 478 insertions, 0 deletions

diff --git a/fml/lib/IO/Adapter/MySQL/toymodel.pl b/fml/lib/IO/Adapter/MySQL/toymodel.pl
new file mode 100644
index 00000000..78a58b2e
--- /dev/null
+++ b/fml/lib/IO/Adapter/MySQL/toymodel.pl
@@ -0,0 +1,478 @@
+#-*- 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<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 $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<execute($args)
+
+execute sql query.
+
+    $args->{ 
+	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;