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

lakshmananindia's scratchpad

by lakshmananindia (Chaplain)
on Sep 15, 2008 at 09:02 UTC ( #711411=scratchpad: print w/ replies, xml ) Need Help??

Daemon.pm
# #===================================================================== +========== # # FILE: Daemon.pm # # DESCRIPTION: A separate package for Daemonizing the program. # # FILES: --- # BUGS: --- # NOTES: --- # AUTHOR: (), <> # COMPANY: # VERSION: 1.0 # CREATED: 10/22/08 19:35:52 IST # REVISION: --- #===================================================================== +========== package Daemon; use strict; use warnings; use POSIX; use Carp; #If we export functions then there is no need for us to use Packagenam +e::funtion_name. We can just use the function. # Object Creation sub new { bless {}, shift } ; # To open maximum file descriptors. sub Open_Descriptors { my $openmax = POSIX::sysconf( &POSIX::_SC_OPEN_MAX );#This wil +l give the maximum open descriptors. (!defined($openmax) || $openmax < 0) ? 1024 : $openmax;#If tha +t is given then take that else use 1024. } #This is used to fork and exit to get rid of the controlling terminal. sub Forking { my $pid; if (($pid = fork()) < 0) { die("can't fork"); } elsif ($pid != 0) { exit(0); } return ; } #=== FUNCTION ====================================================== +========== # NAME: Daemonize # PURPOSE: To make daemon process. # PARAMETERS: ???? # RETURNS: ???? # DESCRIPTION: ???? # THROWS: no exceptions # COMMENTS: none # SEE ALSO: n/a #===================================================================== +========== sub Daemonize { my $class = shift; my ( $fd0,$fd1,$fd2,$pid ); umask(0); # Clear the file creation mask. #Fork the process. $class->Forking; croak "Cannot detach from controlling terminal" unless my +$sess_id = POSIX::setsid(); $SIG{'HUP'} = 'IGNORE'; $class->Forking;#Again call the fork. ## Change working directory to root. #chdir "/"; # Close all the file descriptors foreach my $i (0 .. $class->Open_Descriptors) { POSIX::clo +se($i); } ## Reopen stderr, stdout, stdin to /dev/null open(STDIN, "+>/dev/null"); open(STDOUT, "+>&STDIN"); open(STDERR, "+>&STDIN"); return ; } 1;
XP alert
#!/usr/bin/perl use strict; use warnings; use LWP; use XML::Simple; use Daemon; use Tk; my $obj=new Daemon; $obj->Daemonize; my $oldxp=0; my $curxp; my $user="lakshmananindia"; while (1) { if ( -e "./.perlmonks" ) { open (FILE,"./.perlmonks") or die "Cannot open the file .perlm +onks\n"; $oldxp=<FILE>; chomp $oldxp; close FILE; } my $browser = LWP::UserAgent->new; my $req="http://perlmonks.org/index.pl?node_id=16046&for_user=" . +$user; my $response = $browser->get($req); my $ticker = XMLin($response->content); $curxp = $ticker->{XP}->{xp}; my $gained = $curxp - $oldxp; my $mw = new MainWindow; $mw->withdraw(); if($gained > 0) { $mw->messageBox(-icon => 'info', -message =>"Hey $user! You ga +ined $gained XP\n", -title => "Your current XP is $curxp", -type => ' +ok'); } elsif($gained < 0) { $mw->messageBox(-icon => 'info', -message =>"Sorry $user! You +lost $gained XP\n", -title => "Your current XP is $curxp", -type => ' +ok'); } else { $mw->messageBox(-icon => 'info', -message =>"Hai $user! Your X +P is $curxp\n", -title => "Your current XP is $curxp", -type => 'ok') +; } $mw->destroy(); open (FILE,'>',"./.perlmonks") or die "Cannot open the file\n"; print FILE $curxp; close FILE; sleep(300); }
New Node Alert
#!/usr/bin/perl #===================================================================== +========== # # FILE: lak1.pl # # USAGE: ./lak1.pl # # DESCRIPTION: # # OPTIONS: --- # REQUIREMENTS: --- # BUGS: --- # NOTES: --- # AUTHOR: (), <> # COMPANY: # VERSION: 1.0 # CREATED: 04/06/09 13:08:10 IST # REVISION: --- #===================================================================== +========== use strict; use warnings; use strict; use warnings; use LWP; use XML::Simple; use Daemon; use Tk; my $obj=new Daemon; $obj->Daemonize; while(1) { my $oldnode_id=0; if ( -e "./.perlmonks_recent" ) { open (FILE,"./.perlmonks_recent") or die "Cannot open the file + .perlmonks\n"; $oldnode_id=<FILE>; chomp $oldnode_id; close FILE; } my $browser = LWP::UserAgent->new; my $response = $browser->get('http://www.perlmonks.org/?node_id=30 +175;types=perlquestion'); my $ticker=XMLin($response->content); my $currnode_id=$ticker->{NODE}[0]->{node_id}; if($currnode_id > $oldnode_id) { my $mw=new MainWindow; $mw->withdraw(); $mw->messageBox(-icon => 'info', -message =>"Hai Lakshmanan! T +here is a new node titled $ticker->{NODE}[0]->{content}", -title => " +$ticker->{NODE}[0]->{authortitle}", -type => 'ok'); $mw->destroy(); } open (FILE,'>',"./.perlmonks_recent") or die "Cannot open the file +\n"; print FILE $currnode_id; close FILE; sleep(300); }
Log In?
Username:
Password:

What's my password?
Create A New User
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others about the Monastery: (16)
As of 2014-07-31 13:35 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    My favorite superfluous repetitious redundant duplicative phrase is:









    Results (248 votes), past polls