Beefy Boxes and Bandwidth Generously Provided by pair Networks
P is for Practical
 
PerlMonks  

Re: Ensuring only one copy of a perl script is running at a time

by bayugyug (Beadle)
on Dec 21, 2006 at 06:16 UTC ( [id://591053]=note: print w/replies, xml ) Need Help??


in reply to Ensuring only one copy of a perl script is running at a time

hi
to ensure 1 instance of the application running using perl
i have a suggestion
1. pls open a specific port for locking
port must be greater than 10000 and less than 60000
ex: port 28004
2. so as long as the port is open, then, meaning there is still program running on that particular port
3. upon program exit, close the port
i have an ex code below:
hope this helps
its a class
how to use??



#-----------------------------------------------------


use PortLocker();
my $port = 52480;
my $locker = new PortLocker();
if(! $locker->lock())
{
die("Port Already lock, pls check if already running!\n");

#--- failed, port already locked
}
#--- continue here your program

. #then before exit, pls unlock the port

$locker->unlock();


#-----------------------------------------------------






PortLocker.pm ( code )

#----------------------------------------------------------------------------------------------
# Filename : PortLocker.pm
# Description : this is the package that will lock a specified port#
# Date : 08-10-2001
# Ver : ver1.1
# Author : bayugyug
#----------------------------------------------------------------------------------------------



package PortLocker;
use IO::Socket;

#--- set vars here
my $portlock = undef;
use constant PORT_LOCK => 28788;


#---
$| = 1;
my $VERSION = "1.01";





sub new
{


my $type = shift;
my $self = {};
$self->{'PORT'} = $_[0];
$self->{'PORT'} = PORT_LOCK if(int($self->{'PORT'}) <= 0);
bless $self, $type;

}



sub lock()
{

my $self = shift;
my $port = $self->{'PORT'};


$portlock = new IO::Socket::INET (
LocalHost =>
'localhost',
LocalPort => $port,
Proto => 'tcp',
Listen => 1
);

$self->debug("lock() :: port ($port) ok");
#--- return ok/fail

unless( $portlock )
{
return 0;
}

return 1;
}


sub unlock()
{

my $self = shift;
if(defined($portlock))
{
close($portlock);
}

$portlock= undef;
$self->debug("unlock() :: ok");
}


#---
sub debug()
{
my $self = shift;
my (@parm) = (@_);
my $msg = join(' : ',@parm);
my $scr = "Ver$VERSION";

print "$scr - $msg\n";
}


1;


(END) #----------------------------------------------------- hope this helps, tnx #!/bin/bayugyug

Replies are listed 'Best First'.
Re^2: Ensuring only one copy of a perl script is running at a time
by thrig (Beadle) on Mar 25, 2009 at 07:33 UTC
    How do you know port 52480 isn't already in use? This port lies within the Ephemeral Port Range of most modern Unix systems, and could at any time be used by an unrelated TCP session.

Log In?
Username:
Password:

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

How do I use this?Last hourOther CB clients
Other Users?
Others lurking in the Monastery: (5)
As of 2024-03-29 13:35 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found