Any coffee left?

Setup

We first declare the packages we're going to use. As well as Net::Jabber and Win32::OLE, we're going to use Getopt::Std which affords us a comfortable way of accepting and parsing command line switches. We also want to use the strict pragma, which should keep us from making silly coding mistakes by not allowing undeclared variables and the like.

We specify the "Client" string on our usage declaration for the Net::Jabber package to specify what should be loaded. The package is a large and comprehensive set of modules, and only some of those are relevant for what we wish to do in our script—build and work with a Jabber client connection. Other module sets are pulled in by specifying "Component" or "Server".

use Net::Jabber qw(Client);
use Win32::OLE;
use Getopt::Std;
use strict;

We're going to allow the command line switches -l and -s. This is what the switches do:

Here's where the switches are defined with the Getopt::Std function:

my %opts;
getopt('ls', \%opts);

Next come a raft of constants, describing the script's Jabber relationship (the server it will connect to, and the user, password and resource it will connect with), the representation of the two states of "coffee" and "no coffee" (which will be used to determine the content of the <status/> tag sent along inside any <presence/> element emitted), the identification of the connector to which the light sensor is attached, and the polling granularity of the sensor poll / presence push loop described earlier (measured in seconds).

use constant SERVER   => "merlix.dyndns.org";
use constant PORT     => 5222;
use constant USERNAME => "coffee";
use constant PASSWORD => "pass";
use constant RESOURCE => "perlscript";

use constant NOCOFFEE => 0;
use constant COFFEE   => 1;

use constant SENSOR   => defined($opts{'s'}) ? $opts{'s'} : 0;
use constant GRAIN    => 1;

The last part of the script's setup deals with the coffee state:

my $current_status = -1;
my @status;
$status[NOCOFFEE] = 'xa/coffeepot is empty';
$status[COFFEE]   = '/coffee is available!';

We use a two-element array @status to represent the two possible coffee states. The value of each array element is a two-part string, each part separated by a slash ("/"). Each of these parts will be transmitted in a <presence/> element, where the first part (which is empty in the element representing the COFFEE state) will represent the presence <show/> value, and the second part will represent the presence <status/> value. Example 8-5 shows what a <presence/> element looks like when built up with values to represent the NOCOFFEE state.

<presence>
  <show>xa</show>
  <status>coffeepot is empty</status>
</presence>

Most Jabber clients use different icons in the roster to represent different <show/> values. So we use different values here ("xa" for no coffee, and ""—blank, which represents "online" or "available"— for coffee) to trigger the icon change.

Initialization and calibration

Whenever we need to talk to the RCX, some initialization via the ActiveX control is required. That's the same whether we're going to calibrate or poll for values. The setup_RCX() function takes a single argument—the identification of which connector the light sensor is connected to—and performs the initialization, which is described later in the section called setup_RCX(). The function returns a handle on the Win32::OLE object that represents the ActiveX control, which in turn represents the RCX via the IR tower.

my $rcx = &setup_RCX(SENSOR);

If the -l flag is not specified, it means we're going to be running calibration. So we call the calibrate() function to do this for us. We pass the RCX handle (in $rcx) so the calibration can run properly.

# Either calibrate if no parameters given, or
# run with the parameter given as -l, which will
# be taken as the pivot between coffee and no-coffee.
&calibrate($rcx) unless defined($opts{'l'});
  

As with the setup_RCX() function, calibrate() is described later.

The calibration mode will be terminated by ending the script with Ctrl-C, so the next thing we come across is the call to the function set_status() which represents the first stage in the normal script mode; set_status() is used to determine the initial coffee status.

A value is retrieved by calling the ActiveX control's Poll() function. (Table 8-1 lists and described the ActiveX control's functions and properties used in this script.) We specify that we're after a "Sensor Value" (the 9 as the first argument) from the sensor attached to the connector indicated by the SENSOR constant.

# Determine initial status (will be either 0 or 1)
my $s = &set_status($rcx->Poll(9, SENSOR));

The value retrieved—it's going to be something along the lines of one of the values displayed when the script was run in calibration mode—is passed to set_status() which determines whether the value is above or below the pivot value, and whether the "new" status is different to the current one. If it is (and it this case, it will be, because in this first call, the value of $current_status is set to -1, which represents neither the COFFEE nor the NOCOFFEE state) that status will be returned, otherwise undef will be returned.

