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

use strict;
use Zoidberg;

# TODO --rcfile oid
# TODO -M module

my $prefix = '/usr/local/';  # prefix to zoidberg files
my $skel_dir = '/etc/zoid/'; # path to default config file

my @args = (
	#['short option', 'long option', 'description', 'arg name', 'CODE'],
	['e', 'exec', 'Execute non-interactive', '$string', '&silent_exec($ARGV[1])'],
	['c', 'exec', 'Execute non-interactive', '$string', '&silent_exec($ARGV[1])'],
	['h', 'help', 'Print this help text.', '', '&display_help'],
	['u', 'usage', 'Print short help text.', '', '&display_usage'],
#	['d', 'debug', 'option to test options are working', '', 'print "It worked !\n";'],
	['V', 'version', 'Print version.', '', '&display_version'],
);

# get info
my @passwd = getpwuid($>);
# Returns ($name, $passwd, $uid, $gid, $quota, $comment, $gcos, $dir, $shell).

# check for .zoid and copy skel
my $dir = $passwd[7].'/.zoid/';
unless (-e $dir) {
	dircopy($skel_dir, $dir);
	mkdir $dir.'var/';
}

# check for login shell
unless ($ENV{PWD}) { $ENV{PWD} = $passwd[7]; }

my $fluff_conf = {
	'prefix' => $prefix,
	'config_dir' => $dir,
	'config_file' => 'profile.pd',
	'core_file' => 'core.pd',
	'grammar_file' => 'grammar.pd',
};
#print "Debug: ARGV: >>".join('--', @ARGV)."<<\n";
unless (@ARGV) { &interactive_exec }
elsif (my ($arg) = grep {($ARGV[0] eq '-'.$_->[0]) || ($ARGV[0] eq '--'.$_->[1])} @args) { eval($arg->[4]); }
else {
	print "unknown commandline argument: ".$ARGV[0]."\n";
	&display_usage;
}

sub interactive_exec {
	my $cube = Zoidberg->new;
	$cube->init($fluff_conf);
	$cube->main_loop;
	my $exitstat = $cube->round_up;
	#print "Debug: exit status wordt $exitstat\n";
	exit $exitstat;
}

sub silent_exec {
	my $arg = shift;
	#print "Debug: arg: $arg\n";
	my $cube = Zoidberg->new;
	$cube->silent;
	$cube->init($fluff_conf);
	$cube->parse($arg);
	my $exitstat = $cube->round_up;
	#print "Debug: exit status wordt $exitstat\n";
	exit $exitstat;
}

sub display_version { print $Zoidberg::LONG_VERSION."\n"; }

sub display_help {
	print " Zoidberg knows the following commandline arguments\n";
	foreach my $arg (@args) {
		print "\t-".$arg->[0].'   --'.$arg->[1].'  '.$arg->[3]."\n";
		print "\t\t".$arg->[2]."\n\n";
	}
}

sub display_usage {
	print " Usage: ".__FILE__.' [ '.join(' | ', map {'-'.$_->[0].' '.$_->[3]} @args)."]\n";
	print " Try the -h or --help option for a longer description\n";
}

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