seeker watch

[vladdrak]

Category:

PerlMonks Related Scripts

Description:

Checks perlmonks at a defined interval for new seeker posts and notifies when found. Since I'm on a Windows box primarily now, it plays a .wav. Season to taste.

use strict;
use LWP::Simple;
use Win32::Sound;

my $poll=600;
my $wav='c:\winnt\media\chimes.wav';
my $question;

&watch;

sub watch {
  my @content = split/\n/,get("http://www.perlmonks.org");
  my $hit;
  
  for (@content) {
    if ($hit and /href.*node.*\>(.*)\<\/a\>/i) {$hit=0;compare($1)};
    $hit=1 if /New Questions/;
  }
}

sub compare {
  my $curquestion=shift;

  if ($question ne $curquestion) {
    $question=$curquestion;
    &act; 
  }
  sleep $poll;
  &watch
}

sub act {
  print "New Question: $question\n";
  Win32::Sound::Play($wav);
}

[kilinrax]

Here's an x-windows version, with slight adjustments.

#!/usr/bin/perl -w

use strict;
use LWP::Simple;

my $poll = 60;
my $question = {};

{
    &watch;
    sleep $poll;
    redo;
}

sub watch {
    my $content = get('http://perlmonks.org/index.pl?node=Seekers%20of
+%20Perl%20Wisdom');
    if ($content =~ /<font color=white>User Questions<\/font>.+?<a hre
+f=\"\/index\.pl\?node_id=\S+\">(.*?)<\/a>/is) {
        compare($1);
    }
}

sub compare {
    my $curquestion = shift;
    if ($question ne $curquestion) {
        $question = $curquestion;
        &act;
    }
}

sub act {
    system "xmessage \"New PerlMonks Question: $question\"";
}

[jeroenes]

I updated the script to work with unapproved questions. I don't like to be popped, so it dumps on term only. I shamelessly copied the passwd stuff from jcwren's luke_repwalker.

#!/usr/bin/perl -w

use strict;
use LWP::Simple;
use Getopt::Std;
use URI::Escape;

use constant APPROV => 'Approved';
use constant UNAPPROV => 'Unapproved';
my $poll = 60;
my %question = ( APPROV, '', UNAPPROV,'');
my $count = 0;
$|=1;

{
  my %args;
  getopts('u:p:', \%args);
  # Replace these dies with username/password
  my $user = $args{u} ||  'jeroenes' || # You can put your name here
    die("You need to specify the user with -u");
  my $pass = $args{p} ||  'youdontwannaknowdoyou'  || # You can put yo
+ur password here
    die("You need to specify the password with -p");
  main( $user, $pass ) while (1);
}

sub main {
    watch( @_);
    my @secs = times;
    $secs[0] += $secs[2];
    $secs[1] += $secs[3];
    printf "Done %5i fetch%s since last new question. CPU: %8.3f user;
+ %8.3f system\r", ++$count, $count>1?'es':'', @secs;
    sleep $poll;
}
 
sub watch {
    my $url = 'http://perlmonks.org/index.pl?node=Seekers%20of%20Perl%
+20Wisdom';
    if (@_) {
      my $user = uri_escape(shift);
      my $passwd = uri_escape(shift);
      $url .= "&op=login&user=$user&passwd=$passwd";
    }
    my $content = get($url) or return;
    if ($content =~ m/<font color=white>User Questions<\/font>.+?<a hr
+ef=\"\/index\.pl\?node_id=\S+\">(.*?)<\/a>/is) {
        compare( APPROV, $1);
    }
    if ($content =~ m/<font color=white>Unapproved Questions<\/font>.+
+?<a href=\"\/index\.pl\?node_id=\S+\">(.*?)<\/a>/is) {
        compare( UNAPPROV, $1);
    }
}
 
sub compare {
    my $state = shift;
    my $curquestion = shift;
    if ($question{$state} ne $curquestion) {
        $question{$state} = $curquestion;
        act($state);
        $count = 0;
    }
}
 
sub act {
    my $state = shift;
    print "\nNew $state PerlMonks Question: $question{$state}\n";
}

prints out some CPU info while waiting....

cheers,

Jeroen
"We are not alone"(FZ)

[vroom]

The wave should be the sound from Monty Python's, "The Holy Grail" with the monks chanting and hitting themselves in the forehead with wooden boards.

vroom | Tim Vroom | [e-mail]

[t0mas]

And here it is.... :)

Other "Holy Grail" sound can be downloaded here. Have fun.

/brother t0mas

[d4vis]

Should you initialize $question? I get :


Use of uninitialized value in string ne at seeker.pl line 26.


when I run it with '-w' in the shebang.

