lib/Forks/Super/Config.pm

#
# Forks::Super::Config package - determines what features and
#         modules are available on the current system
#         at run-time.
#
# Some useful system info is expensive to compute so it is
# determined at build time and put into Forks/Super/SysInfo.pm
#


package Forks::Super::Config;
use Forks::Super::Debug qw(debug);
use Forks::Super::SysInfo;
use Carp;
use Exporter;
use strict;
use warnings;

our @ISA = qw(Exporter);
our @EXPORT_OK = qw(CONFIG CONFIG_module);
our %EXPORT_TAGS = (all => \@EXPORT_OK);
our $VERSION = '0.64';

our (%CONFIG, $IS_TEST, $IS_TEST_CONFIG, %SIGNO, $CONFIG_FILE);


sub init {

    %CONFIG = ();
    $CONFIG{filehandles} = 1;

    $IS_TEST = 0;
    $IS_TEST_CONFIG = 0;

    if ($ENV{NO_WIN32_API}) {
	$CONFIG{'Win32::API'} = 0;
    }

    use Config;
    my $i = 0;
    if (defined $Config::Config{'sig_name'}) {
	%SIGNO = map { $_ => $i++ } split / /, $Config::Config{'sig_name'};
    }

    if (defined $ENV{FORKS_SUPER_CONFIG}) {
	my @cfg_spec = split /,/, $ENV{FORKS_SUPER_CONFIG};
	foreach my $spec (@cfg_spec) {
	    if ($spec =~ s/^!//) {
		$CONFIG{$spec} = 0;
	    } elsif ($spec =~ s/^\?//) {
		delete $CONFIG{$spec};
		CONFIG($spec);
	    } else {
		$CONFIG{$spec} = 1;
	    }
	}
    }
    return;
}

sub init_child {
    untie $CONFIG{'filehandles'};
    untie %CONFIG;
#   unconfig('filehandles');
    return;
}

sub unconfig {
    my $module = shift;
    $CONFIG{$module} = 0;
    return 0;
}

sub config {
    my $module = shift;
    $CONFIG{$module} = 1;
    return 1;
}

sub configif {
    my $module = shift;
    return $CONFIG{$module} if defined $CONFIG{$module};
    return config($module);
}

sub deconfig {
    my $module = shift;
    return delete $CONFIG{$module};
}

#
# try to import some modules, with the expectation that the module
# might not be available.
#
# Hmmmm. We often run this subroutine from the children, which could mean
# we have to run it for every child.
#
sub CONFIG {
    my ($module, $warn, @settings) = @_;
    if (defined $CONFIG{$module}) {
	return $CONFIG{$module};
    }

    if (substr($module,0,1) eq '/') {
	return $CONFIG{$module} = CONFIG_external_program($module);
    } elsif ($module eq 'filehandles') {
	return $CONFIG{$module} = 1; # available by default
    } else {
	return $CONFIG{$module} =
	    CONFIG_module($module,$warn,@settings);
    }
}

sub CONFIG_module {
    my ($module,$warn, @settings) = @_;
    if (defined $CONFIG{$module}) {
	return $CONFIG{$module};
    }
    my $zz = eval " require $module ";     ## no critic (StringyEval)
    if ($@) {
	carp 'Forks::Super::CONFIG: ',
	    "Module $module could not be loaded: $@\n" if $warn;
	return 0;
    }

    if (@settings) {
	$zz = eval " $module->import(\@settings) ";  ## no critic (StringyEval)
	if ($@ && $warn) {
	    carp 'Forks::Super::CONFIG: Module ',
	        "$module was loaded but could not import with settings [",
 	        join (',', @settings), "]\n";
	}
    }

    if ($IS_TEST_CONFIG) {
	my $v = eval "\$$module" . '::VERSION';       ## no critic (StringyEval)
	if (defined $v) {
	    print STDERR "[$module enabled (v$v)]\n";
	} else {
	    print STDERR "[$module enabled]\n";
	}
    }
    return 1;
}

