#cbhistory.pl #!/usr/bin/perl -w =head1 DESCRIPTION - what is this cbhistory thing? Well it keeps a history of messages uttered in the cb, so if you walk in on something I, you can catch up without saying: "what are you guys talking about?" =head1 USAGE make a crontab entry looking like */5 * * * * cd /path/to/script/ && ./cbhistory.pl>/dev/null You can do it using crontab -e. You really shouldn't run it more than every 6 minutes, but because of how cron works and whatnot, 5 will do. Don't run it more often than 4 minutes, cause the whole point is to get a recent history of messages so if you walk in something you know what is up, not use it as a replacement to framechat ;) This is not a cb client =head1 SETUP You need to define your database connection. See the C definitions below. You also need to setup your database. Messages are stored in a table called C with the following layout (this for postgresql): Column Type Usage Chatterbox text Chatterbox name (see %boxes keys) MessageTime timestamp Time message was sent UserId integer ID of user that sent message UserName text Name of user that sent message Message text The message itself This table should have a primary key consisting of the Chatterbox and MessageTime fields. =head1 HISTORY this version written by pfaut of perlmonks. cbhistory is derived from cblast35 which was written by crazyinsomniac. =cut BEGIN # better then getting mail fron cron when the script fails { # even if it is a "performance penalty", but really, its not ;-) use CGI::Carp qw(carpout); open(LOG, ">>cbhistory.err.log") or die "can't append to cbhistory.pl.err.log: $!"; carpout(\*LOG); } use strict; # Fo' health and pleasure use XML::Parser; # Fo' parsering'em XML use DBI; # Fo' da db use LWP::UserAgent; # Fo' fetching'em tickers require HTTP::Request; require HTTP::Response; use constant DB_CONNECT => 'dbi:Pg:dbname=chatter'; # this user should have all rights on the chatter table use constant DB_USER => 'username'; use constant DB_PASS => 'password'; # known chatterboxes my %boxes = ( PM => 'http://www.perlmonks.org/index.pl', JJ => 'http://www.javajunkies.org/index.pl' ); # it begins my $dbh = DBI->connect(DB_CONNECT, DB_USER, DB_PASS, {RaiseError=>0,PrintError=>0}) or die "Error connecting to database: $DBI::errstr"; my $insert_stmt = $dbh->prepare(<finish; $dbh->do(<disconnect; exit; sub update_history { my ($boxname, $cbtickerurl) = @_; $cbtickerurl .= '?node=Chatterbox+xml+ticker'; my $dangtimeout = 15; # apparently, this is not the timeout for the entire session # but for each packet ([id://79502]) my $messages = &fetch_cb_xml($cbtickerurl,$dangtimeout); print "$boxname has no messages",return unless defined %{$messages}; &tyebinds($boxname,$messages); undef $messages; }# it ends ############################################################################## ###### - \ | / ~ \ | / - \ | / ~ \ | / - \ | / ~ \ | / - \ | / ~ S U B L A N D =head2 C<&tyebinds($box,$messages);> Takes a reference to the freshly fetched messages. asks L<&can_i_write> for I. If denied, sleeps five seconds, and asks again. die's if it doesn't get permission. If it does get permission (a semaphore file is created), it updates the DB_File database with the new messages, and then removes all but the last 35 messages, untie's the hash, and deletes the semaphore file =cut sub tyebinds { my $box = shift; my $newmessages = shift; # update the message hash for my $timestamp(sort keys %{$newmessages}) { my ($tym) = $timestamp; $tym =~ s/(\d{4})(\d{2})(\d{2})(\d{2})(\d{2})(\d{2})/$1-$2-$3 $4:$5:$6/; my $idn = $newmessages->{$timestamp}->{monkid}; my $nym = $newmessages->{$timestamp}->{monk}; my $msg = $newmessages->{$timestamp}->{message}; $msg =~ s/[\n\r]+//g; # ignore errors, probably duplicate key because we picked # up the message on the last scan $insert_stmt->execute($box, $tym, $idn, $nym, $msg); } undef $newmessages; } =head2 C uses LWP::UserAgent to fetch the xml from $cbtickerurl. Dies if this fails. If it does not, uses XML::Parser to build a hash of the current messages, which is never more than 20(IIRC, or the last 8 minutes if things are slow), and returns a reference to that hash (C<\%messages>). =cut sub fetch_cb_xml { my ($cbtickerurl,$dangtimeout) = @_; die("&fetch_cb_xml takes two params")unless($cbtickerurl && $dangtimeout); # why redundancy, dudn't hurt much my $raw_xml = &requestitraw($cbtickerurl,$dangtimeout); die "LWP::Simple::get ate it on $cbtickerurl ($!)" unless(length $raw_xml > 4); # self documenting code is goood, but comments can't hurt my $messages = {}; my $xml_parser = new XML::Parser( Handlers => { Start => \&_xml_start, End => \&_xml_end, Char => \&_xml_char, Default => \&_xml_def, } ); $xml_parser->{crazy_hashref_b392} = $messages; # make sure you don't call "crazy_hashref_b392" # "Handler" or some other key the module uses ;-) $xml_parser->parse($raw_xml); # parse the xml, &fill {crazy_hashref_b392} undef($raw_xml); # kinda redundant, but i like redundancy undef($xml_parser); # paranoia return $messages; } =head2 C<&requestitraw($cbtickerurl,$dangtimeout);> Uses HTTP::Request along with LWP::UserAgent to fetch the latest messages. =cut sub requestitraw { # LWP simple would've been fine, but hey, I wanted to use UserAgent # But, Dangit Jim, I wanted a timeout my ($toget, $dangtimeout) = @_; my $REQUS = new HTTP::Request(GET => $toget); my $USERA = new LWP::UserAgent(); $USERA->agent("cb Last 35 - crazy is good 4.98"); $USERA->timeout($dangtimeout||30 ); # in case you think you're smart my $RESPO = $USERA->simple_request($REQUS); die "the $toget request failed" if(!$RESPO->is_success && $RESPO->is_error); return $RESPO->content; } ########### YOU CAN'T HAVE ANY PUDDIN', UNTIL YOU EAT YOUR MEAT ################ ################################################################################ ## Thank you id://62782 ####, # The XML::Parser Handlers sub _xml_start # beginning tag { my ($expat, # the object who invoked the sub $name, # what to do %attributes) = @_; # wood for the chipper(what the fu'? my $msghash = $expat->{crazy_hashref_b392};# don't call it Handlers ;-) if($name eq 'message') { my $userid = $attributes{'user_id'}; my $author = $attributes{'author'}; my $timest = $attributes{'time'}; $expat->{mark} = # the trigger $msghash->{$timest} = {monkid => $userid, monk => $author, message => ''}; } } sub _xml_char # more like text (tag encapsulated stuff) { my ($expat, $not_markup) = @_; if(exists $expat->{mark} and defined $expat->{mark}) { # this be the stuff in between message tags $expat->{mark}->{message} .= $not_markup; # i .= append because XML::Parser chuncks } } sub _xml_def{} # mostly space, with some tabs and newlines sprinkled about the north west area sub _xml_end # it's an *end* (closing) tag { my ($expat, $name) = @_; undef($expat->{mark}); # after the tag close, we wait for the next one }