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 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 (His Eminence) 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]

Back to Code Catacombs

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?

www.com | www.net | www.org
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 romping around the Monastery: (4)
As of 2023-01-31 11:23 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found
    Notices?