Set up connection to Jabber

At this stage, we're ready to connect to Jabber. The call to setup_Jabber() does this for us, returning a handle to the Jabber connection object that we store in $jabber. We will use this handle to send out <presence/> elements later in the script. The $jabber variable contains a reference to a Net::Jabber::Client object, and is the equivalent of the con variable used in the earlier Python scripts (the section called CVS notification in Chapter 7 and the section called Presence-sensitive CVS notification in Chapter 7) to hold the Jabber.Connection object, and cb, holding the ConnectionBean object in the earlier Java script (the section called Dialup system watch in Chapter 7).

my $jabber = &setup_Jabber(SERVER, PORT, USERNAME, PASSWORD, RESOURCE, $s);

As well as passing the constants needed for our client connection to the Jabber server, we pass the initial coffee status, held in $s. We'll have a look at what the setup_Jabber() function does with this initial status a bit later when we get to the function's definition.

Sensor poll / presence push loop

The main loop starts here:

# Main loop: check Jabber and RCX
# ===============================
while (1) {
  defined($jabber->Process(GRAIN)) or 
    die "The connection to the Jabber server was broken\n";
  my $s = &set_status($rcx->Poll(9, SENSOR));
  &set_presence($jabber, $s) if defined $s;
}

The while (1) is a bit of a giveaway. This script won't stop until you force it to stop, with a Ctrl-C. But that's essentially what we want. In the loop, we call the Process() method on our Jabber connection object in $jabber.

Process() is the equivalent of the JabberPy's process() method in the Python scripts. Process() waits around for up to the number of seconds specified as the single argument (or not at all if no argument is specified) for XML to appear on the stream connection from the Jabber server. If complete fragments do appear, callbacks, defined to the connection object, are called with the elements (<iq/>s, <message/>s and <presence/>s) that the fragments represent. This is in the same way as, for example, callbacks are called in Python scripts using the JabberPy libraries. The setup_Jabber(), coming next, is where the callback definition is made.

The Process() method returns undef if the connection to the Jabber server is terminated while waiting for XML. The undef value is dealt with appropriately by ending the script.

The GRAIN constant, set to one second in the script's setup section, is used to specify how long to wait. For the most part, we're not expecting to receive much incoming Jabber traffic. The occasional presence subscription (or unsubscription) request, perhaps (see later), but other than that, the only packets travelling over the connection to the Jabber server will be availability <presence/> packets representing coffee state changes, sent from the script. So normally, this delay of 1 second will take place. That's a comfortable polling interval for our light sensor too. So we do that within the same loop, happy in the knowledge that's it's most likely been a second since the last poll.

Calling the ActiveX control's Poll() again with the same arguments as before ("get a sensor value from the sensor attached to the SENSORth connector"), we pass the value to the set_status() to determine the coffee state. If the state was different from last time (if $s receives a value, and not undef), then we want to emit a <presence/> element to reflect that state. We achieve this by calling the set_presence() function, passing it the connection object and the state.

setup_Jabber()

Here we define the setup_Jabber() function, which is called once to set up the connection to the Jabber server and authenticate with a pre-defined user.

# Set up Jabber client connection, sending intial presence
# --------------------------------------------------------
sub setup_Jabber {
  my ($server, $port, $user, $pass, $resource, $initial_status) = @_;
  my $connection = new Net::Jabber::Client;

  # Connect
  my $status = $connection->Connect( hostname => $server,
                                     port     => $port );
  die "Cannot connect to Jabber server $server on port $port\n"
    unless $status;

  # Callbacks
  $connection->SetCallBacks( presence => \&InPresence );

  # Ident/Auth
  my @result = $connection->AuthSend( username => $user,
                                      password => $pass,
                                      resource => $resource );
  die "Ident/Auth failed: $result[0] - $result[1]\n"
    if $result[0] ne "ok";

  # Roster 
  $connection->RosterGet();

  # Initial presence dependent upon initial status
  &set_presence($connection, $initial_status);

  return $connection;
}

First, we instantiate a new Net::Jabber::Client object. Net::Jabber distinguishes between client-based and component-based connections to Jabber; the component-based equivalent of this class is Net::Jabber::Component. The connection() method is passed arguments that specify the hostname and port of the Jabber server to connect to. It returns a zero status if the connection could not be made.

