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!
#!/usr/bin/perl
# juddi.pl, a JUD component that uses Database Independent libraries
#
#
# Migs Paraz <[EMAIL PROTECTED]> 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@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);
}
}
