$VERSION
=
do
{
my
(
@r
)=
q$Revision: 1.2 $
=~/\d+/g;
sprintf
'%d.'
.
'%02d'
x
$#r
,
@r
};
BEGIN {
$ENV
{
'FACTORY_HOME'
} ||=
'.'
;
}
use
POSIX
qw/EBADF EDEADLK/
;
sub
new {
my
(
$type
,
$file
) =
@_
;
my
$no
;
my
$this
= {
'file'
=>
$file
};
my
$sym
= gensym;
unless
(
open
(
$sym
,
"+<$file"
)) {
croak
"Couldn't open [$file]: $!"
;
}
my
$old
= new SelectSaver
$sym
;
$| = 1;
$this
->{
'fh'
} =
$sym
;
return
bless
$this
,
$type
;
}
sub
DESTROY { }
sub
next
{
my
$this
=
shift
;
my
$fh
=
$this
->{
'fh'
};
seek
(
$fh
,0,0);
$this
->_lock;
my
$old_id
;
chomp
(
$old_id
= <
$fh
>);
my
$new_id
=
$this
->_id_increment(
$old_id
);
unless
(
$new_id
) {
croak
"Couldn't increment [$old_id]"
;
}
seek
(
$fh
,0,0);
print
$fh
"$new_id\n"
;
truncate
(
$fh
,
length
(
$new_id
)+1);
$this
->_unlock;
return
$new_id
;
}
sub
set {
my
(
$this
,
$value
) =
@_
;
my
$fh
=
$this
->{
'fh'
};
unless
(
defined
(
$value
)) {
croak
"No value supplied"
;
}
seek
(
$fh
,0,0);
$this
->_lock;
print
$fh
"$value\n"
;
truncate
(
$fh
,
length
(
$value
) + 1);
$this
->_unlock;
}
sub
_lock {
my
$this
=
shift
;
my
$fh
=
shift
||
$this
->{
'fh'
};
my
$file
=
shift
||
$this
->{
'file'
};
my
$retries
= 3;
my
$status
=
undef
;
my
$no
;
do
{
$status
= File::lockf::
lock
(
$fh
);
if
(
$status
== EBADF) {
croak
"Bad filehandle error locking [$file]"
;
}
elsif
(
$status
== EDEADLK) {
unless
(--
$retries
) {
croak
"Deadlock error locking [$file]"
;
}
sleep
2;
}
elsif
(
$status
) {
unless
(--
$retries
) {
croak
"Communication error (NFS?) locking [$file]"
;
}
sleep
10;
}
else
{
$retries
= 0;
}
}
while
(
$retries
);
}
sub
_unlock {
my
$this
=
shift
;
my
$fh
=
shift
||
$this
->{
'fh'
};
my
$file
=
shift
||
$this
->{
'file'
};
my
$status
=
undef
;
seek
(
$fh
,0,0);
$status
= File::lockf::ulock(
$fh
);
if
(
$status
== EBADF) {
croak
"Bad filehandle error unlocking [$file]"
;
}
elsif
(
$status
== EDEADLK) {
croak
"Lock table full error unlocking [$file]"
;
}
elsif
(
$status
) {
croak
"Communication error (NFS?) unlocking [$file]"
;
}
}
sub
_id_increment {
my
(
$this
,
$old_id
) =
@_
;
if
(!
defined
(
$old_id
) or
$old_id
< 0) {
return
;
}
return
$old_id
+ 1;
}
$VERSION
=
$VERSION
;