view release on metacpan or  search on metacpan

t/fake-mysql  view on Meta::CPAN

my $start_dsn;
my $start_dsn_user;
my $start_dsn_password;

my $remote_dsn;
my $remote_dsn_user;
my $remote_dsn_password;

my $port = '23306';
my $interface = '127.0.0.1';
my $debug;
my @config_names;
my @rules;
my %storage;

my @args = @ARGV;

my $result = GetOptions(
	"dsn=s"			=> \$start_dsn,
	"dsn_user=s"		=> \$start_dsn_user,
	"dsn_password=s"	=> \$start_dsn_password,
	"remote_dsn=s"		=> \$remote_dsn,
	"remote_dsn_user=s"	=> \$remote_dsn_user,
	"remote_dsn_password=s"	=> \$remote_dsn_password,
	"port=i"		=> \$port,
	"config=s"		=> \@config_names,
	"if|interface|ip=s"	=> \$interface,
	"debug"			=> \$debug
) or die;

@ARGV = @args;

my $start_dbh;
if (defined $start_dsn) {
	print localtime()." [$$] Connecting to DSN $start_dsn.\n" if $debug;
	$start_dbh = DBI->connect($start_dsn, $start_dsn_user, $start_dsn_password);
}

$storage{dbh} = $start_dbh;
$storage{dsn} = $start_dsn;
$storage{dsn_user} = $start_dsn_user;
$storage{dsn_password} = $start_dsn_password;

$storage{remote_dsn} = $remote_dsn;
$storage{remote_dsn_user} = $remote_dsn_user;
$storage{remote_dsn_password} = $remote_dsn_password;

foreach my $config_name (@config_names) {
	my $config_sub;
	open (CONFIG_FILE, $config_name) or die "unable to open $config_name: $!";
	read (CONFIG_FILE, my $config_text, -s $config_name);
	close (CONFIG_FILE);
	eval ('$config_sub = sub { '.$config_text.'}') or die $@;
	my @config_rules = &$config_sub();
	push @rules, @config_rules;
	print localtime()." [$$] Loaded ".($#config_rules + 1)." rules from $config_name.\n" if $debug;
}

socket(SERVER_SOCK, PF_INET, SOCK_STREAM, getprotobyname('tcp'));
setsockopt(SERVER_SOCK, SOL_SOCKET, SO_REUSEADDR, pack("l", 1));
bind(SERVER_SOCK, sockaddr_in($port, inet_aton($interface))) || die "bind: $!";
listen(SERVER_SOCK,1);

print localtime()." [$$] Note: port $port is now open on interface $interface.\n" if $debug;
while (1) {
	my $remote_paddr = accept(my $remote_socket, SERVER_SOCK);

	if (!defined(my $pid = fork)) {
		die "cannot fork: $!";
	} elsif ($pid) {
		next;
	}

	$storage{dbh} = $start_dbh->clone() if defined $start_dbh;
	$storage{dsn} = $start_dsn;
	$storage{args}= \@ARGV;
	
	my $dbh = get('dbh');
	my $myserver = DBIx::MyServer::DBI->new(
		socket => $remote_socket,
		dbh => $dbh,
		banner => $0.' '.join(' ', @ARGV)
	);
	set('myserver', $myserver);

	$myserver->sendServerHello();
	my ($username, $database) = $myserver->readClientHello();
	set('username', $username); set('database', $database);

        eval {
		my $hersockaddr = getpeername($myserver->getSocket());
		my ($port, $iaddr) = sockaddr_in($hersockaddr);
		my $remote_host = inet_ntoa($iaddr);
		set('remote_host', $remote_host);
        };
	
	$myserver->sendOK();

	while (1) {
		my ($command, $query) = $myserver->readCommand();
		print localtime()." [$$] command: $command; data = $query\n" if $debug;
		last if (not defined $command) || ($command == DBIx::MyServer::COM_QUIT);

		my $outgoing_query = $query;

		foreach my $i (0..$#rules) {

			my $rule = $rules[$i];
			my $rule_matches = 0;

			my @placeholders;

			if (defined $rule->{command}) {
				if ($command == $rule->{command}) {
					$rule_matches = 1;
				} else {
					next;
				}
			} 

			my $match_type = ref($rule->{match});