#!perl
#
# threading.pl
#
#   Time thread operations under various constraints.
#
#   The program flow is kind of weird.  Run this program from the
#   command line and it runs itself via system() a number of times
#   to run all of the tests.  Avoids having a separate script file
#   to run the various tests, but it may be a bit confusing.
#

use     strict;
use     threads;
use     threads::shared;

use     Getopt::Std;
use     Time::HiRes qw(sleep time);

our     %arg;
our     $data;
our     $dataCount;
our     $indent  = '';
our     $summary = 'threading.txt';

###########################################################################
sub loadPackage #
# Purposely picked larger packages (by raw disk space of .pm files).
#
    {
    require CGI;
    require Config;
    require CPAN;
    require POSIX;
    require Storable;
    require Switch;
    }

###########################################################################
sub makeData    # [ $depth ]
# Create a bunch of data.
#   Amount of data can be exponentially varied by increasing depth.
#   Share data objects if specified in command argument.
#
    {
    my  $depth = shift || 0;
    my  $data = { };
    my  $done = $depth >= $arg{'d'};
    
    share($data) if $arg{'s'};
    $dataCount++;
    $depth++;
    
    for my $alpha ('a' .. 'f')
        {
        $data->{$alpha} = $done ? uc($alpha) : makeData($depth);
        }
    
    $data
    }

###########################################################################
sub master  #
# Master program invocation,
#   run all tests in sequence,
#   avoids need for separate non-portable script file:
#
# Assumption:
#   Using system() doesn't invalidate the tests!!!
#
    {
    # Clear the results file:
    unlink $summary if -e $summary;
    
    # Plain test:
    system "perl threading.pl -x";
    
    # Package load test:
    system "perl threading.pl -xp";
    
    my  $depth = $arg{'d'} || 5;

    # Plain (unshared) data test:
    for my $d (1..$depth)
        {
        system "perl threading.pl -xd $d";
        }
    
    # Plain shared data test:
    for my $d (1..$depth)
        {
        system "perl threading.pl -xsd $d";
        }
    
    return unless $arg{'v'};
    
    print "Summary:\n";
        
    if (open(SUMMARY, "<$summary"))
        {
        # Dump results we've collected to the user's screen:
        while (<SUMMARY>)
            {
            print
            }
        
        close SUMMARY
        }
    }

###########################################################################
sub thrdFunc    # $data
# Iterate over data tree.
#   Makes thread non-trivial (and why is this important)?
#   Also checks access time of data with and without sharing it.
#
    {
    my  $count = 0;
    my  $data  = shift;
    
    if ('HASH' eq ref $data)
        {
        map {
            $count += thrdFunc($data->{$_})
            }   keys %$data
        }
    
    elsif (defined $data)
        {
        $count++
        }
    
    $count
    }

###########################################################################
sub usage   #
#
    {
    print STDERR <<USAGE
usage:  threading.pl { <flag> }
        runs various tests on threading mechanism
        
        the following flags are effective when
        using program to run all tests:
        
    -d  <depth>     amount of data created during testing
                    depth has exponential effect, defaults to 5
    -h              show this help data
    -v              show results of all tests
    
        the following flags are used internally,
        or when invoking individual tests:
   
    -d  <depth>     amount of data created during testing
                    depth has exponential affect ( ** 16 )
                    without this flag, data is not created
    -p              load big packages test
    -s              make test data shared
    -x              individual test mode (slave mode)
    
USAGE
    }

###########################################################################
###########################################################################
#
# Main program:
#

my  $progTime = time;
my  $mode     = '';

getopts('d:hpsvx', \%arg);

$mode .= ' packages'        if     $arg{'p'};
$mode .= ' shared'          if     $arg{'s'};
$mode .= " data=$arg{'d'}"  if     $arg{'d'};
$mode  = ' simple'          unless $mode;

usage,
exit 0
    if $arg{'h'};

print "${indent}threading.pl$mode\n";

master,         # Master program invocation,
exit 0          #   everything already done
    unless $arg{'x'};

$data = makeData
    if $arg{'d'};

loadPackage
    if $arg{'p'};

$indent .= ' ';

###########################################################################
# Do the test:

my  $thrdTime = time;
my  $thread   = new threads(\&thrdFunc, $data);
my  $thrdRnng = time;
my  $thrdStrt = $thrdRnng - $thrdTime;

$thread->join();

my  $thrdJoin = time - $thrdRnng;

###########################################################################
# Report results:

$progTime  = time - $progTime;

printf "${indent}program duration:  %.6f seconds \n", $progTime;
printf "${indent}thread  startup:   %.6f seconds \n", $thrdStrt;
printf "${indent}thread  join:      %.6f seconds \n", $thrdJoin;
print  "\n";

my  $first = ! -e $summary;

if (open SUMMARY, ">>$summary")
    {
    print  SUMMARY "program, thrd start, thrd join, data hashes, test\n"
        if $first;
    
    printf SUMMARY "%09.6f, %09.6f, %09.6f, %06i,$mode\n",
                   $progTime, $thrdStrt, $thrdJoin, $dataCount;
    close  SUMMARY;
    }