[JDEV] juddi, a JUD component using Jabber::Connection

[Migs Paraz]

Thanks to DJ Adams, I have a component that can store (but not yet retrieve)
JUD info from a MySQL database... I intend this to be a teaching example
(for myself as well, since I'm learning), so I hope you enjoy!


-------------- next part --------------
#!/usr/bin/perl
# juddi.pl, a JUD component that uses Database Independent libraries
#
#
# Migs Paraz <map at internet.org.ph> November 9, 2001
# Initial release - only "Register" works, written for MySQL 
# License: GNU GPL, as this is a teaching example.
#
# TODO:
# Search function
# External config file.  XML?
# Make it easy to change database backends.
# How to implement searches that take long without blocking other clients?
#
# Current table:
# create table juddi (jid varchar(32) not null primary key,
#                     first varchar(32), last varchar(32),
#                     nick varchar(32), email varchar(64))
#

use Jabber::Connection;
use Jabber::NodeFactory;
use Jabber::NS qw(:all);

use DBI;
use DBD::mysql;

use strict;


#### Configuration section ####

our $config_jabber_server   = "localhost:1234";
our $config_jabber_password = "test";
our $config_localname       = "jud.localhost";
our $config_log             =  1;

# Database 
our $config_db_database = "jabber";
our $config_db_username = "jabber";
our $config_db_password = "imjabber";
our $config_db_table    = "juddi";

# Fields for display and for database.
our %config_db_fields = ("first" => "first",
	 		 "last"  => "last",
			 "nick"  => "nick",
			 "email" => "email");

# This is an ordered list since it will come out in the dialog box.
our @config_jud_list = ("first", "last", "nick", "email");

# Text
our $config_text_search   = "juddi search";
our $config_text_register = "juddi register";

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



# Keep state in between connections
our %state;

our $c = new Jabber::Connection(
  ns => "jabber:component:accept",
  server => $config_jabber_server,
  localname => $config_localname,
  log    => $config_log,
);


$c->connect or die "oops: ".$c->lastError;
$c->register_handler('message', \&message);
$c->register_handler('iq', \&iq);

$c->auth($config_jabber_password);

# Connect to the database.  We will autocommit.
# TODO allow change of db
my $cn = "dbi:mysql:" . $config_db_database;

our $dbh = DBI->connect($cn, $config_db_username,
			$config_db_password, { AutoCommit => 1 });

if (!defined ($dbh)) {
    # TODO: There should be a nicer reporting method.
    die ($dbh->errstr);
}

# We only have one constant select, which is for the register method.
# This will come out like:
# INSERT INTO juddi (jid, first, last, nick, email) VALUES (?, ?, ?, ?, ?)
# jid will always be present.

# This ugly loop, because Perl can't duplicate lists.
my @q;
for (my $i = 0; $i < $#config_jud_list + 2; $i++) {
    push (@q, "?");
}

my $statement  = "INSERT INTO " . $config_db_table . " (jid, " .
    join (",", map {$config_db_fields{$_}} @config_jud_list) .
    ") VALUES (" .
    join (",", @q) .
    ")";

our $sth_register = $dbh->prepare($statement);



#### Main Loop ####

$c->start();

# This never gets called since the entire loop is in the start() call.
$c->disconnect();


sub message {
  my $node = shift;
  print "Message --> ", $node->toStr, "\n";
}

sub iq {
  my $node = shift;

  # Different kinds of XML content

  # Get list for register or search.
  # Pretend we're not yet registered.
  # (Make a database for that!)
  if ($node->attr("type") eq IQ_GET) {

      my $id = $node->attr("id");

      # Create a new node for the reply.
      my $nf = new Jabber::NodeFactory;
      my $tag = $nf->newNode("iq");
      $tag->attr("type", IQ_RESULT);
      $tag->attr("from", "jud.localhost");
      $tag->attr("id", $id);

      # Set "to" to original "from"
      $tag->attr("to", $node->attr("from"));
      
      my $tag2 = $tag->insertTag("query", NS_SEARCH);

      foreach my $k (@config_jud_list) {
	  $tag2->insertTag($k);
      }

      # Key is needed to keep state between searches.

      my $key = time();
      $tag2->insertTag("key")->data($key);

      # Store the from and id so we can reply later
      $state{"from"}{$key} = $node->attr("from");

      my $data;
      if ($node->getTag("query", NS_SEARCH)) {
	  $data = $config_text_search;
      }
      elsif ($node->getTag("query", NS_REGISTER)) {
	  $data = $config_text_register;
      }

      $tag2->insertTag("instructions")->data($data);

      # Send back to client
      $c->send($tag);
  }
  elsif (($node->attr("type") eq IQ_SET) &&
      (my $tag = $node->getTag("query", NS_SEARCH))) {

      my $id = $node->attr("id");

      # Construct a bogus result.

      # Grab parameters and store in a hash.
      my %param;

      foreach my $k (@config_jud_list) {
	  my $tag2 = $tag->getTag($k);
	  if (defined ($tag2)) {
	      $param{$k} = $tag2->data();
	  }
      }

      my $nf = new Jabber::NodeFactory;

      my $tag = $nf->newNode("iq");
      $tag->attr("type", IQ_RESULT);
      $tag->attr("from", "jud.localhost");
      $tag->attr("id", $id);

      # It's a reply.
      $tag->attr("to", $node->attr("from"));

      my $tag3 = $tag->insertTag("query", NS_SEARCH);
      my $tag4 = $tag3->insertTag("item");

      # result at localhost is the dummy answer
      $tag4->attr("jid", "result\@localhost");

      foreach my $k (@config_jud_list) {
	  if ($param{$k}) {
	      $tag4->insertTag($k)->data("Result " . $param{$k});
	  }
      }

      # Send back to client
      $c->send($tag);
  }
  elsif (($node->attr("type") eq IQ_SET) &&
      ($tag = $node->getTag("query", NS_REGISTER))) {

      my (%param, @jud_param);

      # Get parameters from the XML, substituting blanks if there are no tags.
      foreach my $k (@config_jud_list) {
	  my $tag2 = $tag->getTag($k);
	  if ($tag2) {
	      $param{$k} = $tag2->data();
	      push (@jud_param, $param{$k});
	  }
	  else {
	      push (@jud_param, "");
	  }
      }

      # Fetch the requstor ("from") from state
      my $key = $tag->getTag("key")->data();

      # Start building the response.
      my $nf = new Jabber::NodeFactory;
      my ($tag3, $success);

      $tag3 = $nf->newNode("iq");


      # At this point, @jud_param has the ordered list of parameters to set.
      # jid is in front, and does not include the resource.
      # (this is more elegant as a regexp but I'm not familiar with optional
      #  matches)
      my $jid = $state{"from"}{$key};
      $jid =~ s!/.*$!!;
		   
      
      if (($success = $sth_register->execute($jid, @jud_param))) {
	  # Success
	  $tag3->attr("type", IQ_RESULT);
      }
      else {
	  # TODO Make this registration error friendlier.
	  $tag3->attr("type", IQ_ERROR);

	  my $tag4 = $tag3->insertTag("error");
	  $tag4->attr("code", 406);
	  $tag4->data("Database error: " . $dbh->errstr());
      }

      # Continue composing the reply.
      $tag3->attr("from", $config_localname);
      $tag3->attr("id", $node->attr("id"));
	  
      $tag3->attr("to", $state{"from"}{$key});

      # Repeat the query.
      my $tag4 = $tag3->insertTag("query", NS_REGISTER);

      if ($success) {
	  $tag4->insertTag("registered");
      }
	  
      foreach my $k (@config_jud_list) {
	  if ($param{$k}) {
	      $tag4->insertTag($k)->data($param{$k});
	  }
      }

      # Copy the key value.
      $tag4->insertTag("key")->data($key);
      
      # Send
      $c->send($tag3);

  }
}