x9991.htm

Its a xmpp protocol book

>Next, we build a frame to hold the three buttons <I
CLASS="EMPHASIS"
>Clear</I
>,
<I
CLASS="EMPHASIS"
>Fetch</I
>, and <I
CLASS="EMPHASIS"
>Exit</I
>, and a scrollable
list to contain the item titles as we receive them:</P
><P
><PRE
CLASS="SCREEN"
># Button frame
my $buttons = $main-&#62;Frame();
$buttons-&#62;pack(qw/-side bottom -fill x/);

# Headline list
my $list = $main-&#62;Scrolled(qw/Listbox -scrollbars e -height 40 -setgrid 1/);&#13;</PRE
></P
><P
>Defining the buttons, one at a time, brings our attention to the Tk
UI event model, in that we define the handlers using the 
<TT
CLASS="LITERAL"
>-command</TT
> argument of the 
<TT
CLASS="FUNCTION"
>Button()</TT
> method. The handlers' jobs are quite 
small, so we can get away with writing them "in-line":</P
><P
><PRE
CLASS="SCREEN"
># Clear button
my $button_clear = $buttons-&#62;Button(
              -text      =&#62; 'Clear',
              -underline =&#62; '0',
              -command   =&#62; sub
              {
                @list = (); $list-&#62;delete(0, 'end')
              },
            );&#13;</PRE