sub CONFIG_external_program {
    my ($external_program) = @_;
    if (defined $CONFIG{$external_program}) {
	return $CONFIG{$external_program};
    }

    if (-x $external_program) {
	if ($IS_TEST_CONFIG) {
	    print STDERR "CONFIG\{$external_program\} enabled\n";
	}
	return $external_program;
    }

    my $xprogram = $external_program;
    $xprogram =~ s{^/}{};
    if (-w '/dev/null') {
	my $which = qx(which $xprogram 2>/dev/null); ## no critic (Backtick)
	$which =~ s{\s+$}{};
	if ($which && -x $which) {
	    if ($IS_TEST_CONFIG) {
		print STDERR "CONFIG\{$external_program\} enabled\n";
	    }
	    return $CONFIG{$external_program} = $CONFIG{$which} = $which;
	}
    }

    # poor man's which
    my @path1 = split /:/, $ENV{PATH};
    my @path2 = split /;/, $ENV{PATH};
    foreach my $path (@path1, @path2, '.') {
	if (-x "$path/$xprogram") {
	    if ($IS_TEST_CONFIG) {
		print STDERR "CONFIG\{$external_program\} enabled\n";
	    }
	    return $CONFIG{$external_program} = "$path/$xprogram";
	}
    }
    return 0;
}

