#!/usr/bin/perl
my $APPDIR = '';

##################################################################
# 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:j.g.karssenberg@student.utwente.nl                      #
# http://zoidberg.sourceforge.net                                #
##################################################################

use strict;
use vars qw/%ZoidConf/;

our $VERSION = '0.3b';

####################
#### Parse ARGV ####
####################
my %args = ();
my %opts = (
	# name	=> [char, expect_arg_bit ]
	'help'		=> ['h'],
	'usage'		=> ['u'],
	'exec'		=> ['e', 1],
	'command'	=> ['c', 1],
	'version'	=> ['V'],
	'list-conf'	=> ['l'],
	'interactive'	=> ['i'],
	'debug'		=> ['d'], # FIXME, use this switch to switch $DEBUG
	# 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).
	#
	#-v verbose (as opposed to -q)
);

while ((@ARGV) && ($ARGV[0] =~ /^-/)) {
	my $opt = shift @ARGV;
	if ($opt =~ /^--?$/) { last; }
	# specials
	elsif ($opt =~ s/^-I//) { $args{inc} .= ($args{inc} ? ',' : '').$opt; }
	# default
	elsif ($opt =~ s/^--([\w-]+)(?:=(.*))?/$1/) {
		unless ($opts{$opt}) { complain('--'.$opt) }
		if ($opts{$opt}[1]) { 
			my $arg = $2 || shift @ARGV || complain('--'.$opt, 2);
			$args{$opt} .= ( $args{$opt} ? ' ' : '' ).$arg; # join with whitespace
		}
		else { $args{$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('--'.$opt, 2);
				$args{$key} .= ( $args{$key} ? ' ' : '' ).$arg; # join with whitespace
			}
			else { $args{$key}++; }
		}
	}
	else { complain($opt) }
}

# parse includes
unshift @INC, $APPDIR.'/lib' if $APPDIR;
unshift @INC, split(/\,/, $args{inc}) if $args{inc}; 

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

if ($args{help} || $args{usage}) { 
	print (<DATA>);
	exit 0;
}
elsif ($args{version}) { 
	if ($VERSION) { print "zoid $VERSION\n" }
	print $Zoidberg::LONG_VERSION."\n";
	exit 0;
}
elsif ($args{'list-conf'}) { 
	Zoidberg::Config->output();
	exit 0;
}

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

# rest ARGV should be files
for (@ARGV) { 
	if (-f $_) { $exec_string .= ($exec_string ? ' ; ' : '').'_source '.$_; } # FIXME dit via api
	else { complain($_, 3); }
}

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

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

# copy skel
my ($dir, $prefix) = ($ZoidConf{config_dir}, $ZoidConf{prefix});
$dir =~ s/\/?$/\//;
unless (-e $dir) {
	dircopy($prefix.'/share/zoid/skel', $dir);
	for (qw/var lib cmd plugins/) {
		my $s_dir = $dir.$_;
		unless (-d $s_dir) { mkdir $s_dir }
	}
}

# set env
$ENV{USER} = $Zoidberg::Config::user_info[0];
$ENV{HOME} = $Zoidberg::Config::user_info[7];

# check for login shell
unless ($ENV{PWD}) {
	$ENV{PWD} = $ENV{HOME} || '/'; 
	$ENV{SHELL} = $0;
}

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

my $cube = Zoidberg->new;

unless ($interact) { $cube->silent } # FIXME -- this should be done internally - this api is wrong

$cube->init(interactive => $interact);
if ($exec_string) { 
#    if ($args{command}) {
#        $cube->{ipc}->do($exec_string);
#    }
#    else {
        $cube->do($exec_string)
#    }
}

if (-e $dir.'/.first_time' && $interact) {
#	$cube->print("## Type help to get on your feet", 'message'); # FIXME help is currently broken
	$cube->print("## Try typing \"->Buffer->probe\" if keybindings fail", 'message');
	unlink $dir.'/.first_time';
}

if (-p STDIN) {
	while (<STDIN>) { $cube->do($_) } 
	# FIXME more intel for this situation ?
	# built this in the api ? something like "parse_from_pipe()"
}

if ($interact) { $cube->main_loop }

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;	
}

sub dircopy {
	# dir from, dir to
	my ($from, $to) = @_;
	$from =~ s/\/?$/\//;
	$to =~ s/\/?$/\//;
	print "Copying $from to $to\n";
	unless (-e $to) { mkdir($to) || die "Could not create dir $to"; }
	opendir FROM, $from || die "Could not open dir $from";
	my @files = readdir FROM;
	closedir FROM;
	shift @files; #.
	shift @files; #..
	foreach my $file (grep {-f $from.$_} @files) {
		open IN, $from.$file || die "Could not open file ".$from.$file." to read";
		open OUT, '>'.$to.$file  || die "Could not open file to ".$to.$file." write";
		while (<IN>) { print OUT $_; }
		close OUT;
		close IN;
	}
	foreach my $dir (grep {(-d $from.$_)&&($_ ne 'CVS')} @files) {
		dircopy( $from.$dir, $to.$dir ); #recurs
	}
}

__DATA__
