File sqlgrey.patch of Package perl-DBIx-DBCluster

diff -uNr ../../DBIx-DBCluster-0.01/Changes DBIx-DBCluster-0.01/Changes
--- ../../DBIx-DBCluster-0.01/Changes	2003-06-17 22:00:50.000000000 +0200
+++ DBIx-DBCluster-0.01/Changes	2012-02-13 17:54:08.000000000 +0100
@@ -3,5 +3,6 @@
 0.01  Tue Jun 17 13:54:47 2003
 	- original version; framework created by h2xs 1.21
 
-
+      2006
+	- Modified for use in sqlgrey by Dan Faerch
 
diff -uNr ../../DBIx-DBCluster-0.01/DBCluster.pm DBIx-DBCluster-0.01/DBCluster.pm
--- ../../DBIx-DBCluster-0.01/DBCluster.pm	2003-06-17 22:00:18.000000000 +0200
+++ DBIx-DBCluster-0.01/DBCluster.pm	2012-02-13 17:54:08.000000000 +0100
@@ -27,7 +27,7 @@
 our $CLUSTERS;
 our $DEBUG;
 our @WRITE_COMMANDS;
-
+our $WRITE_HOSTS_NEVER_READ;
 
 my %PRIVATE;
 
@@ -42,7 +42,6 @@
 	my ($write_dbh,$read_dbh);
 	my $hostname = _get_hostname($dsn);
 
-
 	_debug("Analyzing this hostname/label: $hostname");
 	_debug("No such label found in cluster definitions - will try this as a hostname") unless defined $CLUSTERS->{$hostname};
 
@@ -159,10 +158,20 @@
 sub _get_hostname {
 	my $driver_args = (split(':', shift))[2];
 
+
 	return '' unless $driver_args;
 
-	$driver_args =~ /^.+\@(.+)$/;
-	return $1 if $1;
+	$driver_args =~ /^.+\@((.+))$/;
+	return $2 if $2;
+#	$driver_args =~ /^.+\@(.+)$/;
+#	if ($1){ return $1 } ;
+
+# For some strange resaon $1 ALWAYS contains programname (like $0) under some scripts
+# Coulndt figure out why, so came up with the above ugly little hack.
+#	$driver_args =~ /^.+\@(.+)$/;
+#	return $1 if $1;
+
+
 
 	$driver_args =~ /host=([^;]+)/;
 	return $1 if $1;
@@ -415,12 +424,12 @@
 		if ($PRIVATE{$self}->{QUERY_STATE} eq 'TRANSACTION_WRITE' || $self->_compare_tables_used($sql)){
 			$selection = 'WRITE_DBH';
 		} else {
-			$selection = 'AUTO';
+			$selection = ($WRITE_HOSTS_NEVER_READ)?'READ_DBH':'AUTO';
 		}
 
 		my $server = $self->_choose_server($selection);
 
-		_debug("Statement directed to $server");
+		_debug("Read Statement directed to $server");
 
 		$result = $PRIVATE{$self}->{$server}->$command($sql, @_);
 	}