#!/usr/bin/perl -w
use strict;
$|=1;

my ($config, %optctl);
my ($nf, $c);
my ($mysql_dbh, $mssql_dbh);

sub debug { print "[$0] @_\n" if $config->{debug} }

use Jabber::Connection;
use Jabber::NodeFactory;
use Jabber::NS qw(:all);
use DBI;
use DBD::Sybase;
use XML::Simple;
use Getopt::Long;
use Encode;
#use Encode::Guess qw/ascii cp1250 cp1252 cp850 cp852 iso-8859-1 iso-8859-15 iso-8859-2 utf8/;
use HTML::Entities qw(encode_entities_numeric);

use Data::Dumper;
$Data::Dumper::Indent=1;
$Data::Dumper::Useqq=1;
$Data::Dumper::Terse=1;

# Fetch command-line options

$optctl{config} = "";
&GetOptions(\%optctl, "config=s");
$optctl{config} = undef unless ($optctl{config} ne "");

# Read config file
$config = XMLin($optctl{config});

# "trap" sigint
sub terminate {
	my $signame = shift;
    warn "Somebody sent me a SIG$signame. Terminating...\n";

	$c->disconnect;
	$mysql_dbh->disconnect;
	$mssql_dbh->disconnect;

	die "\n";
}

$SIG{INT} = \&terminate;
$SIG{TERM} = \&terminate;


# Create a new node factory
$nf = new Jabber::NodeFactory;

# Open connection to Jabber server
$c = new Jabber::Connection(
  server  => $config->{'jabber'}->{'server'},
  log     => $config->{'log'} || 0,
  debug   => $config->{'debug'} || 0,
);

$c->connect or die "oops: cannot connect to $config->{jabber}->{server}". 
	"last error: ". Dumper($c->lastError);

# Register handlers
$c->register_beat(300, \&get_valid_ids);
$c->register_beat(10, \&slurp_and_pump);

$c->register_handler('message', \&incoming_message);

# Identify and authenticate with the server
$c->auth(
 $config->{jabber}->{user}, 
 $config->{jabber}->{password},
 $config->{jabber}->{resource}
) or die "Cannot authenticate with Jabber server\n";

# Send presence
$c->send('<presence/>');

# Create a new db connection
&mysql_db_connect;
&mssql_db_connect;

&get_valid_ids;

# Start processing loop
$c->start();

#
# db_connect - connect to the database
#
sub mssql_db_connect {
	my $dsn =
		"DBI:Sybase:server=" . $config->{mssql}->{server}.
		";database=" . $config->{mssql}->{database};
	$mssql_dbh = DBI->connect($dsn,
		$config->{mssql}->{user},
		$config->{mssql}->{password},
		{PrintError => 0})
	or die "Cannot connect to MS SQL ($!), error: $DBI::errstr\n";
}

sub mysql_db_connect {
	my $dsn = 
		"DBI:mysql:database=".$config->{mysql}->{database}.
		";host=".$config->{mysql}->{server};
	$mysql_dbh = DBI->connect($dsn, 
		$config->{mysql}->{user},
		$config->{mysql}->{password},
		{PrintError => 0})
	or die "Cannot connect to MS SQL ($!), error: $DBI::errstr\n";
}

my @valid_ids;

sub get_valid_ids {
	debug "Refreshing Valid Logins\n";
	my $db_h = DBI->connect(
		"DBI:mysql:database=".$config->{mysql}->{jabberdb},
		$config->{mysql}->{user},
		$config->{mysql}->{password},
		{PrintError => 0}
	) or do { warn "get_valid_ids connect error\n"; return };

	my $query = "SELECT `username` FROM `authreg`";
	my $sth = $db_h->prepare($query)
		or do { warn "get_valid_ids prepare error\n"; return };
	$sth->execute() 
		or do { warn "get_valid_ids execute error\n"; return };

	my $row5;
	my @new_ids;
	while($row5 = $sth->fetchrow_hashref) {
		debug "[". $row5->{'username'} . "]\n";
		my $tmp = $row5->{'username'};
		chomp $tmp;
		push @new_ids, $tmp;
	}
	@valid_ids = @new_ids;
	$sth->finish();
	$db_h->disconnect();
}

sub valid_login {
	my $in = shift;
	chomp $in;
	$in = lc $in;
	for(@valid_ids) {
		$in eq $_ and return 1;
	}
	return 0;
}


#
# OKJabber - mark particular message as done
#
sub OKJabber {
	my $id = shift;
	$id == int($id) or do { warn "OKJabber: expecting int, got $id\n"; return}; 
	$mssql_dbh->ping or &mssql_db_connect;
	my $sth = $mssql_dbh->prepare("exec OKJabber $id") or return;
	$sth->execute();
}
#
# ErrJabber - mark particular message as wrong (?)
#
sub ErrJabber {
	my ($id, $reason) = (shift, shift);
	warn "ErrJabber: $id -> $reason\n";
	$id == int($id) or do { warn "ErrJabber: expecting int, got $id\n"; return}; 
	$mssql_dbh->ping or &mssql_db_connect;
	my $sth = $mssql_dbh->prepare("exec ErrJabber $id") or return;
	$sth->execute();
}