~d4vis
#!/usr/bin/fnord

[vladdrak]

doh.. updated.

[Ido]

A very similar GUI script I've written some time ago. (Before I'd seen that one..Otherwise I wouldn't have written it;)

#!perl -w
use strict;
use Tk;
use Win32::Process;
use LWP::Simple;
use Storable 'nstore','retrieve';
use Socket;

my $mw=new MainWindow(-title=>'Running...');
my($space,$browser,$nqfocus,$nqal,$nqem,$nrfocus,$nral,$nrem,$frfocus,
+$fral,$frem,$to,$smtp,$timer,$rep)=eval '@{retrieve(q/seekers.inf/)}'
+;
END{nstore [$space,$browser,$nqfocus,$nqal,$nqem,$nrfocus,$nral,$nrem,
+$frfocus,$fral,$frem,$to,$smtp],'seekers.inf'};
$mw->Label(-textvariable=>\(my $timeshow='Time to next check: 00:00'))
+->pack;
$mw->Label(-textvariable=>\(my $nq))->pack;

my $buttons=$mw->Frame->pack;
    $buttons->Button(-text=>'Launch',-command=>\&launch)->pack(-side=>
+'left');
        my($pause,$pausea,$cont);
        $pausea=sub{$rep->cancel;$mw->title('Paused');$pause->configur
+e(-text=>'Continue',-command=>$cont)};
        $cont=sub{$rep=$mw->repeat(1000,\&timer);$mw->title('Running')
+;$pause->configure(-text=>'Pause',-command=>$pausea)};
    $pause=$buttons->Button(-text=>'Pause',-command=>$pausea)->pack(-s
+ide=>'left');
    $buttons->Button(-text=>'Check Now',-command=>\&check)->pack(-side
+=>'left');
my $options=$mw->Frame;
my @o;
    $o[0]=$options->Label(-text=>'General Settings: ')->form(-top=>5,-
+left=>15);
    $o[1]=$options->Label(-text=>'Time between checks: ')->form(-top=>
+[$o[0],3],-left=>5);
    $o[2]=$options->Entry(-width=>4,-textvariable=>\($space=60))->form
+(-top=>['&',$o[1]],-left=>[$o[1],3]);
    $o[3]=$options->Label(-text=>'seconds')->form(-top=>['&',$o[1]],-l
+eft=>$o[2]);
    $o[4]=$options->Label(-text=>'Web Browser Location: ')->form(-top=
+>[$o[1],1],-left=>5);
    $o[5]=$options->Entry(-textvariable=>\$browser)->form(-top=>['&',$
+o[4]],-left=>[$o[4],3]);
    $o[6]=$options->Button(-text=>'...',-command=>sub{$browser=$mw->ge
+tOpenFile(-title=>'Web Browser',-filetypes=>[['Programs','.exe']])})-
+>form(-top=>['&',$o[4]],-left=>[$o[5],1]);
    $o[7]=$options->Label(-text=>'E-Mail Recipient: ')->form(-top=>[$o
+[4],1],-left=>5);
    $o[8]=$options->Entry(-textvariable=>\$to)->form(-top=>['&',$o[7]]
+,-left=>[$o[7],3]);
    $o[9]=$options->Label(-text=>'SMTP Server: ')->form(-top=>[$o[7],1
+],-left=>5);
    $o[10]=$options->Entry(-textvariable=>\$smtp)->form(-top=>['&',$o[
+9]],-left=>[$o[9],3]);
    $o[11]=$options->Label(-text=>'Upon New Question: ')->form(-top=>[
+$o[10],5],-left=>['&',$o[0]]);
    $o[12]=$options->Checkbutton(-variable=>\$nqal)->form(-top=>[$o[11
+],1],-left=>5);
    $o[13]=$options->Label(-text=>'Auto Launch')->form(-top=>['&',$o[1
+2]],-left=>[$o[12],1]);
    $o[14]=$options->Checkbutton(-variable=>\$nqfocus)->form(-top=>[$o
+[13],1],-left=>5);
    $o[15]=$options->Label(-text=>'Focus Window')->form(-top=>['&',$o[
+14]],-left=>[$o[14],1]);
    $o[16]=$options->Checkbutton(-variable=>\$nqem)->form(-top=>[$o[15
+],1],-left=>5);
    $o[17]=$options->Label(-text=>'Send E-Mail')->form(-top=>['&',$o[1
+6]],-left=>[$o[16],1]);
    $o[18]=$options->Label(-text=>'Upon First Reply: ')->form(-top=>[$
+o[17],5],-left=>['&',$o[0]]);
    $o[19]=$options->Checkbutton(-variable=>\$fral)->form(-top=>[$o[18
+],1],-left=>5);
    $o[20]=$options->Label(-text=>'Auto Launch')->form(-top=>['&',$o[1
+9]],-left=>[$o[19],1]);
    $o[21]=$options->Checkbutton(-variable=>\$frfocus)->form(-top=>[$o
+[20],1],-left=>5);
    $o[22]=$options->Label(-text=>'Focus Window')->form(-top=>['&',$o[
+21]],-left=>[$o[21],1]);
    $o[23]=$options->Checkbutton(-variable=>\$frem)->form(-top=>[$o[22
+],1],-left=>5);
    $o[24]=$options->Label(-text=>'Send E-Mail')->form(-top=>['&',$o[2
+3]],-left=>[$o[23],1]);
    $o[25]=$options->Label(-text=>'Upon Any New Reply: ')->form(-top=>
+[$o[24],5],-left=>['&',$o[0]]);
    $o[26]=$options->Checkbutton(-variable=>\$nral)->form(-top=>[$o[25
+],1],-left=>5);
    $o[27]=$options->Label(-text=>'Auto Launch')->form(-top=>['&',$o[2
+6]],-left=>[$o[26],1]);
    $o[28]=$options->Checkbutton(-variable=>\$nrfocus)->form(-top=>[$o
+[27],1],-left=>5);
    $o[29]=$options->Label(-text=>'Focus Window')->form(-top=>['&',$o[
+28]],-left=>[$o[28],1]);
    $o[30]=$options->Checkbutton(-variable=>\$nrem)->form(-top=>[$o[29
+],1],-left=>5);
    $o[31]=$options->Label(-text=>'Send E-Mail')->form(-top=>['&',$o[3
+0]],-left=>[$o[30],1]);

