view release on metacpan or  search on metacpan

lib/Benchmark/Thread/Size.pm  view on Meta::CPAN

package Benchmark::Thread::Size;

# Make sure we have version info for this module
# Make sure we do everything by the book from now on

$VERSION = '0.10';
use strict;
# Initialize the modules to be loaded string
# While compiling
#  Set to use forks if forks.pm loaded, otherwise threads
#  Set to use forks::shared if forks::shared.pm loaded, else threads::shared

my $modules;
BEGIN {
    if ($forks::threads) {
        $modules = 'use forks;';
        $modules .= 'use forks::shared;'
         if $threads::shared::threads_shared;
        $SIG{'CHLD'} = 'IGNORE';
    } else {
        $modules = 'use threads ();';
        $modules .= 'use threads::shared ();'
         if $threads::shared::threads_shared;
    }
} #BEGIN

# Satisfy -require-

1;

#---------------------------------------------------------------------------
#  IN: 1 class (ignored)
#      2..N parameter hash

sub import {

# Lose the class
# Initialize the parameters hash
# Initialize the number of times setting
# Initialize the oneliner flag
# Initialize the reference only flag
# Initialize the key list

    shift;
    my %param;
    my $times = '';
    my $oneliner = (join( ' ',caller() ) eq 'main - 0');
    my $refonly = $oneliner;
    my @key;

# While there are keys to be obtained
#  If it is the times setting
#   Set that
#  Elseif we want the reference only
#   Set reference only flag
#  Else (key + code setting)
#   Associate the code with this key
#   Keep the key for the right order
# Return now unless there is something to do

    while (my $key = shift) {
        if ($key eq 'times') {
            $times = shift;
        } elsif ($key eq 'refonly') {
            $refonly = 1;
        } else {
            $param{$key} = shift;
            push( @key,$key );
        }
    }
    return unless $refonly or keys %param;

# Initialize the test scripts

    _ramthread(); _ramthread1();

# For all of the pieces of code to check
#  Create the file or die
#  Write the code there
#  Close the handle or die

    while (my($file,$code) = each %param) {
        open( my $handle,'>',$file ) or die "Could not write $file: $!\n";
        print $handle $code;
        close( $handle ) or die "Could not close $file: $!\n";
    }

# Execute the test script
# Remove the test scripts from the face of the earth
# Exit now if it was a one-liner

    system( "$^X -w ramthread $times @key" );
#    unlink( qw(ramthread ramthread1),@key );
    exit if $oneliner;
} #import

#---------------------------------------------------------------------------

# internal subroutines

#---------------------------------------------------------------------------

sub _ramthread {

# Attempt to create the main test script
# Write out the script