sub load_config_file {
    my $file = shift || ($CONFIG_FILE ||= "./.forkssuperrc");
    $CONFIG_FILE ||= $file;
    if (open my $fh, '<', $file) {
	while (<$fh>) {
	    next if /^\s*[#;-]/;
	    chomp;
	    my ($key,$val) = split /\s*=\s*/, $_, 2;
	    $key = uc $key;
	    $key =~ s/[-. ]/_/g;

	    # DEBUG, MAX_PROC, MAX_LOAD, ON_BUSY, 
	    # IPC_DIR/FH_DIR, CHILD_FORK_OK,
	    # QUEUE_INTERRUPT, QUEUE_MONITOR_FREQ 
	    if ($key eq 'DEBUG') {
		$Forks::Super::DEBUG = $val || 0;
	    } elsif ($key eq 'MAX_PROC') {
		$Forks::Super::MAX_PROC =
		    $val || $Forks::Super::DEFAULT_MAX_PROC;
	    } elsif ($key eq 'MAX_LOAD') {
		$Forks::Super::MAX_LOAD = $val;
	    } elsif ($key eq 'ON_BUSY') {
		$Forks::Super::ON_BUSY = lc $val;
	    } elsif ($key eq 'IPC_DIR' || $key eq 'FH_DIR') {
		if (-d $val || mkdir($val, 0777)) {
		    Forks::Super::Job::Ipc::set_ipc_dir($val, 1);
		} else {
		    carp "Forks::Super::Config: ",
		    	"cannot use '$val' as IPC directory: $!\n";
		}
	    } elsif ($key eq 'CHILD_FORK_OK') {
		$Forks::Super::CHILD_FORK_OK = $val || 0;
	    } elsif ($key eq 'QUEUE_INTERRUPT') {
		$Forks::Super::QUEUE_INTERRUPT = $val;
	    } elsif ($key eq 'QUEUE_MONITOR_FREQ') {
		$Forks::Super::Queue::QUEUE_MONITOR_FREQ = $val || 30;
	    } elsif ($key eq 'QUEUE_MONITOR_LIFESPAN') {
		$Forks::Super::Queue::QUEUE_MONITOR_LIFESPAN = $val;
	    } elsif ($key eq 'QUEUE_DEBUG') {
		$Forks::Super::Queue::QUEUE_DEBUG = $val;
	    } elsif ($key eq 'SIG_DEBUG') {
		$Forks::Super::Sigchld::SIG_DEBUG = $val;
	    } elsif ($key eq 'DUMP_SIG') {
		Forks::Super::Debug::enable_dump($val);
	    } elsif ($key eq 'SYNC_YIELD_DURATION') {
		$Forks::Super::Sync::IPCSempahore::NO_WAIT_YIELD_DURATION
		    = $val/1000;
		$Forks::Super::Sync::Win32::NO_WAIT_YIELD_DURATION = $val;
		$Forks::Super::Sync::Win32Mutex::NO_WAIT_YIELD_DURATION = $val;
	    } elsif ($key eq 'TIE_HANDLES') {
		$Forks::Super::Job::Ipc::USE_TIE_FH = $val =~ /all|1|file|fh/i;
		$Forks::Super::Job::Ipc::USE_TIE_SH
		    = $val =~ /all|1|socket|sh/i;
		$Forks::Super::Job::Ipc::USE_TIE_PH = $val =~ /all|1|pipe|ph/i;
	    } elsif ($key eq 'DEFAULT_PAUSE') {
		$Forks::Super::Util::DEFAULT_PAUSE = $val;
	    } elsif ($key eq 'DEFAULT_PAUSE_IO') {
		$Forks::Super::Util::DEFAULT_PAUSE_IO = $val;
	    } elsif ($key eq 'SOCKET_READ_TIMEOUT') {
		$Forks::Super::SOCKET_READ_TIMEOUT = $val;
	    } else {
		carp "Forks::Super::Config: ",
			"Unknown configuration parameter '$key'. Ignoring\n";
	    }
	}
    } else {
	carp "failed to open Forks::Super config file '$file': $!";
    }
    return;
}

my @config_sig = ();
my $last_sig;

sub enable_signal_config {
    use Signals::XSIG;

    my $sig = _resolve_signum(shift);
    if (!$sig) {
	delete $XSIG{$_}[1] for @config_sig;
	@config_sig = ();
print STDERR "Disabled signal-based dynamic configuration\n";	
	return;
    }
    @config_sig = ();
    for my $i (0 .. 6) {
	push @config_sig, _resolve_signame($sig+$i);
    }

    $XSIG{$config_sig[0]}[1] = sub {
	$DB::single = 1;
	$CONFIG_FILE ||= "./.forkssuperrc";
	print STDERR qq[
Dynamic configuration signals:
  kill -$config_sig[0],$$    \tthis help message
  kill -$config_sig[1],$$    \treload setings from config file '$CONFIG_FILE'
  kill -$config_sig[2],$$    \tincrement \$Forks::Super::MAX_PROC
  kill -$config_sig[3],$$    \tderecment \$Forks::Super::MAX_PROC
  kill -$config_sig[4],$$    \tdump active process information
  kill -$config_sig[5],$$    \tdump active and completed process information
  kill -$config_sig[6],$$    \tchange \$Forks::Super::ON_BUSY
];
    };
    $XSIG{$config_sig[1]}[1] = sub {
	$DB::single = 1;
	print STDERR "Reloading Forks::Super config file\n";
	load_config_file(); 
    };
    $XSIG{$config_sig[2]}[1] = sub { 
	$DB::single = 1;
	$Forks::Super::MAX_PROC++; 
	print STDERR "MAX_PROC changed to $Forks::Super::MAX_PROC\n";
    };
    $XSIG{$config_sig[3]}[1] = sub {
	$DB::single = 1;
	$Forks::Super::MAX_PROC--; 
	$Forks::Super::MAX_PROC ||= 1;
	print STDERR "MAX_PROC changed to $Forks::Super::MAX_PROC\n";
    };
    $XSIG{$config_sig[4]}[1] = sub { Forks::Super::Debug::parent_dump(0); };
    $XSIG{$config_sig[5]}[1] = sub { Forks::Super::Debug::parent_dump(1); };
    $XSIG{$config_sig[6]}[1] = sub {
	if ($Forks::Super::ON_BUSY eq 'block') {
	    $Forks::Super::ON_BUSY = 'fail';
	} elsif ($Forks::Super::ON_BUSY eq 'fail') {
	    $Forks::Super::ON_BUSY = 'queue';
	} elsif ($Forks::Super::ON_BUSY eq 'queue') {
	    $Forks::Super::ON_BUSY = 'block';
	}
	print STDERR "ON_BUSY changed to $Forks::Super::ON_BUSY\n";
    }
}

sub _resolve_signum {
    use Config;
    my $sig = shift;
    return $sig if $sig =~ /\d/ && $sig !~ /\D/;
    $sig =~ s/^SIG//i;
    my @names = split ' ', $Config{sig_name};
    my @nums = split ' ', $Config{sig_num};
    for my $i (0..$#names) {
	if (uc $sig eq uc $names[$i]) {
	    return $nums[$i];
	}
    }
    return;
}

sub _resolve_signame {
    my $sig = shift;
    return $sig if $sig =~ /\D/;
    my @names = split ' ', $Config{sig_name};
    my @nums = split ' ', $Config{sig_num};
    for my $i (0..$#names) {
	if ($sig == $nums[$i]) {
	    return $names[$i];
	}
    }
    return;
}

1;
	Global
`s`	Focus search bar
`?`	Bring up this help dialog
	GitHub
`g` `p`	Go to pull requests
`g` `i`	go to github issues (only if github is preferred repository)
	POD
`g` `a`	Go to author
`g` `c`	Go to changes
`g` `i`	Go to issues
`g` `d`	Go to dist
`g` `r`	Go to repository/SCM
`g` `s`	Go to source
`g` `b`	Go to file browse
	Search terms
module: (e.g. module:Plugin)
distribution: (e.g. distribution:Dancer auth)
author: (e.g. author:SONGMU Redis)
version: (e.g. version:1.00)