We can register handlers for Jabber elements that are received over the XML stream which is carried via the connection we've just made. Here we are only interested in incoming <presence/> elements—indeed, only those carrying presence subscription or unsubscription requests, as we'll see in the definition of the InPresence() function.

The single method SetCallBacks() does what the collective Jabber.Connection methods setPresenceHandler(), setMessageHandler(), and setIqHandler() do in a single call, taking a list of element types and subroutine references, in the form of a hash.

After registering our callback for <presence/> elements, it's time to authenticate, passing the username, password and resource that we defined in our list of constants at the start of the script. If the authentication is successful, the result of the call to the AuthSend() method is a single string with the value "ok". If not, that value is replaced with an error code and the descriptive text is available in a further string. (This is why we catch the results of a call in an array, called @result). The full list of Jabber error codes and texts are shown in Table 5-3.

Why RosterGet()? We're not subscribing to anyone, and we're not really interested in anything but the values we're polling from our brick. Yes, you guessed it—we want the script to receive and process presence subscription and unsubscription requests, but we aren't sent those by the JSM unless we've requested our roster beforehand. See the section called Request for roster in Chapter 7 for an explanation as to why.

Once we've kicked the JSM into sending any presence requests on to us, the job is almost done. The last thing to do in setting up our Jabber connection is to send our initial availability information. setup_Jabber() receives the initial coffee status as the last argument in the call (in $initial_status), which it now duly passes on to the function that sends a <presence/> element, set_presence(). Along with the initial coffee status, we also send the $connection object that represents the connection to the Jabber server that we've just established (and that is referred to outside of this function with the $jabber variable. This is so the set_presence() function can use the connection handle to send the element down the stream.

set_presence()

This function is used by setup_Jabber() to send the script's (and the coffee's) initial presence. It's also used within the main sensor poll / presence push loop to send further presence packets if the coffee's state changes.

sub set_presence {
  my ($connection, $s) = @_;
  my $presence = Net::Jabber::Presence->new();
  my ($show, $status) = split("/", $status[$s], 2);
  $presence->SetPresence( show   => $show, 
                          status => $status );
  print $status, "\n";
  $connection->Send($presence);
}

On receipt of the Jabber connection object and the status, which will be 0 (NOCOFFEE) or 1 (COFFEE), set_presence() constructs a new Net::Jabber::Presence object. This object represents a <presence/> element, upon which we can make method calls to hone the element as we wish. SetPresence() is one of these methods, with which we can set values for each of the <show/> and <status/> tags. We retrieve the values for each of these tags by pulling the strings from the appropriate member of the @status array, as described in the section called Setup.

We print the coffee's status (remember, this function is only called when the status changes, not every time the sensor is polled), and send our newly built <presence/> element off down the XML stream to the Jabber server by passing the presence object as an argument to the Send() method of the connection object in $connection. This works in the same way as the send() function in JabberPy, and the send() function in JabberBeans. And by the diffusive magic of the presence subscription model (see the section called Presence Subscription in Chapter 5), everyone who has subscribed to the script user's presence, and who is available, will receive the coffee status information.

Figure 8-4 shows the status information received in the WinJab client. The string sent in the <status/> tag is shown in the tooltip that appears when the mouse hovers over the "coffee" roster item.

InPresence()

Our presence handler, the callback subroutine InPresence(), exists for a single purpose: to honor requests for subscription and unsubscription to the script user's (and therefore the coffee's) presence. This callback is designed to work in the same way as the presenceCB() callback in the Python recipe described in the section called Presence-sensitive CVS notification in Chapter 7.

However, while the Python JabberPy library hands to the callbacks a Jabber.Connection object and the element to be handled, the Perl Net::Jabber library hands over a session ID and the element to be handled. The session ID is related to functionality for building Jabber servers, functionality that is not yet complete. We can and should ignore it for our script's purposes. What is important is the element to be handled, which appears as the second argument passed to the subroutine, which we collect into the $presence variable from $_[1].

What is common between the two libraries is that the element that is passed to be handled, as the subject, so to speak, of the callback, is an instance of the class that the callback represents. In other words, here we have a callback to handle <presence/> elements, and the element received is an instance of the Net::Jabber::Presence class (just as the element received by a JabberPy presence callback is an instance of the Jabber.Presence class).

