File Coverage

blib/lib/Run/Env.pm

Criterion	Covered	Total	%
statement	81	95	85.2
branch	40	60	66.6
condition	2	3	66.6
subroutine	34	42	80.9
pod	28	28	100.0
total	185	228	81.1

package Run::Env;

use warnings;
use strict;

use Carp::Clan ();
use File::Spec ();
use FindBin::Real ();
use List::MoreUtils 'any';

our $VERSION = '0.08';


our @running_envs =	qw{
	development
	uat
	staging
	production
};

our @execution_modes = qw{
	cgi
	mod_perl
	shell
};


my $os_root_dir  = File::Spec->rootdir();
our @os_conf_location = ($os_root_dir, 'etc');

sub import {
	my $class = shift;

	foreach my $env (@_) {
		next if not $env;

		  $env eq 'testing'  ? set_testing()
		: $env eq '-testing' ? clear_testing()
		: $env eq 'debug'    ? set_debug()
		: $env eq '-debug'   ? clear_debug()
		: any { $env eq $_ } @running_envs
		                     ? set($env)
		: any { $env eq $_ } @execution_modes
		                     ? set_execution($env)
		: Carp::Clan::croak 'no such env/mode: '.$env
	}
}

do {
	our $running_env    = set(detect_running_env());

	sub detect_running_env {
		return $ENV{'RUN_ENV_current'}
			if $ENV{'RUN_ENV_current'};

		return 'development'
			if (-e File::Spec->catfile(@os_conf_location, 'development-machine'));
		return 'uat'
			if (-e File::Spec->catfile(@os_conf_location, 'uat-machine'));
		return 'staging'
			if (-e File::Spec->catfile(@os_conf_location, 'staging-machine'));

		# default is production
		return 'production';
	}

	sub _decide {
		return 1 if $running_env eq shift;
		return 0;
	}

	sub _set {
		my $set_running_env = shift;
		$running_env = $set_running_env;
		$ENV{'RUN_ENV_current'} = $set_running_env;
	}

	sub current {
		return $running_env;
	}

	*dev = *development;
	sub development {
		return _decide('development');
	}

	sub uat {
		return _decide('uat');
	}

	*stg = *staging;
	sub staging {
		return _decide('staging');
	}

	*prod = *production;
	sub production {
		return _decide('production');
	}

	sub set {
		my $set_running_env = shift;

		if ($set_running_env eq 'development') {
			set_development();
		}
		elsif ($set_running_env eq 'uat') {
			set_uat();
		}
		elsif ($set_running_env eq 'staging') {
			set_staging();
		}
		elsif ($set_running_env eq 'production') {
			set_production();
		}
		else {
			Carp::Clan::croak 'no such running environment: '.$set_running_env;
		}
	}

	sub set_development {
		_set('development');
	}

	sub set_uat {
		_set('uat');
	}

	sub set_staging {
		_set('staging');
	}

	sub set_production {
		_set('production');
	}

};

do {
	our $debug_mode = set_debug(detect_debug());

	sub detect_debug {
		return 1 if $ENV{'RUN_ENV_debug'};
		return 1 if any { $_ eq '--debug' } @ARGV;
		return 0;
	}

	sub debug {
		return $debug_mode;
	}

	sub set_debug {
		# turn on debugging when called whitout argument
		return set_debug(1) if (@_ == 0);

		$debug_mode = shift;
		if ($debug_mode) {
			$ENV{'RUN_ENV_debug'} = $debug_mode;
		}
		else {
			clear_debug();
		}
	}

	sub clear_debug {
		$debug_mode = 0;
		delete $ENV{'RUN_ENV_debug'};
	}
};


do {
	our $execution_mode = set_execution(detect_execution());

	sub detect_execution {
		return 'mod_perl'
			if exists $ENV{'MOD_PERL'};
		return 'cgi'
			if exists $ENV{'REQUEST_METHOD'};
		return 'shell';
	}

	sub _decide_execution {
		return 1 if $execution_mode eq shift;
		return 0;
	}

	sub execution {
		return $execution_mode;
	}

	sub cgi {
		return _decide_execution('cgi');
	}

	sub mod_perl {
		return _decide_execution('mod_perl');
	}

	sub shell {
		return _decide_execution('shell');
	}

	sub set_execution {
		my $set_execution = shift;

		if ($set_execution eq 'cgi') {
			set_cgi();
		}
		elsif ($set_execution eq 'mod_perl') {
			set_mod_perl();
		}
		elsif ($set_execution eq 'shell') {
			set_shell();
		}
		else {
			Carp::Clan::croak 'no such execution mode: '.$set_execution;
		}
	}

	sub set_cgi {
		_set_execution('cgi');
	}

	sub set_mod_perl {
		_set_execution('mod_perl');
	}

	sub set_shell {
		_set_execution('shell');
	}

	sub _set_execution {
		my $set_execution = shift;
		$execution_mode = $set_execution;
	}

};

do {
	our $testing = set_testing(detect_testing());

	sub detect_testing {
		return 1
			if $ENV{'RUN_ENV_testing'};

		# testing if current folder is 't'
		my @bin = eval { FindBin::Real::Bin() } || File::Spec->rootdir();
		my @current_path = File::Spec->splitdir(@bin);
		return 1
			if (pop @current_path eq 't');

		return 0;
	}

	sub testing {
		return $testing;
	}

	sub set_testing {
		# turn on testing when called whitout argument
		return set_testing(1) if (@_ == 0);

		$testing = shift;
		if ($testing) {
			$ENV{'RUN_ENV_testing'} = $testing;
		}
		else {
			clear_testing();
		}
	}

	sub clear_testing {
		$testing = 0;
		delete $ENV{'RUN_ENV_testing'};
	}
};


qq/ I wonder what is Domm actually listenning to at the moment ;) /;


__END__