Beefy Boxes and Bandwidth Generously Provided by pair Networks
We don't bite newbies here... much
 
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 ( #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

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

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
Node Status?
node history
Node Type: note [id://591053]
help
Chatterbox?
[Corion]: Yay. Traditional finance situation averted. Bonds can be quoted in amounts (1_000_000 EUR) or per unit (1 unit). And a traditional error is to trade 2_000_000 piece when you meant to trade 2_000_000 EUR.
[Corion]: (one of my scripts simply catches high amounts and I phone people making that trade, ideally before the payment is due)
[Corion]: The sad thing is that my script sits at the end of the pipeline and can only look at the payments due today or tomorrow basically, while there are many more systems further up in the pipeline
[GotToBTru]: better late than never, I guess

How do I use this? | Other CB clients
Other Users?
Others wandering the Monastery: (13)
As of 2017-03-29 11:29 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    Should Pluto Get Its Planethood Back?



    Results (347 votes). Check out past polls.