package Newslash::Model::LegacyDB;
use Newslash::Model::Base -base;

use Newslash::Model::LegacyFirehose;
use Data::Dumper;

## WORNING:
## This is legacy from slash. deprecated, and you can use only backword-compatible.

#========================================================================

=head2 dbAvailable([TOKEN])

Returns TRUE if (as usual) the DB(s) are available for reading and
writing.  Returns FALSE if the DB(s) are not available and should not
be accessed.  If a TOKEN is named, return FALSE if either the DB(s)
required for that purpose are down or all DBs are down.  If no TOKEN is
named, return FALSE only if all DBs are down.

Whether or not the DBs are down is determined only by whether files exist
at /usr/local/slash/dboff or /usr/local/slash/dboff_TOKEN.  For best
results, admins will want to write their own db-angel scripts that detect
DBs having gone down and create one or more of those files.

=over 4

=item Parameters

=over 4

=item TOKEN

Name of the resource specifically being asked about, or the
empty string.

=back

=item Return value

0 or 1.

=back

=cut

sub dbAvailable {
    my $self = shift;
    return 1;
}

#========================================================================

=head2 getCurrentStatic([MEMBER])

Returns the current static variables (or variable).

Slash's original implement was depended to Apache and memcached,
but this implement uses redis for cache.

And in this implement, this function is method.

=over 4

=item Parameters

=over 4

=item MEMBER

A member from the static record to be returned.

=back

=item Return value

A hash reference with the static information is returned unless MEMBER is passed. If
MEMBER is passed in then only its value will be returned.

=back

=cut

sub getCurrentStatic {
    my ($self, $value, $force_secure) = @_;
    state $slash_conf = {};

#    my $kvs = $self->connect_kvs;
#    my $kvs_key = "slash_static";
#    my $constants;

#    if ($kvs->exists($kvs_key)) {
#        $constants = decode_json($kvs->get($kvs_key));
#    }
#    else {
#        $constants = $self->getSlashConf(0, 0);
#        $kvs->set($kvs_key, encode_json($constants));
    #    }

    if (!%$slash_conf) {
        $slash_conf = $self->getSlashConf(0, 0);
    }

    #return defined $value ? $constants->{$value} : $constants;
    return defined $value ? $slash_conf->{$value} : $slash_conf;
}

########################################################
sub _getSlashConf_rawvars {
	my($self, $secure, $skipcache) = @_;
	$secure = $secure ? 1 : 0;
#	my $vu = $self->{virtual_user};
#	return undef unless $vu;
#	my $mcd = $self->getMCD({ no_getcurrentstatic => 1 });
#	my $mcdkey= "x:vars$secure";
#	my $got_from_memcached = 0;
	my $vars_hr;
#	if ($mcd && !$skipcache) {
#		if ($vars_hr = $mcd->get($mcdkey)) {
#			$got_from_memcached = 1;
#		}
#	}
	$vars_hr ||= $self->sqlSelectAllKeyValue('name, value', 'vars');
#	if ($mcd && !$got_from_memcached) {
#		# Cache this for about 3 minutes.   should be a var.
#		my $expire_time = 180;
#		$mcd->set($mcdkey, $vars_hr, $expire_time);
#	}
	return $vars_hr;
}