my($settings,$noset);
$settings=$mw->Button(-text=>'Settings>>',-command=>sub{$settings->pac
+kForget;$noset->pack(-anchor=>'e');$options->pack})->pack(-anchor=>'e
+');
$noset=$mw->Button(-text=>'Hide Settings<<',-command=>sub{$noset->pack
+Forget;$settings->pack(-anchor=>'e');$options->packForget});


{
    my($last,$lastre);
    sub check{
        $timer=$space;
        $rep->cancel if $rep;
        $mw->title($last?'Checking...':'Initializing...');$mw->update;
        my $content=get('http://www.perlmonks.org/index.pl?node=Seeker
+s%20of%20Perl%20Wisdom') or $mw->title('Error...'),$timer=10,$rep=$mw
+->repeat(1000,\&timer),return;
        my($first,$question)=$content=~/<!-- Begin Post -->(.*?<a[^>]*
+>([^<]*)<.*?)<!--  End Post  -->/s;
        $first=~s/(\d+)\srepl(y|ies)//;
        $nq="$question ($1 repl".($1==1?'y':'ies)');
        if($last and $first ne $last){
            launch() if $nqal;
            $mw->deiconify,$mw->focusForce if $nqfocus;
            sendemail('New Question') if $nqem;
            }
        elsif(defined $lastre and $lastre!=$1){
            launch() if $nral;
            $mw->deiconify,$mw->focusForce if $nrfocus;
            sendemail('New Reply') if $nrem;
            if($1==1){
                launch() if $fral&&!$nral;
                $mw->deiconify,$mw->focusForce if $frfocus&&!$nrfocus;
                sendemail('First Reply') if $frem&&!$nrem;
                }
        }
        $lastre=$1;$last=$first;
        $rep=$mw->repeat(1000,\&timer);
        $mw->title('Running...');$mw->update;
    }
}
sub timer{check() unless $timer;$timer--;$timeshow=sprintf 'Time to ne
+xt check: %02d:%02d',int($timer/60),$timer%60}
sub launch{Win32::Process::Create(my $obj,$browser,'http://www.perlmon
+ks.org/index.pl?node=Seekers%20of%20Perl%20Wisdom',0,NORMAL_PRIORITY_
+CLASS,'.')}

sub sendemail{
$mw->title('Sending E-Mail...');
$mw->update;
socket my($fh),PF_INET,SOCK_STREAM,scalar getprotobyname('tcp');
connect $fh,sockaddr_in(25,inet_aton($smtp)) or die $!;
select+(select($fh),$|=1)[0];
print $fh "HELO localhost\15\12MAIL FROM:<update\@perlmonks.org>\15\12
+RCPT TO:$to\15\12","DATA\15\12To: $to\15\12Subject: $_[0]\15\12\15\12
+$nq\15\12.\15\12QUIT\15\12";
}


$mw->after(1000,\&check);

MainLoop;