#!/usr/bin/perl
use strict;
#################### main pod documentation begin ###################

=head1 NAME

  Zymonic - Test script to verify locking works within the system
  as needed.

=head1 SYNOPSIS

=head1 DESCRIPTION

This script will take in a process name then verify that
only one 'user' at a time can get a lock on it.

=head1 SUPPORT

As in the license, Zymonic is provided without warranty or support
unless purchased separately, however... If you email
zymonic-support@zednax.com your issue will   be noted and may
receive a response.

For security issues, please contact zymonic-security@zednax.com and
someone will respond within 8 working hours.


=head1 AUTHOR

    Alex Masidlover et al.
    CPAN ID: MODAUTHOR
    Zednax Limited
    alex.masidlover@zednax.com
    http://www.zednax.com

=head1 COPYRIGHT

This program is free software licensed under the...

    Zymonic Public License 1.0

The full text of the license can be found in the
LICENSE file included with this module.

Other licenses may be acceptable if including
parts of Zymonic in larger projects, please
contact Zednax for details. 

=head1 SEE ALSO

perl(1).

=cut

#################### main pod documentation end ###################

# modules
use File::Slurp;
use Sys::Hostname;

use Zymonic::Script;
use Zymonic::Process;

# start a zymonic script
my $s = Zymonic::Script->new(
    args => {
        process => { type => 'string', required => 'true', description => 'ZName of the process to use', },
        users   => { type => 'int',    default  => 2,      description => 'Number of simultaneous users', },
        process_id =>
          { type => 'int', description => 'ID of the process to use. If not set then will create a new one.', },
        attempts => { type => 'int', default => 1, description => 'Number of times to run.', },
    },
    init_session => '',
    init_auth    => 'true',
    init_locking => 'true',
);

# file names used as semaphores with child processes
my $run_file     = 'locking_process.run';
my $attempt_file = 'locking_process.attempt';
my $wait_file    = 'locking_process.wait';
my $lock_file    = 'locking_process.lock';

main();
exit(0);

#################### subroutine header begin ####################

=head2 main 

 Usage     : main();
 Purpose   : main script functionality
 Returns   : nothing
 Argument  : nothing
 Throws    : nothing
 Comment   : 


See Also   :

=cut

#################### subroutine header end ###################

sub main
{
    # get process
    my $process_zname = $s->get_arg('process');
    my $process_id    = get_process_id();

    # grab the current lock and quit if it has one, verify it before quitting
    my $lock_args = $s->get_process_lock_args( $process_zname, $process_id );
    my $lock_value = $s->{locking}->get_current_lock( 'process', $lock_args );
    $s->{locking}->full_verify_lock( 'process', $lock_args ) if $lock_value;
    $lock_value = $s->{locking}->get_current_lock( 'process', $lock_args );
    if ($lock_value)
    {
        print "Process $process_zname ($process_id) is already locked, cannot test: $lock_value\n";
        exit(1);
    }

    # start the run file so children now to keep running
    write_file( $run_file, $$ );

    # fork into desired number of 'users'
    my @child_pids = ();
    my $count      = $s->get_arg('users');
    foreach my $i ( 1 .. $count )
    {
        my $pid = fork();
        if ($pid)
        {
            push( @child_pids, $pid );
        }
        elsif ( $pid == 0 )
        {
            user_attempt( $process_zname, $process_id, $lock_args );
            exit(0);
        }
        else
        {
            die "Unable to fork\n";
        }
    }
    print "Started 'users' " . join( ', ', @child_pids ) . "\n";

    my $attempts = $s->get_arg('attempts');
    foreach my $attempt ( 1 .. $attempts )
    {
        print "--\nAttempt $attempt\n";
        attempt( \@child_pids, $lock_args );
    }

    # once done clear the run file to stop children
    print "--\nWaiting for 'users' to stop\n";
    unlink($run_file);
    foreach my $child_pid (@child_pids)
    {
        waitpid( $child_pid, 0 );
    }
    print "Done\n";
}