></P
><P
>If called, the <I
CLASS="EMPHASIS"
>Clear</I
> button will clear the scrollable
display by calling the <TT
CLASS="FUNCTION"
>delete()</TT
> method on our 
<TT
CLASS="LITERAL"
>$list</TT
> object, and emptying the corresponding array
of URLs.</P
><P
>The <I
CLASS="EMPHASIS"
>Fetch</I
> button extracts the URL from the item
that is highlighted in the scrollable list (using the 
<TT
CLASS="FUNCTION"
>curselection()</TT
> method to retrieve the index value)
which is then used to look up the <TT
CLASS="LITERAL"
>@list</TT
> array, and
calls the external browser program in the background, passing it that URL.
Many browsers accept a URL as the first argument, if your choice of 
browser doesn't, you'll need to modify this call slightly.</P
><P
><PRE
CLASS="SCREEN"
># Fetch Button
my $button_fetch = $buttons-&#62;Button(
              -text      =&#62; 'Fetch',
              -underline =&#62; '0',
              -command   =&#62; sub
              {
                system(
                  join(" ", (BROWSER, $list[$list-&#62;curselection], "&#38;"))
                )
              },
           );&#13;</PRE
></P
><P
>The <I
CLASS="EMPHASIS"
>Exit</I
> button, if pressed, uses 
<TT
CLASS="FUNCTION"
>destroy()</TT
> to, well, destroy the main window.
This will cause Tk's main event loop to come to an end, passing 
control back to the statement in the script following where that
main event loop was launched (with <TT
CLASS="FUNCTION"
>MainLoop()</TT
>).</P
><P
><PRE
CLASS="SCREEN"
># Exit button
my $button_exit = $buttons-&#62;Button(
              -text      =&#62; 'exit',
              -underline =&#62; '0',
              -command   =&#62; [$main =&#62; 'destroy'],
           );&#13;</PRE
></P
><P
>Having created all the buttons, and packed everything into our
window with the <TT
CLASS="FUNCTION"
>pack()</TT
> method:</P
><P
><PRE
CLASS="SCREEN"
>$button_clear-&#62;pack(qw/-side left -expand 1/);
$button_fetch-&#62;pack(qw/-side left -expand 1/);
$button_exit-&#62;pack(qw/-side left -expand 1/);

$list-&#62;pack(qw/-side left -expand 1 -fill both/);&#13;</PRE
></P
><P
>we announce to the JSM that we're available:</P
><P
><PRE
CLASS="SCREEN"
>$connection-&#62;PresenceSend();&#13;</PRE
></P
><P
>All that remains for us to do is start Tk's main event loop. We include
a call to the <TT
CLASS="LITERAL"
>Net::Jabber</TT
> <TT
CLASS="FUNCTION"
>Disconnect()</TT
>
method for when the <I
CLASS="EMPHASIS"
>Exit</I
> button is pressed and control
returns to the script, so we can gracefully end our Jabber connection:</P
><P
><PRE
CLASS="SCREEN"
>MainLoop();

$connection-&#62;Disconnect;
exit(0);&#13;</PRE
></P
><P
>We defined the <TT
CLASS="FUNCTION"
>check_headlines()</TT
> function as the
function to invoke every five seconds.</P
><P
><PRE
CLASS="SCREEN"
>sub check_headlines {
  $connection-&#62;Process(1);
  while (@headlines) {
    my $headline = pop @headlines;
    $list-&#62;insert(0, $headline-&#62;{title});
    unshift @list, $headline-&#62;{link};
  }
}&#13;</PRE
></P
><P
>To check for any messages that have arrived on the XML stream, we can
call the <TT
CLASS="FUNCTION"
>Process()</TT
> method on our connection 
object. If there <I
CLASS="EMPHASIS"
>are</I
> any waiting messages, the
callback that we defined to handle
them&mdash;<TT
CLASS="FUNCTION"
>handle_message()</TT
>&mdash;will be called:</P
><P
><PRE
CLASS="SCREEN"
>sub handle_message {
  my $msg = new Net::Jabber::Message($_[1]);
  return unless $msg-&#62;GetType eq 'headline';

  my ($oob) = $msg-&#62;GetX('jabber:x:oob');
  push @headlines, {
                     link =&#62; $oob-&#62;GetURL(),
                     title =&#62; $msg-&#62;GetSubject(),
                   };                    
}&#13;</PRE
></P
><P
>This message handling callback will ignore everything but 
<TT
CLASS="LITERAL"
>&#60;message/&#62;</TT
> elements that have the
value "<TT
CLASS="LITERAL"
>headline</TT
>" in the <TT
CLASS="LITERAL"
>type</TT
>
attribute. Remembering that a headline message, complete with 
an <TT
CLASS="LITERAL"
>&#60;x/&#62;</TT
> extension, qualified with 
the <TT
CLASS="LITERAL"
>jabber:x:oob</TT
> namespace, looks like this:</P
><P
><PRE
CLASS="SCREEN"
>&#60;message type='headline' to='[e-mail]'&#62;
  &#60;subject&#62;JabberCon Update 11:45am - Aug 20&#60;/subject&#62;
  &#60;body&#62;JabberCon Update - Monday Morning&#60;/body&#62;
  &#60;x xmlns='jabber:x:oob'&#62;
    &#60;url&#62;http://www.jabbercentral.com/news/view.php?news_id=998329970&#60;/url&#62;
    &#60;desc&#62;JabberCon Update - Monday Morning&#60;/desc&#62;
  &#60;/x&#62;
&#60;/message&#62;&#13;</PRE
></P
><P
>we can see fairly easily what the <TT
CLASS="FUNCTION"
>GetX()</TT
> method
does. It returns, in list context, all the 
<TT
CLASS="LITERAL"
>&#60;x/&#62;</TT
> elements contained in the element
represented by <TT
CLASS="LITERAL"
>$msg</TT
> that are qualified by the 
<TT
CLASS="LITERAL"
>jabber:x:oob</TT
> namespace. We're only expecting there
to be one, which is why we plan to throw all but the first array item
away with the <TT
CLASS="LITERAL"
>($oob)</TT
> construction. After the 
call to <TT
CLASS="FUNCTION"
>GetX()</TT
>, the object in <TT
CLASS="LITERAL"
>$oob</TT
>
represents this part of the message:</P
><P
><PRE
CLASS="SCREEN"
>&#60;x xmlns='jabber:x:oob'&#62;
  &#60;url&#62;http://www.jabbercentral.com/news/view.php?news_id=998329970&#60;/url&#62;
  &#60;desc&#62;JabberCon Update - Monday Morning&#60;/desc&#62;
&#60;/x&#62;&#13;</PRE
></P
><P
>The item's details&mdash;the URL and title&mdash;are pushed onto the
<TT
CLASS="LITERAL"
>@headlines</TT
> list, and our headline type message 
handling function has done its job.
Control passes back to the <TT
CLASS="FUNCTION"
>check_headlines()</TT
> script,
to immediately after the call to the <TT
CLASS="FUNCTION"
>Process()</TT
> method.</P
><P
>The <TT
CLASS="FUNCTION"
>handle_message()</TT
> function may have
bee called multiple times, depending on how many elements had arrived;
so the <TT
CLASS="LITERAL"
>@headlines</TT
> array might contain more than one
item. We run through the array, <TT
CLASS="FUNCTION"
>pop()</TT
>ping off 
each headline in turn, inserting the title into our scrollable list
object, and the URL into the corresponding position in our 
<TT
CLASS="LITERAL"
>@list</TT
> array:&#13;</P
><P
><PRE
CLASS="SCREEN"
>$list-&#62;insert(0, $headline-&#62;{title});
unshift @list, $headline-&#62;{link};&#13;</PRE
></P
></DIV
><DIV
CLASS="SECT2"
><H2
CLASS="SECT2"
><A
NAME="JABTDG-CH-8-SECT-4.3"
>The script</A
></H2
><P
>Here's the script in its entirety.</P
><P
><PRE
CLASS="SCREEN"
>use Tk;
use Net::Jabber qw(Client);
use strict;

use constant SERVER   =&#62; 'gnu.pipetree.com';
use constant PORT     =&#62; 5222;
use constant USER     =&#62; 'dj';
use constant PASSWORD =&#62; 'secret';
use constant RESOURCE =&#62; 'hlv';

use constant BROWSER  =&#62; '/usr/bin/konqueror';

my @headlines;
my @list;

my $connection = Net::Jabber::Client-&#62;new();

$connection-&#62;Connect(
  hostname =&#62; SERVER,
  port     =&#62; PORT,
) or die "Cannot connect ($!)\n";

