Preface

One thing that I pride myself on is my own responsiveness when people send me email, leave me voicemail, letters or whatever form of communication. I'm terrible about initiating correspondance, but I'm great at keeping up with replies to correspondance that I've recieved.

It doesn't happen often, but every once in a while someone from Perl Monks sends me a private "/msg" from CB and I'll miss it. I may not see it for several days and if my life outside the Monastery is really busy it may even be weeks before I notice it.

When it does happen I feel really horrible about that like I've ignored a realy good friend at a party.

With that in mind and as well as some curiosity about a couple of things that I wanted to look at (more on that in a bit) I decided to create a tool that would look at the XML ticker for the Message Inbox (see: What XML generators are currently available on PerlMonks? sitedoclet) scrape off the latest messages there and send them to my pager and email.

This also was a perfect excuse for me to explore several CPAN modules at the same time. Those were:

Platform information:

This was developed and tested on a Linux box with Perl 5.8.6. The backend database is Postgres 8.1.

Without further ado, let's look at the code and what's in it.

A better configuration tool? maybe... maybe not...

One of the features that I'm always keeping an eye out for is a better way to store and retrieve configuration data for an application. I've tried all sorts of methods from using Windows style configuration files and the CPAN module AppConfig and flat files and all sorts of methods including rolling my own techniques. Then, in a completely unrelated bit of work I was researching I tripped across XML::Simple. In its man page it gave the following code sniglet: 

         use XML::Simple;
 
         my $config = XMLin();

[download]
which turned out to implement behavior that looked for a file called MyProgram.xml (where MyProgram was the basename of the script being run) and would return a nested hash into the scalar $config consisting of the XML embedded in the XML file. Nice....

So for input to my script you need a XML file in the same directory that the script "lives in" to configure the configuration settings that the script needs as follows: 

<config>
  <perlmonks>
     <userid>your_pm_userid_here</userid>
     <password>your_passowrd_here</password>
  </perlmonks>
  <database>
     <driver>Pg</driver>
     <dbname>pmdata</dbname>
     <dbhost>your.database.host.here</dbhost>
     <dbuser>dbuser</dbuser>
     <dbpass>secret</dbpass>
  </database>
  <notification>
     <mailfrom>nobody@wherever.net</mailfrom>
     <pager>email@pagercompany.com</pager>
     <email>youself@yourisp.net</email>
  </notification>
</config>

[download]

Each section of the configuration file should be self-explanitory. Each value setting should also be self-explanitory. I love XML for that. :-)

The script itself

The script itself is pretty straight forward in its functionality. The steps are:

  1. Create a user agent
  2. Create a temporary cookie jar
  3. Log into Perl Monks
  4. Remember what the last message ID was we read
  5. Grab the newest messages
  6. Store them in a database
  7. Mail out notifications

So... why the database you might ask. There are two very valid reasons I do that:

  1. I felt like it. You don't have to implement this part if you don't want to, but you will have to provide some other way of keeping track of the last message id you scraped from the message inbox was and persist it.
  2. See #1

The table that I created in the database is pretty straight forward: 

CREATE TABLE messages (
    message_id integer NOT NULL,
    status character varying(20) NOT NULL,
    time_rcvd timestamp without time zone NOT NULL,
    author character varying(20) NOT NULL,
    content character varying(200) NOT NULL
);

[download]

Without further ado, here's the script itself: 

#!/usr/bin/perl -w
######################################################################
+##
#
#  $Id: PmChatPage.pl,v 1.4 2005/11/02 16:20:38 peter Exp $
#
#  $Log: PmChatPage.pl,v $
#  Revision 1.4  2005/11/02 16:20:38  peter
#  final touches to get it ready to be posted as a CUFP
#
#  Revision 1.3  2005/11/01 03:39:27  peter
#  DOH!  Forgot to load the notification addresses from the config fil
+e.
#
#  Revision 1.2  2005/11/01 03:33:57  peter
#  autodetect of host it is running on
#
#  Revision 1.1.1.1  2005/11/01 03:28:40  peter
#  This is the beginning of a beautiful thing.
#
#
#  Author: Peter L. Berghold
#
#  Purpose: Retrieve current messages from Perl Monks and send a copy
#           to my pager and email so I can stay on top of what is happ
+ening
#           at my favorite web site.
#           And it cannot be overlooked that this is for my own
#           amuzment and I amuze so easily.
#
######################################################################
+##
$|=1;
 
use strict;
use DBI;
use XML::Simple;
use Data::Dumper;
use LWP::UserAgent;
use HTTP::Request::Common;
use HTTP::Cookies;
use MIME::Lite;
 
#
#       These variables will be configured by the PmChatPage.xml
#       contents via the XML::Simple parser.
# ----------------------------------------------------------------
 
my $conf_parser=new XML::Simple;
my $config= $conf_parser->XMLin();
 
 
my $DSN = sprintf("DBI:%s:database=%s;host=%s",
                  $config->{database}->{driver},
                  $config->{database}->{dbname},
                  $config->{database}->{dbhost});
 
 
 
 
 