#################### subroutine header begin ####################

=head2 attempt() 

 Usage     : attempt();
 Purpose   : Runs an attempt
 Returns   : nothing
 Argument  : nothing
 Throws    : nothing
 Comment   : 


See Also   :

=cut

#################### subroutine header end ###################

sub attempt
{
    my $child_pids = shift;
    my $lock_args  = shift;

    # setup wait file so all processes go at the same time
    write_file( $wait_file, $$ );

    # setup files to set all children attempting
    map { write_file( "$attempt_file.$_", $$ ); } @{$child_pids};

    # now clear wait file so they all start going
    unlink($wait_file);

    # wait for all the attempt files to go
    map {
        while ( -f "$attempt_file.$_" ) { sleep(0.001); }
    } @{$child_pids};

    # lookup lock PID
    unless ( -f $lock_file )
    {
        print "Locking test failed - no 'user' got a lock\n";
        return;
    }
    my $lock_pid = read_file($lock_file) || '';
    chomp($lock_pid);
    unlink($lock_file);

    # check we now have a lock
    my $expected_pid_value  = 'ZZPID' . hostname() . ',' . $lock_pid;
    my $expected_lock_value = "${expected_pid_value}:::${expected_pid_value}";
    my $actual_lock_value   = $s->{locking}->get_current_lock( 'process', $lock_args );
    if ( $expected_lock_value && $actual_lock_value && $expected_lock_value eq $actual_lock_value )
    {
        print "Locking test passed!\n";
    }
    else
    {
        print "Locking test failed - expected=$expected_lock_value, actual=$actual_lock_value\n";
    }

    # unlock it now
    $s->{locking}->clear_lock( 'process', $lock_args );
}

#################### subroutine header begin ####################

=head2 user_attempt 

 Usage     : user_attempt();
 Purpose   : Ran by each user in attempt to get the locks
 Returns   : nothing
 Argument  : nothing
 Throws    : nothing
 Comment   : 


See Also   :

=cut

#################### subroutine header end ###################

sub user_attempt
{
    my $process_zname     = shift;
    my $process_id        = shift;
    my $user_attempt_file = "$attempt_file.$$";

    # loop until run file is gone
    while ( -f $run_file )
    {
        while ( !-f $user_attempt_file && -f $run_file )
        {
            sleep(0.01);
        }

        # check now that run file wasn't removed while we were waiting above
        if ( !-f $run_file )
        {
            last;
        }

        # wait for the wait file to disapper, so we all go at the same time
        while ( -f $wait_file )
        {
            sleep(0.000001);
        }

        # child needs to get the lock
        my $got_lock = $s->lock_process( $process_zname, $process_id );
        my $msg = '';
        if ($got_lock)
        {
            # wait a little bit before writing to the lock file
            sleep 1;
            write_file( $lock_file, $$ );
            $msg = 'Got lock';
        }
        else
        {
            $msg = $s->lock_process_fail_message( $process_zname, $process_id );
        }
        print "User $$ - $msg\n";

        # once done clear the attempt file to wait and clear down caches
        unlink($user_attempt_file);
        $s->{locking}->clear_caches();
    }

    print "User $$ - stopped\n";
    exit(0);
}

#################### subroutine header begin ####################

=head2 get_process_id 

 Usage     : get_process_id();
 Purpose   : Gets the process to test locking on
 Returns   : process id
 Argument  : nothing
 Throws    : nothing
 Comment   : 


See Also   :

=cut

#################### subroutine header end ###################

sub get_process_id
{
    my $pid = $s->get_arg('process_id');
    return $pid if $pid;

    # if there is no process specified, create one
    my $process = Zymonic::Process->new(
        parent  => $s,
        zname   => $s->get_arg('process'),
        ident   => '',
        config  => $s->{config},
        session => $s->{session},
        DB      => $s->{DB},
        auth    => $s->{auth},
    );
    my $pid = $process->{process_id};

    # then delete it after we got the pid
    $process->delete();

    print "Created Process ID $pid\n";
    return $pid;
}