Beefy Boxes and Bandwidth Generously Provided by pair Networks
Syntactic Confectionery Delight
 
PerlMonks  

comment on
( [id://3333]=superdoc: print w/replies, xml ) Need Help??
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]

In reply to Re: seeker watch by Ido
in thread seeker watch by vladdrak

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":


  • Are you posting in the right place? Check out Where do I post X? to know for sure.
  • Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
    <code> <a> <b> <big> <blockquote> <br /> <dd> <dl> <dt> <em> <font> <h1> <h2> <h3> <h4> <h5> <h6> <hr /> <i> <li> <nbsp> <ol> <p> <small> <strike> <strong> <sub> <sup> <table> <td> <th> <tr> <tt> <u> <ul>
  • Snippets of code should be wrapped in <code> tags not <pre> tags. In fact, <pre> tags should generally be avoided. If they must be used, extreme care should be taken to ensure that their contents do not have long lines (<70 chars), in order to prevent horizontal scrolling (and possible janitor intervention).
  • Want more info? How to link or How to display code and escape characters are good places to start.
Log In?
Username:
Password:

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

www.com | www.net | www.org
Chatterbox?
and the web crawler heard nothing...

How do I use this? • Last hour • Other CB clients
Other Users?
Others having an uproarious good time at the Monastery: (4)
As of 2024-04-19 16:58 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found