#!/usr/bin/perl -w
use strict ;

=head1 NAME sched_resource_manager

=head2 INSTALLATION

=head2 USAGE

=cut

#####################################################

my $prefix = '/tmp' ;
my $tempo  = 30 ; # sleep $tempo between 2 check

#####################################################

use Fcntl ':flock'; # import LOCK_* constants
use Getopt::Long;

my $resource ;
my $help_message ;
my $release ;
my $serial ;
my $list ;

GetOptions ("help"       => \$help_message,
	    "resource=s" => \$resource,
	    "serial=s"   => \$serial,
	    "list"       => \$list,
	    "ok"         => \$release) ;

if (   $help_message 
    or !$resource
    or (!$serial and !$list)
   )
{
    print "Usage : $0 [-h] [-o] [-l] -s serial -r resource_name
    --help	    : this message
    --resource name : try to acquire resource 'name' (case independant)
    --serial	    : job serial
    --list	    : list who is waiting for resource
    --ok	    : release resource 

    Example in sched_builder

    comment = 'acquire resource tape1'
    cmd_line = $0 -s \${SERIAL} -r tape1

    ...

    comment = 'release resource tape1 for other job'
    cmd_line = $0 -s \${SERIAL} -r tape1 -o

    ...
    $0 -l -r tape1
    Waiting for resource tape1
     1) serial1 (pid 2819)
     2) serial2 (pid 281)


" ;
    exit 0 ;
}

$resource =~ s/\W/_/g ;
$resource = lc($resource) ;

my $lock ;
my $wait_file ;

sub lock_manager
{
    open ($lock, ">$prefix/$resource") 
	|| die "E : problem opening $prefix/$resource ($!)";

    flock $lock, LOCK_EX;
    print scalar(localtime(time)), " : lock ok\n" ;
}

sub unlock_manager
{
    flock $lock, LOCK_UN;
    close($lock);
    undef $lock ;
    print scalar(localtime(time)), " : unlock ok\n" ;
}

END {
    if ($lock) {
	unlock_manager() ;
    }
}    

sub touch
{
    my $file = shift ;
    open(FP, ">$prefix/$file") ||
	die "E : can't touch $prefix/$file ($!)" ;
    close(FP) ;
}


sub test_resource
{
    
    my @files = <$prefix/${resource}.*> ;
	
    die "E : our turn have been delete"
	unless (scalar(@files)) ;
    
    my $first = shift @files ;
    if ($first eq "$prefix/$wait_file") {
	# c'est a nous
	return 1 ;
    }

    return 0 ;
}

if ($release) 
{
    lock_manager() ;
    # recuperation de la liste d'attente
    my @files = <$prefix/${resource}.*> ;
    my $ret = 0 ;

    # si on est tout seul
    if (scalar(@files) == 0) {
	unlock_manager() ;
	die "E : can't release resource (already free)" ;
    }

    my $first = shift @files ;
    
    if ($first !~ m!^$prefix/${resource}\.(\d+)\.${serial}\.(\d+)$!) {
	# c'est pas a nous, on supprime et on se casse
	$ret = 1 ;
	print "E : it's not our turn\n" ;
    }

    my ($file) = <$prefix/${resource}.[0-9]*.${serial}.[0-9]*> ;
    
    if ($file) {
	unlink($file) ;
    }

    unlock_manager() ;
    
    if ($ret == 0) { # la ressource etait a nous
	    my $second = shift @files ;

	    if ($second) {
		if ($second =~ /${resource}\.\d+\..+\.(\d+)$/) {
			kill('USR1', $1) ;
		}
	    }
    }

    print "I : release resource ($resource) ok\n" ;
    exit $ret ;

} elsif($list) {
    my @files = <$prefix/${resource}.*> ;
    print "Waiting for resource $resource\n" ;
    my $first = '*' ;
    for my $f (@files) {
	if ($f =~ /$resource\.(\d+)\.(.+)\.(\d+)$/) {
		print "$first $1) $2 (pid $3)\n" ;
		$first = ' ' ;
	}
    }
    exit 0 ;
} else {

    lock_manager() ; 
    # recuperation de la liste d'attente
    my @files = <$prefix/${resource}.*> ;

    # si on est tout seul
    if (scalar(@files) == 0) {
	touch("${resource}.1.${serial}.$$") ;
	unlock_manager() ;
	exit 0 ;
    }

    # on est pas tout seul, il faut donc attendre
    if (scalar(@files) > 0) {
        my ($file) = <$prefix/${resource}.[0-9]*.${serial}.[0-9]*> ;
       
        die "E : This resource $resource is already lock ($file)"
		if ($file) ;

	# on se positionne dans la file d'attente
	my $last = pop @files ;

	if ($last !~ m!^$prefix/${resource}\.(\d+)\..+\.(\d+)$!) {
	    print "E : last worker have a bad name ($last)\n" ;
	    exit 1 ;
	}

	my $nb = $1 + 1 ;
	$wait_file = "${resource}.${nb}.${serial}.$$" ;

	touch($wait_file) ;

	unlock_manager() ;

	$SIG{USR1} = sub {
	    my $ret = test_resource() ;
	    exit 0 if ($ret) ;
	} ;
        
	$SIG{TERM} = $SIG{INT} = sub {
	    unlink("$prefix/$wait_file") ;
	    print "I : Recieve TERM/INT Signal\n" ;
	    exit 1 ;
	} ;

	while (sleep $tempo) {
	    my $ret = test_resource() ;
	    exit 0 if ($ret) ;
	}
    }
} 

exit 1 ;

__END__

=head1 AUTHOR

(C) 2004-2005 Eric Bollengier

You may reach me through the contact info at eric@eb.homelinux.org

=head1 LICENSE

    sched_validate_job, part of the network scheduling system (Sched)
    Copyright (C) 2004-2005 Eric Bollengier
        All rights reserved.

    This program is free software; you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
    the Free Software Foundation; either version 2 of the License, or
    (at your option) any later version.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.

    You should have received a copy of the GNU General Public License
    along with this program; if not, write to the Free Software
    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA

=cut

