Beefy Boxes and Bandwidth Generously Provided by pair Networks
Clear questions and runnable code
get the best and fastest answer
 
PerlMonks  

seeker watch

by vladdrak (Monk)
on Sep 14, 2000 at 02:13 UTC ( #32379=sourcecode: print w/ replies, xml ) Need Help??

Category: PerlMonks.org 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);
}

Comment on seeker watch
Download Code
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
      And here it is.... :)

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

      /brother t0mas
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.

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

    ~d4vis
    #!/usr/bin/fnord

      doh.. updated.
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\""; }
      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)

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;

Back to Code Catacombs

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: sourcecode [id://32379]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others examining the Monastery: (13)
As of 2014-10-31 18:38 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    For retirement, I am banking on:










    Results (223 votes), past polls