Beefy Boxes and Bandwidth Generously Provided by pair Networks
Just another Perl shrine
 
PerlMonks  

Re: seeker watch

by Ido (Hermit)
on Jul 25, 2002 at 01:50 UTC ( #185089=note: print w/ replies, xml ) Need Help??


in reply to seeker watch

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;


Comment on Re: seeker watch
Download Code

Log In?
Username:
Password:

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

How do I use this? | Other CB clients
Other Users?
Others wandering the Monastery: (6)
As of 2015-07-04 05:51 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    The top three priorities of my open tasks are (in descending order of likelihood to be worked on) ...









    Results (57 votes), past polls