Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl Monk, Perl Meditation
 
PerlMonks  

seeker watch

by vladdrak (Monk)
on Sep 14, 2000 at 02:13 UTC ( #32379=sourcecode: print w/replies, xml ) Need Help??
Category: PerlMonks Related Scripts
Author/Contact Info Vlad Drak chris@randomdynamics.com
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);
}
Replies are listed 'Best First'.
RE: seeker watch
by kilinrax (Deacon) on Sep 26, 2000 at 19:12 UTC
    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\"";
}

    [download]
[reply]
[d/l]
      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";
}

      [download]
      prints out some CPU info while waiting....

      cheers,

      Jeroen
      "We are not alone"(FZ)

[reply]
[d/l]
RE: seeker watch
by vroom (Pope) on Sep 14, 2000 at 03:18 UTC
    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 | vroom@cs.hope.edu
[reply]
      And here it is.... :)

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

      /brother t0mas
[reply]
RE: seeker watch
by d4vis (Chaplain) on Sep 14, 2000 at 23:03 UTC
    Should you initialize $question? I get :
    Use of uninitialized value in string ne at seeker.pl line 26.

    [download]

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

    ~d4vis
    #!/usr/bin/fnord

[reply]
[d/l]
      doh.. updated.
[reply]
Re: seeker watch
by Ido (Hermit) on Jul 25, 2002 at 01:50 UTC
    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;

    [download]
[reply]
[d/l]
Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: sourcecode [id://32379]
help
Chatterbox?
and all is quiet...

How do I use this? | Other CB clients
Other Users?
Others examining the Monastery: (8)
As of 2018-07-16 22:21 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    It has been suggested to rename Perl 6 in order to boost its marketing potential. Which name would you prefer?















    Results (352 votes). Check out past polls.
    Notices?