
# ############################################################## #
# Copyright (c) 2002 Jaap G Karssenberg. All rights reserved.    #
# This program is free software; you can redistribute it and/or  #
# modify it under the same terms as Perl itself.                 #
#                                                                #
# This script is a frontend to the Zoidberg module, it starts    #
# the Zoidberg perl shell.                                       #
#                                                                #
# mailto:pardus@cpan.org                                         #
# http://zoidberg.sourceforge.net                                #
# ############################################################## #

use strict;
use Cwd qw/cwd/;
our $VERSION = '0.41';

# ############### #
# 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} !

# ########## #
# Parse ARGV #
# ########## #
my %args = ();
my %opts = (
	# name	=> [char, expect_arg_bit ]
	'help'		=> ['h'],
	'usage'		=> ['u'],
	'exec'		=> ['e', 1],
	'command'	=> ['c', 1],
	'version'	=> ['V'],
	'config'	=> ['C'],
	'interactive'	=> ['i'],
	'login'		=> ['l'],
	'stdin'		=> ['s'],
	'rcfile'	=> ['r', 1],
	'norc'		=> [undef],
	'debug'		=> ['D'],
	'verbose'	=> ['v'],
	# TODO -M use module etc.
	# -q
	#     Quiet (usually without argument). Suppress normal result or 
	#     diagnostic output. This is very common. Examples: ci(1), co(1), make(1).
	#
);
my %conf;
my @conf_opts = qw/data-dirs rcfiles cache-dir/; 
	# FIXME undocumented options -- see Zoidberg::Config

while ((@ARGV) && ($ARGV[0] =~ /^-/)) {
	my $opt = shift @ARGV;
	if ($opt =~ /^--?$/) { last; }
	# specials
	elsif ($opt =~ s/^-I//) { $args{inc} .= ($args{inc} ? ',' : '').$opt }
	elsif ($opt =~ /^-D(.+)/) { no strict 'refs'; ${$1.'::DEBUG'}++ }
	# default
	elsif ($opt =~ s/^--([\w-]+)(?:=['"]?(.*)['"]?)?/$1/) {
		if (grep {$opt eq $_} @conf_opts) {
			my $arg = $2 || shift @ARGV;
			complain('--'.$opt, 2) unless defined $arg;
			$opt =~ s/-/_/g;
			$conf{$opt} .= ( $conf{$opt} ? ':' : '' ) . $arg;
		}
		elsif (exists $opts{$opt}) {
			if ($opts{$opt}[1]) { 
				my $arg = $2 || shift @ARGV;
				complain('--'.$opt, 2) unless defined $arg;
				$args{$opt} .= ( $args{$opt} ? ' ' : '' ) . $arg;
			}
			else { $args{$opt}++; }
		}
		else { complain('--'.$opt) }
	}
	elsif ($opt =~ s/^-(?!-)//) {
		foreach my $o (split //, $opt) {
			my ($key) = grep { $opts{$_}[0] eq $o } keys %opts;
			unless ($key) { complain($o) }

			if ($opts{$key}[1]) { 
				my $arg = shift @ARGV;
				complain('-'.$o, 2) unless defined $arg;
				$args{$key} .= ( $args{$key} ? ' ' : '' ).$arg; # join with whitespace
			}
			else { $args{$key}++; }
		}
	}
	else { complain($opt) }
}

# parse includes
my $cwd = cwd;
my @inc = split /\,/, $args{inc};
$0 =~ m!(.*/)!;
$Zoidberg::Config::ScriptDir = $1;
push @inc, "$1/lib" if -d "$1/lib";
for (@inc, $Zoidberg::Config::ScriptDir) { $_ = "$cwd/$_" unless m!^/! }
unshift @INC, @inc;

# load some packages - force runtime eval to get includes right
for (qw/Zoidberg Zoidberg::Config Zoidberg::Utils/) {
	eval "require $_";
	die $@ if $@;
}
Zoidberg::Utils->import(':output');

$conf{rcfiles} = $args{rcfile} if $args{rcfile};
$Zoidberg::Config::settings{cache_dir} = $conf{cache_dir} if $conf{cache_dir};
for (qw/data_dirs rcfiles/) {
	next unless $conf{$_};
	$Zoidberg::Config::settings{$_} = [ split /:/, $conf{$_} ];
}
$Zoidberg::Config::settings{rcfiles} = [] if $args{norc};

if ($args{help} || $args{usage}) {
	print (<DATA>);
	exit 0;
}
elsif ($args{version}) {
	print "zoid $VERSION\n$Zoidberg::LONG_VERSION\n";
	exit 0;
}
elsif ($args{config}) {
	while ( my ($k,$v) = each %Zoidberg::Config::settings) {
		print $k, ' = ', ref($v) ? join(', ', @$v) : $v, "\n";
	}
	exit 0;
}

my $exec_string = $args{exec} || $args{command} || '';

# rest ARGV should be files
for (@ARGV) { complain($_, 3) unless -f $_ }

my $interact;
if ($args{interactive}) { $interact = 1; }
elsif (!$exec_string && !$args{stdin}) { $interact = (-t STDIN) && (-t STDOUT); }
else { $interact = 0; }
#print "debug: interact: $interact, interact_opt: $interact_opt, string: $exec_string\n";

# ################## #
# prepare for launch #
# ################## #

# check for login shell
$args{login} = 1 unless $ENV{PWD};
if ($args{login}) {
	$ENV{USER} = $user_info[0];
	$ENV{HOME} = $user_info[7];
	$ENV{PWD} = $ENV{HOME} || '/';
	chdir $ENV{PWD} ;
}

# ############## #
# AND Lift-off ! #
# ############## #

my $cube = Zoidberg->new( {
	settings => {
		login       => $args{login},
		interactive => $interact,
		output => {
			( $interact ? () : (
				message => 'mute',
				warning => 'mute',
			) ),
		},
		verbose => $args{verbose},
		debug   => $args{debug},
	}
} );

message( 
"--[ This is the Zoidberg shell ]--[ Version $Zoidberg::VERSION ]--
### This is a development version, consider it unstable" );

$cube->source( grep {-f $_} @{$cube->{settings}{rcfiles}}, @ARGV );

if ($exec_string) {
#	if ($args{command}) { $cube->{ipc}->do($exec_string) }
#	else { 
		$cube->shell_string($exec_string)
#	}
}

if ( $args{stdin} || -p STDIN || (!$interact && !$exec_string) ) {
	while (<STDIN>) { $cube->shell_string($_) }
	# FIXME do something like set nobuffer and let zoid read STDIN
	# then it can also pull from it
}

$cube->main_loop if $interact;

message("--[ CU ]--[ Please report all bugs ]--");

my $exit = $cube->round_up ? 1 : 0;

exit $exit;

# ############ #
# sub routines #
# ############ #

sub complain {
	my $opt = shift;
	my $m = shift || 1;
	
	my $bn = $0;
	$bn =~ s|^(.*/)*||;
	if ($m == 1) { print STDERR "$bn: unrecognized option '$opt'"; }
	elsif ($m == 2) { print STDERR "$bn: option '$opt' requires an argument"; }
	elsif ($m == 3) { print STDERR "$bn: $opt: No such file or directory\n"; }
	
	if ($m < 3) {print "\nTry '$bn --help' for more information.\n"}
	exit $m;	
}

# the usage message is inserted below on compile time
__DATA__