my $dbh = DBI->connect($DSN,
                       $config->{database}->{dbuser},
                       $config->{database}->{dbpass},
                       {RaiseError=>1})
  or die DBI::errstr;
 
my $ua=LWP::UserAgent->new();
my $pm="http://www.perlmonks.org/index.pl";
 
$ua->cookie_jar({});   # set up a temporary cookie jar for my session
 
login($ua,$config);    # Log into Perl Monks
 
#
# Check my messages....
my @msg_list=get_messages($ua,get_max_id($dbh));
 
#
# If there are any, process them.
if ($#msg_list > -1 ) {
  process_messages($dbh,$config,@msg_list);
}
 
 
 
exit(0);
 
#
# This sub retrieves the highest id of the messages stored in the data
+base
sub get_max_id {
  my $dbh = shift;
 
  my $sth = $dbh->prepare(qq@
                   select max(message_id) as message_id from messages
 @) or die $dbh->errstr;
  $sth->execute();
  my $row=$sth->fetchrow_hashref;
 
  return $row->{message_id};
 
}
 
 
#
# Logs into PerlMonks
sub login {
  my ($ua,$config)=@_;
  my $r=$ua->request( POST ($pm,[
                                 op=> 'login',
                                 user=> $config->{perlmonks}->{userid}
+,
                                 passwd => $config->{perlmonks}->{pass
+word},
                                 expires => '+1y',
                                 node_id => '16046',
                                 ticker=>'yes'
                                ]));
 
}
 
#
# Slurp in the messages from the XML ticker.
sub get_messages {
  my ($ua,$msg_id)=@_;
  my $xs=new XML::Simple();
 
  my $response = $ua->request(GET("$pm?node_id=15848;since_id=$msg_id"
+));
  my $tree=$xs->XMLin($response->content);
 
  my @msgs=();
  if ($tree->{message}) {
 
    if ( ref($tree->{message}) eq 'ARRAY' ) {
      push @msgs,@{$tree->{message}};
    } else {
      push @msgs,$tree->{message};
    }
 
  }
 
  return @msgs;
}
 
#
# Store the messages into the database and send the notifications out.
sub process_messages {
  my $dbh=shift;
  my $config=shift;
  my $sth=$dbh->prepare(qq(
insert into messages(message_id,status,time_rcvd,author,content)
    values (?,?,?,?,?)
)
 
) or die $dbh->errstr;
 
 
  foreach my $msg (@_) {
    my $raw_time = $msg->{time};
    my $msg_id = $msg->{message_id};
    my $content = $msg->{content};
    my $status = $msg->{status};
    my $author = $msg->{author};
 
    $content =~ s/\n+//g;
 
    $raw_time =~ m@^(\d{4})(\d{2})(\d{2})(\d{2})(\d{2})(\d{2})$@;
 
 
 
    my ($year,$month,$day,$hour,$minute,$seconds)=($1,$2,$3,$4,$5,$6);
 
    my $timestamp=sprintf("%0.4d-%0.2d-%0.2d %0.2d:%0.2d:%0.2d",
                          $year,$month,$day,$hour,$minute,$seconds
                         );
    $sth->execute($msg_id,$status,$timestamp,$author,$content)
      or die $sth->errstr;
 
    my $mail_text = sprintf("Message from %s\n%s",$author,$content);
    my $mail_msg = MIME::Lite->new(
                                   From => $config->{notification}->{m
+ailfrom},
                                   To => $config->{notification}->{pag
+er},
                                   Cc => $config->{notification}->{ema
+il},
                                   Subject => 'Messages on PerlMonks',
                                   Type=> 'TEXT',
                                   Data=> $mail_text
                                  );
     
    $mail_msg->send;
     
  }
}

[download]

Afterword

I run this script on a Linux box I have at home out of cron. I run it about once every 15 minutes between 1300GMT and 0300GMT daily.

Peter L. Berghold -- Unix Professional
Peter -at- Berghold -dot- Net; AOL IM redcowdawg Yahoo IM: blue_cowdawg

Replies are listed 'Best First'.
Re: Send private PM messages to my pager.
by thor (Priest) on Nov 02, 2005 at 19:28 UTC
    While cool and all, I don't know that I'd put a public interface to my pager on the internet. If someone wanted to annoy the bejeesus out of you, they could have it post a message once a second. Your risk is somewhat mitigated since you're running the script every 15 minutes, but I know that I wouldn't want to get a page every 15 minutes for 14 hours a day...

    thor

    Feel the white light, the light within
    Be your own disciple, fan the sparks of will
    For all of us waiting, your kingdom will come

[reply]
      The script could be made to issue an /ignore if someone sent too many messages.
      Caution: Contents may have been coded under pressure.
[reply]
[d/l]

Back to Cool Uses for Perl