my @result = $connection-&#62;AuthSend(
  username =&#62; USER,
  password =&#62; PASSWORD,
  resource =&#62; RESOURCE,
);

if ($result[0] ne "ok") {
  die "Ident/Auth with server failed: $result[0] - $result[1]\n";
}

$connection-&#62;SetCallBacks( message =&#62; \&#38;handle_message );

my $main = MainWindow-&#62;new( -title =&#62; "Headline Viewer" );
$main-&#62;geometry('50x5+10+10');
$main-&#62;repeat(5000, \&#38;check_headlines);

# Button frame
my $buttons = $main-&#62;Frame();
$buttons-&#62;pack(qw/-side bottom -fill x/);

# Headline list
my $list = $main-&#62;Scrolled(qw/Listbox -scrollbars e -height 40 -setgrid 1/);

# Clear button
my $button_clear = $buttons-&#62;Button(
              -text      =&#62; 'Clear',
              -underline =&#62; '0',
              -command   =&#62; sub
              {
                @list = (); $list-&#62;delete(0, 'end')
              },
            );

# Fetch Button
my $button_fetch = $buttons-&#62;Button(
              -text      =&#62; 'Fetch',
              -underline =&#62; '0',
              -command   =&#62; sub
              {
                system(
                  join(" ", (BROWSER, $list[$list-&#62;curselection], "&#38;"))
                )
              },
           );

# Exit button
my $button_exit = $buttons-&#62;Button(
              -text      =&#62; 'exit',
              -underline =&#62; '0',
              -command   =&#62; [$main =&#62; 'destroy'],
           );


$button_clear-&#62;pack(qw/-side left -expand 1/);
$button_fetch-&#62;pack(qw/-side left -expand 1/);
$button_exit-&#62;pack(qw/-side left -expand 1/);

$list-&#62;pack(qw/-side left -expand 1 -fill both/);

$connection-&#62;PresenceSend();

MainLoop();

$connection-&#62;Disconnect;
exit(0);

sub check_headlines {
  $connection-&#62;Process(1);
  while (@headlines) {
    my $headline = pop @headlines;
    $list-&#62;insert(0, $headline-&#62;{title});
    unshift @list, $headline-&#62;{link};
  }
}

sub handle_message {
  my $msg = new Net::Jabber::Message($_[1]);
  return unless $msg-&#62;GetType eq 'headline';

  my ($oob) = $msg-&#62;GetX('jabber:x:oob');
  push @headlines, {
                     link =&#62; $oob-&#62;GetURL(),
                     title =&#62; $msg-&#62;GetSubject(),
                   };                    
}&#13;</PRE
></P
></DIV
></DIV
><H3
CLASS="FOOTNOTES"
>Notes</H3
><TABLE
BORDER="0"
CLASS="FOOTNOTES"
WIDTH="100%"
><TR
><TD
ALIGN="LEFT"
VALIGN="TOP"
WIDTH="5%"
><A
NAME="FTN.AEN9996"
HREF="x9991.htm#AEN9996"
>[1]</A
></TD
><TD
ALIGN="LEFT"
VALIGN="TOP"
WIDTH="95%"
><P
>Alright, I said it. "Leverage." It's the only occasion in the book, ok?</P
></TD
></TR
><TR
><TD
ALIGN="LEFT"
VALIGN="TOP"
WIDTH="5%"
><A
NAME="FTN.AEN10077"
HREF="x9991.htm#AEN10077"
>[2]</A
></TD
><TD
ALIGN="LEFT"
VALIGN="TOP"
WIDTH="95%"
><P
>(<I
CLASS="EMPHASIS"
>Konqueror</I
>, my browser of choice in the KDE environment).</P
></TD
></TR
></TABLE
><DIV
CLASS="NAVFOOTER"
><HR
ALIGN="LEFT"
WIDTH="100%"><TABLE
WIDTH="100%"
BORDER="0"
CELLPADDING="0"
CELLSPACING="0"
><TR
><TD
WIDTH="33%"
ALIGN="left"
VALIGN="top"
><A
HREF="x9016.htm"
>Prev</A
></TD
><TD
WIDTH="34%"
ALIGN="center"
VALIGN="top"
><A
HREF="book1.htm"
>Home</A
></TD
><TD
WIDTH="33%"
ALIGN="right"
VALIGN="top"
><A
HREF="c10187.htm"
>Next</A
></TD
></TR
><TR
><TD
WIDTH="33%"
ALIGN="left"
VALIGN="top"
>RSS punter</TD
><TD
WIDTH="34%"
ALIGN="center"
VALIGN="top"
><A
HREF="c7982.htm"
>Up</A
></TD
><TD
WIDTH="33%"
ALIGN="right"
VALIGN="top"
>Pointers for further development</TD
></TR
></TABLE
></DIV
></BODY
></HTML
>