view release on metacpan or  search on metacpan

bin/zoid  view on Meta::CPAN

if (defined $1) {
	my $dir = $1;
	$dir = "$cwd/$_" unless $dir =~ m!^/!;
	$Zoidberg::_base_dir = $dir;
	unshift @INC, "$dir/lib" if -d "$dir/lib";
}
else { $Zoidberg::_base_dir = '' }

# ########### #
# Get Options #
# ########### #

eval q#use Zoidberg::Utils::GetOpt 'getopt'; 1# or die $@;

my ($opts, $args) = eval { getopt( '
	help,h,usage,u version,V config,C
	exec,e@ command,c@ stdin,s
	interactive,i login,l plug,p@
	debug,-D,D verbose,v include,-I@
	-I* -D* +o@ -o@ -m* -M*
	@', @ARGV ) } ;
if ($@) { # renice error message
	print STDERR ref($@) ? $@->stringify(format => 'gnu') : $@;
	exit 1;
}

# TODO -q
#     Quiet (usually without argument). Suppress normal result or 
#     diagnostic output. This is very common. Examples: ci(1), co(1), make(1).
# TODO find switch to set mode / include plugins

if ($$opts{help}) { # pre-emptive #1
	pod2usage(
		-verbose => 1,
		-exitval => 0,
	);
}

if ($$opts{_opts}) { # special switches
	for (grep /^-[IDMm]./, @{$$opts{_opts}}) {
		if ( s/^-I// ) { push @inc, $_ }
		elsif ( s/^-D// ) {
			no strict 'refs';
			${$_.'::DEBUG'}++;
		}
		else {
			my $import = /^-M/ ? 1 : 0 ;
			my $use =
				/-[Mm](\S+)=(.*)/ ? "use $1 split(/,/,q{$2}); " :
				s/^-M//           ? "use $_; "  : "use $_ (); " ;
			$use =~ s/^use -/no /;
			$$opts{use} .= $use;
		}
	}
}

# ############### #
# set environment #
# ############### #

my @user_info = getpwuid($>);
$ENV{USER} ||= $user_info[0];
$ENV{HOME} ||= $user_info[7];
$ENV{ZOID} = $0; # _Don't_ change this to ENV{SHELL} !

# fix environment
$$opts{login} = 1 unless $ENV{PWD}; # FIXME a better check ?
if ($$opts{login}) {
	$ENV{LOGNAME} = $ENV{USER} = $user_info[0];
	$ENV{HOME} = $user_info[7];
	$ENV{PWD} = $ENV{HOME} || '/';
	chdir $ENV{PWD} ;
}
else { $ENV{PWD} = $cwd }

# ############# #
# Load includes #
# ############# #

# parse includes
unshift @INC,
	map { m!^/! ? $_ : "$cwd/$_" }
	grep s/^-I//, @{ $$opts{_opts} } if $$opts{_opts};

# load Zoidberg.pm
eval q#require Zoidberg# or die $@;

if ($$opts{version}) { # pre-emptive #2
	print "zoid $VERSION\n$Zoidberg::LONG_VERSION\n";
	exit 0;
}

# ############## #
# Parse settings #
# ############## #

my %settings;

if ($$opts{'-o'}) {
	for ( @{$$opts{'-o'}} ) {
		my ($opt, $arg) = split '=', $_, 2;
		$settings{$opt} = defined($arg) ? $arg : 1;
	}
}
if ($$opts{'+o'}) {
	for ( @{$$opts{'+o'}} ) {
		my ($opt, $arg) = split '=', $_, 2;
		$settings{$opt} = defined($arg) ? $arg : 0;
	}
}

for (qw/data_dirs rcfiles/) { # arrays
	$settings{$_} = [ split /:/, $settings{$_} ]
		if defined $settings{$_} and ! ref $settings{$_};
}

for (qw/verbose debug login/) { # options
	$settings{$_} = $$opts{$_} if defined $$opts{$_};
}

if ($$opts{config}) { # pre-emptive #3