# Handle presence messages
# ------------------------
sub InPresence
{
  my $presence = $_[1];
  my $from = $presence->GetFrom();
  my $type = $presence->GetType();

  if ($type eq "subscribe") {
    print "Subscribe request ($from) ...\n";
    $jabber->Send($presence->Reply(type => 'subscribed'));
  }
    
  if ($type eq "unsubscribe") {
    print "Unsubscribe request ($from) ...\n";
    $jabber->Send($presence->Reply(type => 'unsubscribed'));
  }
}

With an object in $presence, we can get information from the element using data retrieval methods such as those used here: GetFrom() and GetType(), which extract the values from the from and type attributes of the <presence/> element respectively.

If the <presence/> element type represents a subscription request (type='subscribe'), we unquestioningly honor the request, by sending back an affirmative reply. The Reply() method of the presence object is one of a number of high-level functions that make it very comfortable to turn elements around and send them back. In this case, the method replaces the value of the <presence/>'s to attribute with the value of the from attribute, and preserves any id attribute. It also allows us to pass arguments as if we were calling the SetPresence() method described earlier. Rather than set the <show/> and <status/> tags as we did earlier in the set_presence() function, we merely set the element's type attribute to "subscribed" or "unsubscribed", depending on the request.

So with an incoming <presence/> element in $presence that looks like this:

<presence from='qmacro@jabber.org/office' type='subscribe'
            to='coffee@merlix.dyndns.org' id='21'>

calling the Reply() method would cause the element in $presence to change to this: [3]

<presence to='qmacro@jabber.org/office' type='subscribed' id='21'>

Note that the script doesn't ask for a subscription to the user's presence in return. The script isn't interested whether or not the people that have subscribed to its presence are available or not. It's sole job in life is to emit coffee availability.

setup_RCX()

This function is called once every time the script is started, and is required to initialize the RCX:

sub setup_RCX {
  my $sensor = shift;
  my $rcx = Win32::OLE->new('SPIRIT.SpiritCtrl.1');
  $Win32::OLE::Warn = 0;
  $rcx->{ComPortNo} = 1;
  $rcx->{InitComm};
  $rcx->SetSensorType($sensor, 3);
  $rcx->SetSensorMode($sensor, 2);
  return $rcx;
}

A Win32::OLE object representing the RCX's ActiveX control "Spirit" is instantiated. A Win32::OLE function is used to suppress warnings, and the RCX is initialized by setting the COM port to COM1 and initializing the serial communiations on that port. The sensor type and mode are set for the light sensor attached to the connector identified by the value passed into the $sensor variable. Table 5-1 shows us that sensor type 3 represents "Light", and sensor mode 2 specifies a "Transitional" measurement mode, the upshot of which is that the values returned on a poll are all within a certain restricted range, which makes it easier to decide on the coffee or no-coffee status.

We return the Win32::OLE RCX object to be used elsewhere in the script for calibration and polling.

calibrate()

The calibrate() function, called if the script is started without the -l switch, simply prints a message, waits for the user to press Enter, and then goes into a a gentle loop, emitting whatever value was polled from the light sensor, so the user can determine the pivot point:

sub calibrate {
  my $rcx = shift;
 
  print <<EOT;
Calibration mode.
Note the sensor values and decide on a 'pivot' value 
above which 'no coffee' is signified and below which
'coffee' is signified.

End the calibration mode with Ctrl-C.

Press Enter to start calibration...
EOT

  <STDIN>;

  while (1) {
    print $rcx->Poll(9, SENSOR), " ";
    sleep 1;
  }

}

The output produced from this function can be seen in Figure 8-3.

set_status()

The set_status() function simply receives the latest light value as polled from the sensor and compares it with the pivot value. If the status so determined (in $new_status) is different from the current status (in $current_status) the current status is updated and returned. Otherwise undef is returned:

sub set_status {
  my $val = shift;
  
  my $new_status = $val < $opts{'l'} ? COFFEE : NOCOFFEE;

  if ($new_status != $current_status) {
    $current_status = $new_status;
    return $current_status;
  }
  else {
    return undef;
  }
}

If this function returns a status value, a new <presence/> element is generated and emitted by the script. Otherwise, there's no change ("the coffee's still there", or "there's still no coffee!") and nothing happens.