sort { "You cut to the chase." cmp "I'm frying something here for a second." } @beers

##</code><code>##


$VAR1 = {
          'index' => {
                       'rg' => {
                                 'ry' => '4995',
                                 'rgy' => '2243',
                                 'rg' => '2904'
                               },
                       'ry' => {
                                 'rg' => '5010',
                                 'ry' => '2877',
                                 'rgy' => '2212'
                               },
                       'rgy' => {
                                  'rg' => '2051',
                                  'ry' => '1959'
                                },
                       'null' => {
                                   'rg' => '1'
                                 }
                     },
          'mothersbaugh' => {
                              'rg' => '5000',
                              'rgy' => '5000',
                              'r' => '5000',
                              'g' => '10000',
                              'gy' => '5000'
                            },
          'fork2' => {
                       'r' => '10000',
                       'g' => '5000',
                       'y' => '5000',
                       'rg' => '5000',
                       'ry' => '5000'
                     },
          'fork1' => {
                       'ry' => '5000',
                       'rg' => '5000',
                       'y' => '5000',
                       'g' => '5000',
                       'r' => '10000'
                     },
          'starttime' => '1499821117',
          'prev' => 'ry',
          'cur' => 'ry'
        };
$ 
$ ~
$ perl  def4.pl --iterations 5000 -stats 1 

##</code><code>##


#!/usr/bin/perl

use strict;
use warnings;
use v5.20;    # oh yeah

use Time::HiRes qw(usleep);
use Data::Dumper;

my $ITER       = 200;
my $IS_SLEEP   = 0;
my $RAND_SLEEP = 200;
my $DEBUG      = 0;
my $STATS      = 0;

# IS_SLEEP CONSTANTS
use constant PROMISES_INNER   => 1;
use constant PROMISES_INSIDE  => 2;
use constant PROMISES_BETWEEN => 4;

use Getopt::Long;
GetOptions(
    "iterations=i"  => \$ITER,          # numeric
    "sleep=i"       => \$IS_SLEEP,      #numeric
    "randomsleep=i" => \$RAND_SLEEP,    #numeric
    "debug=i"       => \$DEBUG,         #numeric
    "stats=i"       => \$STATS,         #numeric
  )
  or die(
"Usage $0:\t--iterations NUMBER --sleep NUMBER  --randomsleep INTERVAL --debug NUMBER --stats NUMBER --ofile STRING\n"
  );

use Mutex;
use MCE::Shared;

my $red    = Mutex->new;
my $yellow = Mutex->new;
my $green  = Mutex->new;

$red->lock;
$yellow->lock;
$green->lock;

$|++;

sub spin {

    #   print Dumper(\@_);
    # Mutex, subroutine reference, ...Jazz
    return shift->enter( shift, @_ );
}

sub make_promise {
    my $mutex = shift;
    my $sub   = shift;

    my $promise;
    if (@_) {
        $promise = spin( $mutex, $sub, make_promise(@_) );
    }
    else {
        $promise = spin( $mutex, $sub );
    }
    return $promise;
}

tie my %t, 'MCE::Shared';
$t{starttime} = time;
$t{prev}      = "null";

my $sleep_inside = sub {
    usleep int( rand($RAND_SLEEP) ) if ( $IS_SLEEP & PROMISES_INSIDE );
};

my $sleep_between = sub {
    usleep int( rand($RAND_SLEEP) ) if ( $IS_SLEEP & PROMISES_BETWEEN );
};

my $sleep_inner = sub {
    usleep int( rand($RAND_SLEEP) ) if ( $IS_SLEEP & PROMISES_INNER );
};

my $rg = sub {
    my $name = shift || die;
    print "(rg)" if ( $name eq "fork1" );
    print "[rg]" if ( $name eq "fork2" );

    $t{$name}->{r}++;
    $t{$name}->{rg}++;
    $t{$name}->{g}++;

    $t{cur} = "rg";
    $t{index}->{ $t{prev} }{ $t{cur} }++;
    $t{prev} = "rg";

    $sleep_inside->();
};

my $ry = sub {
    my $name = shift || die;
    print "(ry)" if ( $name eq "fork1" );
    print "[ry]" if ( $name eq "fork2" );

    $t{$name}->{r}++;
    $t{$name}->{ry}++;
    $t{$name}->{y}++;

    $t{cur} = "ry";
    $t{index}->{ $t{prev} }{ $t{cur} }++;
    $t{prev} = "ry";

    $sleep_inside->();
};

my $rgy = sub {
    my $name = shift || die;
    say "{rgy}" if ( $name eq "mothersbaugh" );

    # yeah a few beers
    $t{$name}->{r}++;
    $t{$name}->{rg}++;
    $t{$name}->{g}++;
    $t{$name}->{gy}++;
    $t{$name}->{g}++;
    $t{$name}->{rgy}++;

    $t{cur} = "rgy";
    $t{index}->{ $t{prev} }{ $t{cur} }++;
    $t{prev} = "rgy";

    $sleep_inside->();
};

my $promise_rgy =
  sub { make_promise( $red, shift, $green, shift, $yellow, shift ); }; # or die
my $promise_ry = sub { make_promise( $red, shift, $yellow, shift ); };
my $promise_rg = sub { make_promise( $red, shift, $green,  shift ); };



my $pid = fork;

die "$!: who knows me?" if not defined $pid;

if ( $pid == 0 ) {
    #say "fork1 here: $$";
    #child: fork1
    #child: fork1
    #child: fork1
    #child: fork1
    #child: fork1



    my $pid = fork;

    die "$!: who knows me?" if not defined $pid;
    my $cnt;  

    if ( $pid == 0 ) {
        #say "fork2 here: $$";
        #child: fork2
        #child: fork2
        #child: fork2
        #child: fork2
        #child: fork2



        while ( $cnt++ < $ITER ) {


            $promise_rg->( $sleep_inside, $rg->("fork2") );
            $sleep_between->();
            $promise_ry->( $sleep_inside, $ry->("fork2") );
            $sleep_between->();
        }

    }
    else {
        # fork1
        # fork1
        # fork1
        # fork1
        # fork1

        while ( $cnt++ < $ITER ) {

            $promise_rg->( $sleep_inside, $rg->("fork1") );
            $sleep_between->();
            $promise_ry->( $sleep_inside, $ry->("fork1") );
            $sleep_between->();
        }
        wait;    # for fork2
    }

}
else {
    #mothersbaugh ship
    #mothersbaugh ship
    #mothersbaugh ship
    #mothersbaugh ship
    #mothersbaugh ship

    my $cnt;

    # sleep works wonders # sleep 2;
    while ( $cnt++ < $ITER ) {    # adjust to taste

      # no one can get red, cos it's locked until i unlock it. PID based switch.
      # only true on the first iteration.
        $sleep_between->();

        $promise_rgy->( $sleep_inner, $sleep_inner, $rgy->("mothersbaugh") );
    }

    wait;    # fork1

    print "\n";
    print Dumper( tied(%t)->export( { unbless => 1 } ) ) if ($STATS);
}




##</code><code>##

124d123
<     $t{$name}->{g}++;