#
# get_em - get external messages and archive them
#
sub get_em {
	debug "Getting External Queued Messages\n";

	my $row;

	# check if we still have a valid database connection(s)
	$mysql_dbh->ping or &mysql_db_connect;
	$mssql_dbh->ping or &mssql_db_connect;

	# select messages from external queue
	my $select_em = $mssql_dbh->prepare("exec GetJabber")
		or do { warn "cannot prepare() GetJabber\n"; return; };
	$select_em->execute()
		or do { warn "cannot execute() GetJabber\n"; return; };

	do {
		while($row = $select_em->fetchrow_hashref) {
			# WE ARE READING FROM STORED PROCEDURE - RTFM
			next unless $select_em->{syb_result_type} == CS_ROW_RESULT;

			debug "Got row:\n", Dumper($row), "\n";

			my $emid = $row->{'Id'};
			# integer Id?
			$emid == int($emid) or do { 
				ErrJabber($emid, "Expecting int, got $emid");
				next;
			};
			my $login = $row->{'Login'};
			my $komunikat = $row->{'Komunikat'};

			# strip NT domain part, incl. backslash
			$login =~ s/^\w+\\//;
			# strip '@' and after
			$login =~ s/\@.*$//;

			# existing login? 
			debug "checking if login $login is valid\n";
			valid_login($login) or do {
				ErrJabber($emid, "No such login: $login");
				next;
			};

			debug "archiving ext_id $emid\n";

			$komunikat = decode($config->{'mssql'}->{'charset'}, $komunikat);
			debug "decoded from ".$config->{'mssql'}->{'charset'}.": ", Dumper($komunikat);

			$komunikat = encode($config->{'mysql'}->{'charset'}, $komunikat);
			debug "encoded to ".$config->{'mysql'}->{'charset'}.": ", Dumper($komunikat);

			my $archive_query = 'INSERT INTO `messages`(`ext_id`, `do`, `text`, `sent`) '.
				"VALUES( $emid, '".$login."', '".$komunikat."', 0)";
			# DBD::mysql - escaping backslash !
			$archive_query =~ s/\\/\\\\/g;
			my $archive_em = $mysql_dbh->prepare($archive_query) or do {
				ErrJabber($emid, "cannot prepare for archiving" ); 
				next;
			};
			$archive_em->execute() or do {
				ErrJabber($emid, "cannot execute query: $archive_query");
				next;
			};
			# mark as done
			debug "calling OKJabber for emid $emid\n";
			OKJabber($emid) or warn "problem with OKJabber($emid)\n";
		}
	} while($select_em->{syb_more_results});
}

#
# send_m - send archived messages
#
sub send_m {
	debug "Sending Archived Messages\n";

	my ($row, $mess);

	# check if we still have a valid database connection(s)
	$mysql_dbh->ping or &mysql_db_connect;

	# fetch outgoing messages
	my $send_m = $mysql_dbh->prepare(
		'SELECT `id`, `do`, `text` FROM `messages` WHERE `sent` = 0 LIMIT 0,10');
	my $mark_sent_m = $mysql_dbh->prepare(
		'UPDATE `messages` set `sent` = `sent` + 1 WHERE `id`=?');

	$send_m->execute() or return;
	while ($row = $send_m->fetchrow_hashref) {
		debug "Got row:\n", Dumper($row), "\n";
		my $to = $row->{'do'};

		# append @realm
		$to .= '@'.$config->{'jabber'}->{'server'};

		# create new <message/> node
		$mess = $nf->newNode('message');
		$mess->attr('type', 'normal');
		$mess->attr('to', $to);
		# this is set automagically:
		#$m->attr('from', $config->{admin}.'/perlscript');

		# we must encode the message :((
		# because there are some XML parser errors
		# TODO: lossless encoding (Unicode?) (HTML entities?)
		#$mess->insertTag('body')->data( encode("ascii", $row->{'text'}) );
		my $body_text = $row->{'text'};

		$body_text = decode($config->{'mysql'}->{'charset'}, $body_text);
		debug "decoded from ".$config->{'mysql'}->{'charset'}.": ", Dumper($body_text);

		encode_entities_numeric($body_text);
		debug "encoded to HTML entities: ", Dumper($body_text);

		$mess->insertTag('body')->insertTag('html')->rawdata($body_text);

		# send out the message
		$c->send($mess) or do { warn "cannot send message"; next };

		# mark message as sent in the queue
		debug "marking ID $row->{'id'} as sent\n";
		$mark_sent_m->execute($row->{'id'}) or warn "cannot mark message as sent";
	}
}

sub incoming_message {
	my ($msg, $parcel) = (shift, shift);

	debug "handling incoming message $msg\n";

	my $body_data = $msg->getTag('body')->data;
	debug "Got body data: ", Dumper($body_data);

	encode_entities_numeric($body_data);
	debug "Got htmlized body data: ", Dumper($body_data);

	# rewrite and send ( with HTMLized body )
	my $omsg = $nf->newNode('message');
	$omsg->attr('to', $config->{'admin'});
	$omsg->insertTag('body')->insertTag('html')->rawdata( $body_data );
	$c->send($omsg);

}

sub slurp_and_pump {
	get_em;
	send_m;
}


exit 0;