########################################################
# Now, the idea is to not cache here, since we actually
# cache elsewhere (namely in %Slash::Apache::constants) - Brian
# I'm caching this in memcached now though. - Jamie
sub getSlashConf {
	my($self, $secure, $skipcache) = @_;

	# Get the raw vars data (possibly from a memcached cache).

	my $vars_hr = $self->_getSlashConf_rawvars($secure, $skipcache);
	return if !defined $vars_hr;
	my %conf = %$vars_hr;

	# Now start adding and tweaking the data for various reasons:
	# convenience, fixing bad data, etc.

	# This allows you to do stuff like constant.plugin.Zoo in a template
	# and know that the plugin is installed -Brian
	my $plugindata = $self->sqlSelectColArrayref('value', 'site_info',
		"name='plugin'");
	for my $plugin (@$plugindata) {
		$conf{plugin}{$plugin} = 1;
	}
	my $tagboxdata = $self->sqlSelectColArrayref('value', 'site_info',
		"name='tagbox'");
	for my $tagbox (@$tagboxdata) {
		$conf{tagbox}{$tagbox} = 1;
	}

	# This really should be a separate piece of data returned by
	# getReasons() the same way getTopicTree() works.  It's only part
	# of $constants for historical, er, reasons.
	if ($conf{m1}) {
		$conf{reasons} = $self->sqlSelectAllHashref(
			"id", "*", "modreasons"
		);
		$conf{reasons_base} = $self->sqlSelectAllHashref(
			"id", "*", "modreasons", "m2able = 1 OR val = 0"
		);
		$conf{reasons_plused} = $self->sqlSelectAllHashref(
			"id", "*", "modreasons", "m2able = 1 OR val <= 0"
		);
		$conf{reasons_minused} = $self->sqlSelectAllHashref(
			"id", "*", "modreasons", "m2able = 1 OR val >= 0"
		);
		foreach my $d (split(/,/, $conf{modreasons_select_disabled} || '')) {
			$conf{reasons}{int($d)}{select_disabled} = 1;
			$conf{reasons_base}{int($d)}{select_disabled} = 1;
			$conf{reasons_plused}{int($d)}{select_disabled} = 1;
			$conf{reasons_minused}{int($d)}{select_disabled} = 1;
		}
	}

	$conf{rootdir}		||= "//$conf{basedomain}";
	$conf{real_rootdir}	||= $conf{rootdir};  # for when rootdir changes
	$conf{real_section}	||= $conf{section};  # for when section changes
	$conf{absolutedir}	||= "http://$conf{basedomain}";
	$conf{imagedir}		||= "$conf{rootdir}/images";
		# If absolutedir_secure is not defined, it defaults to the
		# same as absolutedir.  Same for imagedir_secure.
	$conf{absolutedir_secure} ||= $conf{absolutedir};
	$conf{imagedir_secure}	||= $conf{imagedir};
	$conf{css_extension}      = 'css';
#	if (defined &Slash::Apache::ConnectionIsSSL && Slash::Apache::ConnectionIsSSL())
	if ($secure) {
		# On Secure HTTP connections, force absolutedir/imagedir to
		# be the secure versions.
		$conf{imagedir} = $conf{imagedir_secure};
		$conf{absolutedir} = $conf{absolutedir_secure};
		$conf{css_extension} = 'ssl.css';
	}
	$conf{cssdir}           ||= $conf{css_use_imagedir} ? $conf{imagedir} : $conf{rootdir};
	$conf{rdfimg}		||= "$conf{imagedir}/topics/topicslash.gif";
	$conf{adminmail_mod}	||= $conf{adminmail};
	$conf{adminmail_post}	||= $conf{adminmail};
	$conf{adminmail_ban}	||= $conf{adminmail};
	$conf{basedir}		||= "$conf{datadir}/public_html";
	$conf{index_handler}	||= 'index.pl';
	$conf{cookiepath}	||= URI->new($conf{rootdir})->path . '/';
	$conf{maxkarma}		  =  999 unless defined $conf{maxkarma};
	$conf{minkarma}		  = -999 unless defined $conf{minkarma};
	$conf{expiry_exponent}	  = 1 unless defined $conf{expiry_exponent};
	$conf{panic}		||= 0;
	$conf{textarea_rows}	||= 10;
	$conf{textarea_cols}	||= 50;
	$conf{allow_deletions}  ||= 1;
	$conf{authors_unlimited}  = 100 if !defined $conf{authors_unlimited}
		|| $conf{authors_unlimited} == 1;
		# m2_consensus must be odd
	$conf{m2_consensus}       = 2*int(($conf{m2_consensus} || 5)/2) + 1
		if !$conf{m2_consensus}
		   || ($conf{m2_consensus}-1)/2 != int(($conf{m2_consensus}-1)/2);
	$conf{nick_chars}	||= q{ abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789$_.+!*'(),-};
	$conf{nick_maxlen}	||= 20;
	$conf{cookie_location}  ||= 'classbid';
	$conf{login_temp_minutes} ||= 10;
	# For all fields that it is safe to default to -1 if their
	# values are not present...
	for (qw[min_expiry_days max_expiry_days min_expiry_comm max_expiry_comm]) {
		$conf{$_}	= -1 unless exists $conf{$_};
	}

	# no trailing newlines on directory variables
	# possibly should rethink this for basedir,
	# since some OSes don't use /, and if we use File::Spec
	# everywhere this won't matter, but still should be do
	# it for the others, since they are URL paths
	# -- pudge
	for (qw[rootdir absolutedir imagedir imagedir_secure basedir]) {
		$conf{$_} =~ s|/+$||;
	}

	my $fixup = sub {
		return [ ] if !$_[0];
		[
			map {(
				s/^\s+//,
				s/\s+$//,
				$_
			)[-1]}
			split /\|/, $_[0]
		];
	};
	my $fixup_hash = sub {
		my $ar = $fixup->(@_);
		my $hr = { };
		return $hr if !$ar;
		for my $str (@$ar) {
			my($k, $v) = split(/=/, $str);
			$v = 1 if !defined($v);
			$v = [ split ",", $v ] if $v =~ /,/;
			$hr->{$k} = $v;
		}
		$hr;
	};

	my %conf_fixup_arrays = (
		# var name			# default array value
		# --------			# -------------------
		anonymous_coward_uids =>	[ $conf{anonymous_coward_uid} ],
						# See <http://www.iana.org/assignments/uri-schemes>
		approved_url_schemes =>		[qw( ftp http gopher mailto news nntp telnet wais https )],
		approvedtags =>			[qw( b i p br a ol ul li dl dt dd em strong tt blockquote div ecode quote)],
		approvedtags_break =>		[qw(     p br   ol ul li dl dt dd              blockquote div             img hr )],
		# all known tags, plus table, pre, and slash; this can be overridden
		# in vars, but since we make this all known tags by default ...
		# easier to just keep it in here
		approvedtags_admin =>		[qw( b i p br a ol ul li dl dt dd em strong tt blockquote div ecode
						     img hr big small sub sup span
						     dfn code samp kbd var cite address ins del
						     h1 h2 h3 h4 h5 h6
						     table thead tbody tfoot tr th td pre
						     slash
						)],
		charrefs_bad_entity =>		[qw( zwnj zwj lrm rlm )],
		charrefs_bad_numeric =>		[qw( 8204 8205 8206 8207 8236 8237 8238 )],
		charrefs_good_entity =>		[qw( amp lt gt euro pound yen rsquo lsquo rdquo ldquo ndash mdash )],
		charrefs_good_numeric =>	[ ],
		cur_performance_stat_ops =>	[ ],
		firehose_story_ignore_skids =>	[ ],
		fixhrefs =>			[ ],
		hc_possible_fonts =>		[ ],
		lonetags =>			[ ],
		m2_sliding_consensus =>		[ ],
		op_exclude_from_countdaily =>   [qw( rss )],
		op_extras_countdaily =>   	[ ],
		mod_stats_reports =>		[ $conf{adminmail_mod} ],
		stats_reports =>		[ $conf{adminmail} ],
		stats_metrics_reports =>	[ $conf{adminmail} ],
		stats_sfnet_groupids =>		[ 4421 ],
		submit_categories =>		[ ],
		skins_recenttopics =>           [ ],
		subnet_karma_post_limit_range => [ ],
		search_ignore_skids =>		[ ],
	);
	my %conf_fixup_hashes = (
		# var name			# default hash of keys/values
		# --------			# --------------------
		ad_messaging_sections =>	{ },
		comments_perday_bykarma =>	{  -1 => 2,		25 => 25,	99999 => 50          },
		karma_adj =>			{ -10 => 'Terrible',	-1 => 'Bad',	    0 => 'Neutral',
						   12 => 'Positive',	25 => 'Good',	99999 => 'Excellent' },
		mod_up_points_needed =>		{ },
						#          m2_f_t m2_u_t  m1_t m1_k
		m2_consequences =>		{ 0.00 => [qw( -5    +2   -100 -1   )],
						  0.15 => [qw( -2    +1    -40 -1   )],
						  0.30 => [qw( -0.5  +0.5  -20  0   )],
						  0.35 => [qw(  0     0    -10  0   )],
						  0.49 => [qw(  0     0     -4  0   )],
						  0.60 => [qw(  0     0     +1  0   )],
						  0.70 => [qw(  0     0     +2  0   )],
						  0.80 => [qw( +0.01 -1     +3  0   )],
						  0.90 => [qw( +0.02 -2     +4  0   )],
						  1.00 => [qw( +0.05 -5     +5 +0.5 )],	},
		m2_consequences_repeats =>	{ 3 => -4, 5 => -12, 10 => -100 },
		# 40=0|30=Mainpage|20=0|10=Sectional|0=0
		topic_popup_weights	=>	{ 40 => 0, 30 => 'Mainpage', 20 => 0, 10 => 'Sectional', 0 => 0 },
	);
	for my $key (keys %conf_fixup_arrays) {
		if (defined($conf{$key})) {
			$conf{$key} = $fixup->($conf{$key});
		} else {
			$conf{$key} = $conf_fixup_arrays{$key};
		}
	}
	for my $key (keys %conf_fixup_hashes) {
		if (defined($conf{$key})) {
			$conf{$key} = $fixup_hash->($conf{$key});
		} else {
			$conf{$key} = $conf_fixup_hashes{$key};
		}
	}

	for my $var (qw(email_domains_invalid submit_domains_invalid)) {
		if ($conf{$var}) {
			my $regex = sprintf('[^\w-](?:%s)$',
				join '|', map quotemeta, split ' ', $conf{$var});
			$conf{$var} = qr{$regex};
		}
	}

	if ($conf{comment_nonstartwordchars}) {
		# Expand this into a complete regex.  We catch not only
		# these chars in their raw form, but also all HTML entities
		# (because Windows/MSIE refuses to break before any word
		# that starts with either the chars, or their entities).
		# Build the regex with qr// and match entities for
		# optimal speed.
		my $src = $conf{comment_nonstartwordchars};
		my @chars = ( );
		my @entities = ( );
		for my $i (0..length($src)-1) {
			my $c = substr($src, $i, 1);
			push @chars, "\Q$c";
			push @entities, ord($c);
			push @entities, sprintf("x%x", ord($c));
		}
		my $dotchar =
			'(?:'
				. '[' . join("", @chars) . ']'
				. '|&#(?:' . join("|", @entities) . ');'
			. ')';
		my $regex = '(\s+)' . "((?:<[^>]+>)*$dotchar+)" . '(\S)';
		$conf{comment_nonstartwordchars_regex} = qr{$regex}i;
	}

	for my $regex (qw(
		accesslog_imageregex
		x_forwarded_for_trust_regex
		lowbandwidth_bids_regex
	)) {
		next if !$conf{$regex} || $conf{$regex} eq 'NONE';
		$conf{$regex} = qr{$conf{$regex}};
	}

	# anchor
	for my $regex (qw(
		feed_types
	)) {
		next if !$conf{$regex};
		$conf{$regex} = qr{^(?:$conf{$regex})$};
	}


	for my $var (qw(approvedtags approvedtags_break lonetags)) {
		$conf{$var} = [ map lc, @{$conf{$var}} ];
	}

	for my $attrname (qw(approvedtags_attr approvedtags_attr_admin)) {
		if ($conf{$attrname}) {
			my $approvedtags_attr = $conf{$attrname};
			$conf{$attrname} = {};
			my @tags = split /\s+/, $approvedtags_attr;
			foreach my $tag (@tags){
				my($tagname, $attr_info) = $tag =~ /([^:]*)(?:\:(.*))?$/;
				my @attrs = split ',', ($attr_info || '');
				my $ord = 1;
				foreach my $attr (@attrs){
					my($at, $extra) = split /_/, $attr;
					$extra ||= '';
					$at = lc $at;
					$tagname = lc $tagname;
					$conf{$attrname}{$tagname}{$at}{ord} = $ord;
					$conf{$attrname}{$tagname}{$at}{req} = 1 if $extra =~ /R/;
					$conf{$attrname}{$tagname}{$at}{req} = 2 if $extra =~ /N/; # "necessary"
					$conf{$attrname}{$tagname}{$at}{url} = 1 if $extra =~ /U/;
					$ord++;
				}
			}
		}
	}
	if ($conf{approvedtags_attr} && $conf{approvedtags_attr_admin}) {
		for (keys %{$conf{approvedtags_attr}}) {
			# only add to _admin if not already in it
			$conf{approvedtags_attr_admin}{$_} ||= $conf{approvedtags_attr}{$_};
		}
	}

	# We only need to do this on startup.  This var isn't really used;
	# see the code comment in getObject().
	#$conf{classes} = $self->getClasses();
        $conf{classes} = $self->sqlSelectAllHashref('class', '*', 'classes');

	if ($conf{utf8}) {
		foreach my $k (keys %conf) {
			next if ref($conf{$k}) ne 'SCALAR' || Encode::is_utf8($conf{$k});
			Encode::_utf8_on($conf{$k});
		}
	}

	return \%conf;
}


#################################################################
# get list of DBs, never cache
# (do caching in getSlashConf)
# See code comment in getObject().
sub getClasses {
    my($self) = @_;
    my $ref_func = sub {
	my($self) = @_;
	my $classes = $self->sqlSelectAllHashref('class', '*', 'classes');
	return $classes;
    };
    return $self->cache_local_and_memcached('db_classes', $ref_func);
}


my $mcd_fast;
my $mcd_keyprefix;
sub getMCD {
    my ($self, $options) = @_;

    # If we already created it for this object, or if we tried to
    # create it and failed and assigned it 0, return that.
    return $self->{_mcd} if defined($self->{_mcd});
    if (defined $mcd_fast) {
        $self->{_mcd} = $mcd_fast;
        $self->{_mcd_keyprefix} = $mcd_keyprefix;
        return $self->{_mcd};
    }

    # If we aren't using memcached, return false.
    my $constants;
    #if ($self =~ /Slash::DB::Static::MySQL/ || $options->{no_getcurrentstatic}) {
    #    # If our caller needs getMCD because it's going to
    #    # set up vars, we can't rely on $self->getCurrentStatic.
    #    # So get the vars we need directly.
    #    my @needed = qw( memcached memcached_keyprefix memcached_servers );
    #    my $in_clause = join ",", map { $self->sqlQuote($_) } @needed;
    #    $constants = $self->sqlSelectAllKeyValue(
    #                                             "name, value",
    #                                             "vars",
    #                                             "name IN ($in_clause)");
    #} else {
    $constants = $self->getCurrentStatic();
    #}
    return 0 if !$constants->{memcached} || !$constants->{memcached_servers};

    # OK, let's try memcached.  The memcached_servers var is in the format
	# "10.0.0.15:11211 10.0.0.15:11212 10.0.0.17:11211=3".

    my @servers = split / /, $constants->{memcached_servers};
    for my $server (@servers) {
        if ($server =~ /(.+)=(\d+)$/) {
            $server = [ $1, $2 ];
        }
    }
    require Cache::Memcached::Fast;
    $mcd_fast = Cache::Memcached::Fast->new({
                                             servers =>	[ @servers ],
                                             utf8 =>	1,
                                             #		compress_methods => [ \&IO::Compress::Gzip::gzip, \&IO::Uncompress::Gunzip::gunzip ],
                                             #		debug => 1,
                                            });
    my $check = $mcd_fast->server_versions;
    if (!keys %{$check}) {
        # Can't connect; not using it.
        $mcd_fast = undef;
        return;
    }
    $self->{_mcd} = $mcd_fast;
    if ($constants->{memcached_keyprefix}) {
        $self->{_mcd_keyprefix} = $constants->{memcached_keyprefix};
    } else {
        $self->{_mcd_keyprefix} = 'x';
    }
    $mcd_keyprefix = $self->{_mcd_keyprefix};
    return $self->{_mcd};
}

##################################################################
sub getMCDStats {
    my ($self) = @_;
    my $mcd = $self->getMCD();
    return undef unless $mcd && $mcd->can("stats");

    my $stats = $mcd->stats();
    for my $server (keys %{$stats->{hosts}}) {
        _getMCDStats_percentify($stats->{hosts}{$server}{misc},
                                qw(	get_hits	cmd_get		get_hit_percent ));
        _getMCDStats_percentify($stats->{hosts}{$server}{malloc},
                                qw(	total_alloc	arena_size	total_alloc_percent ));
    }
    _getMCDStats_percentify($stats->{total},
                            qw(	get_hits	cmd_get		get_hit_percent ));
    _getMCDStats_percentify($stats->{total},
                            qw(	malloc_total_alloc	malloc_arena_size	malloc_total_alloc_percent ));
    return $stats;
}

sub _getMCDStats_percentify {
    my($hr, $num, $denom, $dest) = @_;
    my $perc = "-";
    $perc = sprintf("%.1f", $hr->{$num}*100 / $hr->{$denom}) if $hr->{$denom};
    $hr->{$dest} = $perc;
}

########################################################

#  now we don't use local cache.

#my $cache_master;
sub cache_local_and_memcached {
    my ($self, $name, $ref_func, $local_expire, $mcd_expire, $param) = @_;
    return unless $name or $ref_func;
    $mcd_expire ||= 259200; # 84600 * 3
    my $attime = time();
    #$cache_master->{$name}{set} //= 0;

    #if ($local_expire && $cache_master->{$name}{set} + $local_expire < $attime) {
    #    $cache_master->{$name}{data} = undef;
    #}

    #if (!defined $cache_master->{$name}{data}) {
        # try mcd
    my $mcd = $self->getMCD();
    #$cache_master->{$name}{data} = $mcd->get("$self->{_mcd_keyprefix}:$name") if ($mcd);
    my $result;
    $result = $mcd->get("$self->{_mcd_keyprefix}:$name") if ($mcd);

    # get data from db, set mcd
    #if (!defined $cache_master->{$name}{data}) {
    if (!defined $result) {
        if ($param) {
            #$cache_master->{$name}{data} = $ref_func->($self, $param);
            $result = $ref_func->($self, $param);
        } else {
            #$cache_master->{$name}{data} = $ref_func->($self);
            $result = $ref_func->($self);
        }
        #$cache_master->{$name}{set} = $attime;
        #$cache_master->{$name}{data} //= '';
        #$mcd->set("$self->{_mcd_keyprefix}:$name", $cache_master->{$name}{data}, $mcd_expire) if ($mcd);
        $mcd->set("$self->{_mcd_keyprefix}:$name", $result, $mcd_expire) if ($mcd);
    }
    #return $cache_master->{$name}{data};
    return $result;
}

sub delete_local_and_memcached {
    my($self, $name) = @_;
    #$cache_master->{$name} = undef;
    my $mcd = $self->getMCD();
    $mcd->delete("$self->{_mcd_keyprefix}:$name") if ($mcd);
}

sub sqlConnect {
    my ($self, $restart) = @_;
    if ($restart) {
        $self->{_dbh}->disconnect;
    }
    $self->{_dbh} = $self->connect_db();

    if ($self->{_dbh}) {
        return 1;
    } else {
        return undef;
    }
}

sub DESTROY {
    my $self = shift;
    if ($self->{_dbh}) {
        $self->{_dbh}->disconnect
    }
}

sub sqlSelect {
    my ($self, $select, $from, $where, $other, $options) = @_;
    #$self->_refCheck($where);
    my $distinct = ($options && $options->{distinct}) ? "DISTINCT" : "";
    my $sql = "SELECT $distinct $select ";
    $sql .= "FROM $from " if $from;
    $sql .= "WHERE $where " if $where;
    $sql .= "$other" if $other;

    $self->sqlConnect() or return undef;
    #my $qlid = $self->_querylog_start("SELECT", $from);
    my $sth = $self->{_dbh}->prepare($sql);
    if (!$sth->execute) {
    #    $self->sqlErrorLog($sql);
        $self->sqlConnect;
        return undef;
    }
    my @r = $sth->fetchrow;
    $sth->finish;

    #$self->_querylog_finish($qlid);

    if (wantarray()) {
        return @r;
    } else {
        return $r[0];
    }
}

sub sqlUpdate {
    my ($self, $tables, $data, $where, $options) = @_;
    return if $self->check_readonly;
    #$self->_refCheck($where);

    # If no changes were passed in, there's nothing to do.
    # (And if we tried to proceed we'd generate an SQL error.)
    return 0 if !keys %$data;

    my $sql = "UPDATE ";
    # What's inside /*! */ will be treated as a comment by most
    # other SQL servers, but MySQL will parse it.  Kinda pointless
    # since we've basically given up on ever supporting DBs other
    # than MySQL, but what the heck.
    $sql .= "/*! IGNORE */ " if $options->{ignore};

    my $table_str;
    if (ref $tables) {
        $table_str = join(",", @$tables);
    } else {
        $table_str = $tables;
    }
    $sql .= $table_str;
    
    my $order_hr = { };
    if ($options && $options->{assn_order}) {
        # Reorder the data fields into the order given.  Any
        # fields not specified in the assn_order arrayref
        # go last.  Note that the "-" prefix for each field
        # must be included in assn_order keys.
        # <http://www.mysql.com/documentation/mysql/bychapter/
        # manual_Reference.html#UPDATE>
        # "UPDATE assignments are evaluated from left to right."
        my $order_ar = $options->{assn_order};
        for my $i (0..$#$order_ar) {
            $order_hr->{$order_ar->[$i]} = $i + 1;
        }
    }
    # In any case, the field names are sorted.  This is new
    # behavior as of August 2002.  It should not break anything,
    # because nothing previous should have relied on perl's
    # natural hash key sort order!
    my @data_fields = ( );
    @data_fields = sort {
        ($order_hr->{$a} || 9999) <=> ($order_hr->{$b} || 9999)
          ||
          $a cmp $b
      } keys %$data;
    my @set_clauses = ( );
    for my $field (@data_fields) {
        if ($field =~ /^-/) {
            $field =~ s/^-//;
            push @set_clauses, "$field = $data->{-$field}";
        } else {
            my $data_q = $self->sqlQuote($data->{$field});
            push @set_clauses, "$field = $data_q";
        }
    }
    $sql .= " SET " . join(", ", @set_clauses) if @set_clauses;

    $sql .= " WHERE $where" if $where;

    #my $qlid = $self->_querylog_start("UPDATE", $table_str);
    my $rows = $self->sqlDo($sql);
    #$self->_querylog_finish($qlid);
    return $rows;
}

sub sqlDelete {
    my ($self, $table, $where, $limit) = @_;
    return if $self->check_readonly;
    #$self->_refCheck($where);
    return unless $table;
    my $sql = "DELETE FROM $table";
    $sql .= " WHERE $where" if $where;
    $sql .= " LIMIT $limit" if $limit;
    #my $qlid = $self->_querylog_start("DELETE", $table);
    my $rows = $self->sqlDo($sql);
    #$self->_querylog_finish($qlid);
    return $rows;
}

sub sqlSelectMany {
    my($self, $select, $from, $where, $other, $options) = @_;
    #$self->_refCheck($where);

    my $distinct = ($options && $options->{distinct}) ? "DISTINCT" : "";
    my $sql = "SELECT $distinct $select ";
    $sql .= "   FROM $from " if $from;
    $sql .= "  WHERE $where " if $where;
    $sql .= "        $other" if $other;

    $self->sqlConnect() or return undef;
    my $sth = $self->{_dbh}->prepare($sql);
    if ($sth->execute) {
        return $sth;
    } else {
        #$self->sqlErrorLog($sql);
        $sth->finish;
        $self->sqlConnect;
        return undef;
    }
}

sub sqlQuote {
    my($self, $value) = @_;
    $self->sqlConnect() or return undef;
    if (ref($value) eq 'ARRAY') {
        my(@array);
        for (@$value) {
            push @array, $self->{_dbh}->quote($_);
        }
        return \@array;
    } else {
        return $self->{_dbh}->quote($value);
    }
}

sub sqlInsert {
    my ($self, $table, $data, $options) = @_;
    return if $self->check_readonly;
    my ($names, $values);
    # What's inside /*! */ will be treated as a comment by most
    # other SQL servers, but MySQL will parse it.  Kinda pointless
    # since we've basically given up on ever supporting DBs other
    # than MySQL, but what the heck.
    #my $delayed = ($options->{delayed} && !getCurrentStatic('delayed_inserts_off'))
    #  ? " /*! DELAYED */" : "";
    my $delayed = ""; # delayed_inserts_off is 1
    my $ignore = $options->{ignore} ? " /*! IGNORE */" : "";

    for (keys %$data) {
        if (/^-/) {
            $values .= "\n  $data->{$_},";
            s/^-//;
        } else {
            $values .= "\n  " . $self->sqlQuote($data->{$_}) . ',';
        }
        $names .= "$_,";
    }

    chop($names);
    chop($values);

    my $sql = "INSERT $ignore $delayed INTO $table ($names) VALUES($values)\n";
    #my $qlid = $self->_querylog_start("INSERT", $table);
    my $rows = $self->sqlDo($sql);
    #$self->_querylog_finish($qlid);
    return $rows;
}

sub sqlDo {
    my ($self, $sql) = @_;
    #$self->_refCheck($sql);
    $self->sqlConnect() or return undef;
    #if (getCurrentStatic('utf8')) {
    #    is_utf8($sql) or $sql = decode_utf8($sql);
    #}
    my $rows = $self->{_dbh}->do($sql);
    unless ($rows) {
        unless ($sql =~ /^INSERT\s+IGNORE\b/i) {
            #$self->sqlErrorLog($sql);
        }
        $self->sqlConnect;
        return;
    }

    return $rows;
}

sub getLastInsertId {
    my ($self, $options) = @_;
    my $id = $self->{_dbh}->last_insert_id(undef, undef, undef, undef);
    return $id;
}

sub sqlSelectColArrayref {
    my ($self, $select, $from, $where, $other, $options) = @_;
    #$self->_refCheck($where);
    my $distinct = ($options && $options->{distinct}) ? "DISTINCT" : "";
    my $sql_no_cache = ($options && $options->{sql_no_cache}) ? " SQL_NO_CACHE" : "";

    my $sql = "SELECT $distinct$sql_no_cache $select ";
    $sql .= "FROM $from " if $from;
    $sql .= "WHERE $where " if $where;
    $sql .= "$other" if $other;

    $self->sqlConnect() or return undef;
    #my $qlid = $self->_querylog_start("SELECT", $from);
    my $sth = $self->{_dbh}->prepare($sql);
    unless ($sth) {
        #$self->sqlErrorLog($sql);
        $self->sqlConnect;
        return;
    }

    my $array = $self->{_dbh}->selectcol_arrayref($sth);
    unless (defined($array)) {
        #$self->sqlErrorLog($sql);
        $self->sqlConnect;
        return;
    }
    #$self->_querylog_finish($qlid);

    return $array;
}

sub sqlSelectHashref {
    my ($self, $select, $from, $where, $other) = @_;
    #$self->_refCheck($where);

    my $sql = "SELECT $select ";
    $sql .= "FROM $from " if $from;
    $sql .= "WHERE $where " if $where;
    $sql .= "$other" if $other;

    $self->sqlConnect() or return undef;
    #my $qlid = $self->_querylog_start("SELECT", $from);
    my $sth = $self->{_dbh}->prepare($sql);

    unless ($sth->execute) {
        #$self->sqlErrorLog($sql);
        $self->sqlConnect;
        return;
    }
    my $H = $sth->fetchrow_hashref;
    $sth->finish;
    #$self->_querylog_finish($qlid);
    return $H;
}

########################################################
# sqlSelectAll - this function returns the entire
# array ref of all records selected. Use this in the case
# where you want all the records and have to do a time consuming
# process that would tie up the db handle for too long.
#
# inputs:
# select - columns selected
# from - tables
# where - where clause
# other - limit, asc ...
#
# returns:
# array ref of all records
sub sqlSelectAll {
    my ($self, $select, $from, $where, $other) = @_;
    #$self->_refCheck($where);

    my $sql = "SELECT $select ";
    $sql .= "FROM $from " if $from;
    $sql .= "WHERE $where " if $where;
    $sql .= "$other" if $other;

    $self->sqlConnect() or return undef;

    #my $qlid = $self->_querylog_start("SELECT", $from);
    my $H = $self->{_dbh}->selectall_arrayref($sql);
    unless ($H) {
        #$self->sqlErrorLog($sql);
        $self->sqlConnect;
        return undef;
    }
    #$self->_querylog_finish($qlid);
    return $H;
}

sub sqlGetColumnData {
    my($self, $table, $col) = @_;
    return unless $table;

    $self->sqlConnect() or return undef;
    my $hr = $self->{_dbh}->selectall_hashref("SHOW COLUMNS FROM $table", 'Field');
    if ($col) {
        # Return only one column's data.
        return exists($hr->{$col}) ? $hr->{$col} : undef;
	}
    # Return all columns' data in a big hashref.
    return $hr;
}

########################################################
# sqlSelectAllKeyValue - this function returns the entire
# set of rows in a hashref, where the keys are the first
# column requested and the values are the second.
# (Name collisions are the caller's problem)
#
# inputs:
# select - exactly 2 columns to select
# from - tables
# where - where clause
# other - limit, asc ...
#
# returns:
# hashref, keys first column, values the second
sub sqlSelectAllKeyValue {
    my ($self, $select, $from, $where, $other) = @_;
    #$self->_refCheck($where);

    my $sql = "SELECT $select ";
    $sql .= "FROM $from " if $from;
    $sql .= "WHERE $where " if $where;
    $sql .= "$other" if $other;

    $self->sqlConnect() or return undef;

    #my $qlid = $self->_querylog_start("SELECT", $from);
    my $H = $self->{_dbh}->selectall_arrayref($sql);
    unless ($H) {
        #$self->sqlErrorLog($sql);
        $self->sqlConnect;
        return undef;
    }
    #$self->_querylog_finish($qlid);

    my $hashref = { };
    for my $duple (@$H) {
        $hashref->{$duple->[0]} = $duple->[1];
    }
    return $hashref;
}

########################################################
# sqlSelectAllHashref - this function returns the entire
# set of rows in a hash.
#
# inputs:
# id -  column to use as the hash key
# select - columns selected
# from - tables
# where - where clause
# other - limit, asc ...
#
# returns:
# hash ref of all records
sub sqlSelectAllHashref {
    my($self, $id, $select, $from, $where, $other, $options) = @_;
    #$self->_refCheck($where);
    # Yes, if $id is not in $select things will be bad

    # Allow $id to be an arrayref to collect multiple rows of results
    # keyed by more than one column.  E.g. if you "GROUP BY foo, bar"
    # then pass "[qw( foo bar )]" for $id and the column "baz" will
    # be at $returnable->{$foovalue}{$barvalue}{baz}.
    $id = [ $id ] if !ref($id);

    my $sql = "SELECT $select ";
    $sql .= "FROM $from " if $from;
    $sql .= "WHERE $where " if $where;
    $sql .= "$other" if $other;

    #my $qlid = $self->_querylog_start("SELECT", $from);
    my $sth = $self->sqlSelectMany($select, $from, $where, $other);
    return undef unless $sth;
    my $returnable = { };
    while (my $row = $sth->fetchrow_hashref) {
        my $reference = $returnable;
        for my $next_id (@$id) {
            $reference = \%{$reference->{$row->{$next_id}}};
        }
        %$reference = %$row;
        if ($options->{thin}) {
            for my $next_id (@$id) {
                delete $reference->{$next_id};
            }
        }
    }
    $sth->finish;
    #$self->_querylog_finish($qlid);

    return $returnable;
}

########################################################
# sqlSelectAllHashrefArray - this function returns the entire
# set of rows in a array where the elements are the hash.
#
# inputs:
# select - columns selected
# from - tables
# where - where clause
# other - limit, asc ...
#
# returns:
# array ref of all records
sub sqlSelectAllHashrefArray {
	my($self, $select, $from, $where, $other) = @_;
#	$self->_refCheck($where);

	my $sql = "SELECT $select ";
	$sql .= "FROM $from " if $from;
	$sql .= "WHERE $where " if $where;
	$sql .= "$other" if $other;

#	my $qlid = $self->_querylog_start("SELECT", $from);
	my $sth = $self->sqlSelectMany($select, $from, $where, $other);
	return undef unless $sth;
#	my @returnable = ( );
#	while (my $row = $sth->fetchrow_hashref) {
#		push @returnable, $row;
#	}
    #
    #  fetchall_arrayref will return an
    #  array of hashes if given an empty
    #  hashref as an arguement.
    #
    my($rreturn) = $sth->fetchall_arrayref({});
	$sth->finish;
#	$self->_querylog_finish($qlid);

	return $rreturn;
}


# getObject - supports only some classses
sub getObject {
    my ($self, $class, $data, @args) = @_;
    if ($class eq 'Slash::FireHose') {
        #return $self->new_instance_of('LegacyFirehose');
        return Newslash::Model::LegacyFirehose->new($self->{options});
    }
    elsif ($class eq 'Slash::DB') {
        return $self;
    }
    elsif ($class eq 'Slash::Journal') {
        return;
    }
    elsif ($class eq 'Slash::Zoo') {
        return;
    }
    elsif ($class eq 'Slash::Messages') {
        return;
    }
    elsif ($class eq 'Slash::TagModeration') {
        return;
    }
    elsif ($class eq 'Slash::HumanConf') {
        return;
    }
    elsif ($class eq 'Slash::Tags') {
        return Newslash::Model::Tags->new($self->{options});
    }
    elsif ($class eq 'Slash::PollBooth') {
        return;
    }
    elsif ($class eq 'Slash::Remarks') {
        return;
    }
    elsif ($class eq 'Slash::Tagbox') {
        return;
    }
    else {
        return;
    }
}


# querylogs - no use.
sub _querylog_enabled { return 0; }
sub _querylog_start { return 0; }
sub _querylog_finish { return; }
sub _querylog_writecache { return; }


{ # closure
my $_textcollen_hr = { };
sub sqlGetCharColumnLength {
	my($self, $table, $col) = @_;
	return undef unless $table && $col;
	return $_textcollen_hr->{$table}{$col} if exists $_textcollen_hr->{$table}{$col};
	$self->sqlConnect() or return undef;
	my $hr = $self->sqlGetColumnData($table, $col);
	return $_textcollen_hr->{$table}{$col} = undef if !$hr;
	my $type = $hr->{Type};
	return $_textcollen_hr->{$table}{$col} = undef unless $type && $type =~ /^(?:var)?char\((\d+)\)$/i;
	return $_textcollen_hr->{$table}{$col} = $1;
}
} # end closure

1;
