#!/usr/bin/perl

# ############################################################## #
# 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.52';

my @inc = (); # You can list custom includes here

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

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

my (%settings, %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).
	#
);

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'}++ }
	elsif ($opt =~ /^([+\-])o/) {
		my $arg = shift @ARGV;
		complain($opt, 2) unless defined $arg;
		if ($1 eq '+') { $settings{$_} = 0 for split ',', $arg }
		elsif ($arg =~ s/^(\w+)=//) { $settings{$1} = $arg }
		else { $settings{$_} = 1 for split ',', $arg }
	}
	# default
	elsif ($opt =~ s/^--([\w-]+)(?:=['"]?(.*)['"]?)?/$1/) {
		if (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) }
}

if ($args{help} || $args{usage}) { # pre-emptive #1
	print (<DATA>);
	exit 0;
}

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

my $cwd = cwd;

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

# parse includes
push @inc, split /\,/, $args{inc};

$0 =~ s!(.*/)!!;
if (defined $1) {
	$Zoidberg::_base_dir = $1;
	push @inc, "$1/lib" if -d "$1/lib";
}
else { $Zoidberg::_base_dir = '' }

for (grep @inc, $Zoidberg::_base_dir) {
	next if m!^/!;
	$_ = defined($_) ? "$cwd/$_" : $cwd
}

unshift @INC, @inc;

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

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

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

$settings{rcfiles} = $args{rcfile} if defined $args{rcfile};
$settings{$_} = [ split /:/, $settings{$_} ]
	for grep {defined $settings{$_}} qw/data_dirs rcfiles/;
$settings{rcfiles} = [] if $args{norc};
for (qw/verbose debug login/) {
	$settings{$_} = $args{$_} unless defined $settings{$_};
}

if ($args{config}) { # pre-emptive #3
	%settings = (%Zoidberg::_settings, %settings);
	while ( my ($k,$v) = each %settings) {
		next unless defined $v;
		print $k, ' = ', ref($v) ? join(', ', @$v) : $v, "\n"
	}
	exit 0;
}

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

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 (!@ARGV && !$exec_string && !$args{stdin}) { 
	$interact = (-t STDIN) && (-t STDOUT); 
}
else { $interact = 0; }

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

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

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

$cube->source($_) for @ARGV;

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;

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__
