#!/usr/bin/perl -w

# $Id: message_monitor.pl 285 2003-01-15 12:55:55Z ralphm $

use strict;
use open ':utf8';
use Jabber::Connection;
use Jabber::NodeFactory;
use Jabber::NS qw(:all);
use DBI;
use XML::Simple;
use Getopt::Long;

# Fetch command-line options
my %optctl = ();
$optctl{config} = "";
&GetOptions(\%optctl, "config=s");
$optctl{config} = undef unless ($optctl{config} ne "");

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

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

# Create a new db connection
my ($dbh, $sth);
&db_connect;

# Update process list entry
$dbh->do("DELETE FROM process_list WHERE name='message_monitor'");
$dbh->do("INSERT INTO process_list (name, pid) VALUES ('message_monitor', $$)");

# Open connection to Jabber server
my $c = new Jabber::Connection(
  server  => $config->{jabber}->{server},
  log     => 1,
  debug   => 1,
);
$c->connect or die "oops: ".$c->lastError;

# Register various handlers
$c->register_handler('message', \&message);
$c->register_beat(5, \&send_queued_messages);

# Identify and authenticate with the server
$c->auth($config->{jabber}->{username},
         $config->{jabber}->{password},
         $config->{jabber}->{resource});

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

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

#
# db_connect - connect to the database
#
sub db_connect {
  $dbh = DBI->connect("dbi:Pg:dbname=".$config->{database}->{name})
     or die "Cannot connect to database ($!)\n";
}

#
# getdata - return the data inside the element with name $name or empty
#
sub getdata {
  my $node = shift;
  my $name = shift;
  my $tag;

  return ($tag = $node->getTag($name)) ? $tag->data : "";
}

#
# send_queued_messages - sends out messages stored in the database
#
sub send_queued_messages {
  my ($row, $m, $sth2);

  # check if we still have a valid database connection
  $dbh->ping or &db_connect;

  # prepare sql statements we use later on
  $sth = $dbh->prepare('SELECT "id", "to", "from", "message" FROM messages '.
                       'WHERE incoming is null');
  $sth2 = $dbh->prepare('DELETE FROM messages WHERE "id"=?');

  # fetch outgoing messages
  $sth->execute();
  while ($row = $sth->fetchrow_hashref) {
    print STDERR "Sending message to ", $row->{'to'}, ":\n";
    print STDERR $row->{'message'}, "\n\n";

    # create new <message/> node
    $m = $nf->newNode('message');
    $m->attr('type', 'normal');
    $m->attr('to', $row->{'to'});

    # The 'from' value in this case is a session id. This way replies
    # can be directed to the other party
    if ($row->{'from'}) {
      print STDERR $row->{'from'} . "\n";
      $m->attr('from', $config->{jabber}->{username} . '@' .
                       $config->{jabber}->{server} . '/' . $row->{'from'});
    }
    $m->insertTag('body')->data($row->{'message'});

    # send out the message
    $c->send($m);

    # delete the message from the queue
    $sth2->execute($row->{'id'});
  }
}

#
# message - stores incoming messages in the database
#
sub message {
  my $node = shift;
  my $to   = $node->attr('to');
  my $from = $node->attr('from');
  my $message = getdata($node, 'body');

  print STDERR "Received message from $from to $to:\n";
  print STDERR "$message\n";
  print STDERR "\n";

  if ($to =~ /^([^\/]+)\/(.+)/) {
    # check if we still have a valid database connection
    $dbh->ping or &db_connect;

    # store the message
    $sth = $dbh->prepare(
      'INSERT INTO messages ("to", "from", "message", "incoming") '.
      'VALUES (?,?,?,?)'
      );
    $sth->execute($2, $from, $message, 'Y');
  }
}