#!perl -w
# It would be cool if this file could be put inside a /Safe/ object...
use strict;

package input;
use ObjStore ':ADV';
use vars qw($at $db $cursor $view);

package Posh::View;
BEGIN { require Cwd; *cwd = \&Cwd::fastcwd; }
use ObjStore;
use ObjStore::Peeker;
require ObjStore::Path::Ref;
use vars qw(@ISA $view $at);
@ISA = 'ObjStore::HV';

# Refcnts are wildly inaccurate unless you are in read_only mode? XXX

my $Lser    = new ObjStore::Peeker(depth => 0);
my $Peeker  = new ObjStore::Peeker(to => 'stdout', depth => 0);
my $Results = new ObjStore::Peeker(to => 'stdout', vareq => 1);

sub new {
    my ($class, $mom) = @_;
    my $o = $class->SUPER::new($mom);
    $o->{mom} = $mom;
    $o;
}

sub init {
    my ($o, $prev) = @_;
    # copy from $prev by default ?
    $o->{where} ||= 'ufs';
    $o->{'cwd'} ||= cwd;
    $o->{db} ||= '';
    $o->{cursor} ||= new ObjStore::Path::Ref($o);
}

sub POSH_PEEK {
    my ($val, $o, $name) = @_;
    $o->o("You can't peek into posh from posh!  My brain is spinning!");
}

sub enter {
    my ($o) = @_;
    $o->init;
    chdir($o->{'cwd'}) or $o->{'cwd'} = cwd;
    if ($o->{where} eq 'os') {
	begin sub { $o->{cursor}->open; };
	if ($@) {
	    warn "** An error occured while re-entering '$o->{db}':\n";
	    warn $@;
	    $o->{cursor} = new ObjStore::Path::Ref($o);
	    $o->{where} = 'ufs';
	} elsif ($o->{cursor}->depth == 0) {
	    $o->{where} = 'ufs';
	}
    } elsif ($o->{where} eq 'db') {
	if (!-r $o->{db}) {
	    $o->{where} = 'ufs';
	}
    }
    $o->prompt;
}

sub prompt {
    my ($o) = @_;
    local($input::db, $input::at, $input::view, $input::cursor);
    local($at);
    local($view);
    $o->pre_eval;
    my $p = '';
    if ($o->{where} eq 'ufs' ) {
	$p = $o->{'cwd'};
#	$p =~ s,^.+?\/([^/]+\/[^/]+\/[^/]+)$,$1,;  #? XXX
    } elsif ($o->{where} eq 'db') {
	$Lser->reset;
	$o->{db} =~ m,/([^/]+)$,;
        $p = "$o->{'cwd'}/$1";
    } elsif ($o->{where} eq 'os') {
	$p = "\$at = ".$o->{cursor}->focus;
    } else {
	print("You goofball!\n") if $o->{where} eq 'moon';
	$o->{where} = 'ufs';
	$p = $o->enter;
    }
    $p;
}

sub fetch_db {
    my $db;
    eval { $db = ObjStore::lookup($view->{db}); };
    die if $@;
    if (!$db->is_open) {
	$db->open('update');
	$db->import if $db->can('import');
    }
    $db;
}

sub pre_eval {
    $view = shift;
    $input::view = $view;
    if ($view->{where} eq 'os') {
	$input::cursor = $view->{cursor};
	$at = $view->{cursor}->focus;
	$input::db = $at->database_of;
    }
    elsif ($view->{where} eq 'db') {
	$at = fetch_db();
	$input::db = $at;
    }
    $input::at = $at;
}

sub execute {
    local($input::db, $input::at, $input::view, $input::cursor);
    local($at);
    my ($o, $input) = @_;
    local($view);
    $o->pre_eval;

    if (ref $input) {
	# This code ref did not come from the user.
	eval { $input->(); };
	print $@ if $@;
	return;
    }

    my $eval_setup = "no strict; package input;\n#line 1 \"input\"\n";

    # Any commands that are not straight perl syntax are
    # parsed and executed here.  (cd, ls)

    if ($view->{where} eq 'ufs') {

	if ($input =~ m/^ls(.*)$/s) {   #ls
	    my @ls = `ls -C $1`;		#osls XXX
	    for my $l (@ls) {
		print $l;
	    }
	    return;

	} elsif ($input =~ m/^cd\s*(.*)\s*$/s) {  #cd
	    my $path = $1;
	    $path = $ENV{HOME} if !$path;
	    if (-d $path) {
		if (chdir($path)) { $view->{'cwd'} = cwd; }
		else { print("posh: cd $path: No such directory\n"); }
	    } else {
		my ($dbname, $class, $inc) = split(m/\s+/, $path);
		my $db;
		eval { $db = ObjStore::lookup($dbname); };
		die $@ if $@ && $@ !~ m'database was not found';
		if (!$db) {
		    warn "[creating $dbname]\n";
		    push(@INC, $inc) if $inc;
		    $class ||= 'ObjStore::Database';
		    &ObjStore::require_isa_tree($class);
		    $db = $class->new(cwd . "/$dbname", 'update', 0666);
		    $db->get_INC->[0] = $inc if $inc;
		}
		$view->{db} = $db->get_pathname;
		$view->{where} = 'db';
	    }
	    if ($view->{where} eq 'db') {
		my $at = fetch_db();
		my $cs = $view->{cursor};
		if ($at->can("POSH_ENTER")) {
		    $at = $at->POSH_ENTER();
		    $cs->_Push($at->new_ref($cs, 'unsafe'));
		    $view->{where} = 'os';
		}
	    }
	    return;
	}
	
    } elsif ($view->{where} eq 'db' or
	     $view->{where} eq 'os') {

	my $cs = $view->{cursor};
	if ($input =~ m/^cd\s*(.*)$/s) {   #cd
	    my $path = $1;
	    if ($path eq '') {
		if ($view->{where} eq 'os') {
		    while ($cs->depth) { $cs->_Pop }
		}
	    } elsif ($path =~ m,^\.\.(/\.\.)*\s*$,) {
		if ($view->{where} eq 'db') {
		    my $db = ObjStore::lookup($view->{db});
		    $db->close if ($db and $db->is_open);
		    $view->{where} = 'ufs';
		} else {
		    while ($path =~ s/\.\.// and
			   $cs->depth) { $cs->_Pop }
		}
	    } elsif ($path =~ m/^\w+$/) {
		if ($at->can("POSH_CD")) {
		    my $y = $at->POSH_CD($path);
		    return if !ref $y;
		    $y = $y->POSH_ENTER() if $y->can("POSH_ENTER");
		    if (ref $y) { $cs->_Push($y->new_ref($cs, 'unsafe')); }
		    else        { print "posh: can't cd through $path\n"; }
		} else {
		    print "posh: don't know how to cd through $at\n";
		}
	    } else {
		&pre_eval;
		my $z = eval $eval_setup.$path;
		if ($@) {
		    print $@;
		    print "# Type 'help' for help!\n";
		}
		else    {
		    if (ref $z) { $cs->_Push($z->new_ref($cs, 'unsafe')); }
		    else        { print "posh: cannot cd into $z\n"; }
		}
	    }
	    if ($view->{where} eq 'os' and $cs->depth == 0) {
		$view->{where} = 'db';
	    }
	    if ($view->{where} eq 'db' and $cs->depth > 0) {
		$view->{where} = 'os';
	    }
	    return;
	}
    }

    &pre_eval;
    my @ret = eval $eval_setup.$input;

    if ($@) {
	print $@;
	print "# Type 'help' for help!\n";
    } else {
	$Results->reset;
	for (@ret) { $Results->Peek($_) }
    }
}

#--------------------------------------------- COMMANDS (not methods)
package input;

sub help {
    print '
Outside of databases:
   cd <dir>
   cd <db> [class [inc]]  # enters <db> or $class->new("update", 0666)
   ls <dir>
   pwd

Inside of databases:
   cd string           # interprets string according to $at->POSH_CD
   cd $at->...         # your expression should evaluate to a ref
   cd ..               # what you expect
   ls
   peek                # ls but more
   rawpeek             # ignore special POSH_PEEK methods
   pwd
   <or any perl statement!>

Change transaction mode:
   read
   update
   abort_only
';
    ();
}

sub debug {
    'Carp'->import('verbose');
    ++ $ObjStore::REGRESS;
    'ObjStore::Peeker'->debug(1);
}

sub pwd {
    if ($view->{where} eq 'ufs') {
	print("$view->{'cwd'}\n");
    } elsif ($view->{where} eq 'db') {
	$Lser->reset;
	print '$db = '.$Lser->Peek($db);
    } elsif ($view->{where} eq 'os') {
	$Lser->reset;
	print '$db = '.$Lser->Peek($db);
	for (my $z=0; $z < $view->{cursor}->depth; $z++) {
	    $Lser->reset;
	    print '$cursor->['."$z] = ".$Lser->Peek($cursor->focus($z));
	}
    }
    ();
}

sub ls {
    $Peeker->reset;
    if (@_) { 
	print "\n";
	for (my $x=0; $x < @_; $x++) {
	    print "[$x] = ";
	    $Peeker->Peek($_[$x]);
	}
    } else {
	print "\n\$at = ";
	$Peeker->Peek($at);
#	print join(' ', sort grep(!/^_/, keys %{ methods($fo) }))."\n";
    }
    ();
}

sub peek {
    local $Peeker->{depth} = 10;
    &ls;
    ();
}

sub rawpeek {
    local $Peeker->{depth} = 10;
    local $Peeker->{pretty} = 0;
    &ls;
    ();
}

# revisit this once perl-porters figure out how to mark methods XXX
sub methods {
    my ($ref) = @_;
    my $pack = ref $ref? ref $ref : $ref;
    my $result;
    no strict;
    # magic adapted from Devel::Symdump
    while (($key,$val) = each(%{*{"$pack\::"}})) {
	local(*ENTRY) = $val;
	if (defined $val && defined *ENTRY{CODE}) {
	    $result->{$key}++;
	}
    }
    $result;
}

package Posh::FakeTerm;

sub new {
    my ($class) = @_;
    bless [], $class;
}

sub readline {
    my ($o, $pr) = @_;
    $|=1;
    print($pr);
    $|=0;
    scalar(<>);
}

sub addhistory {}

package Posh;
use strict;
use Carp;
use IO::Handle;
use ObjStore ':ADV';
use vars qw($term @ORINC);
use base 'ObjStore::AppInstance';

@ORINC = @INC;

sub new {
    my ($class, @opts) = @_;
    my $o = $class->SUPER::new('posh', pvars => [qw(ttype pref view)]);

    croak "Odd number of parameters" if @opts & 1;
    while (@opts) { $o->{pop @opts} = pop @opts }

    $o->{user} ||= scalar(getpwuid($>));

    ObjStore::set_transaction_priority(0x1000);
    begin('update', sub {
	$o->cache;
	$o->{public}->segment_of->set_comment($o->{user});
	$o->{state} = 'active';
	$o->{ttype} ||= 'read';
	$o->{public}{user} ||= $o->{user};
	$o->{pref} ||= {view=>0};
	$o->{view} ||= [new Posh::View($o->{public})];
	$o->{prompt} = $o->view->enter;
	$o->uncache;
    });
    die if $@;
    $o;
}

sub view {
    my ($o, $xx) = @_;
    $xx = $o->{pref}{view} if !defined $xx;
    $o->{view}[$xx];
}

sub sid { $_[0]->{user}; }

sub run {
    my ($o) = @_;
    print("posh $ObjStore::VERSION (Perl $] ".ObjStore::release_name.")\n");
    print "[set for \U$o->{ttype}]\n";
    while (1) {
	my $input;
	if ($o->{prompt} =~ m/^(.*\n)(.*)$/s) {
	    print $1;
	    $input = $term->readline("$2% ");
	} else {
	    $input = $term->readline("$o->{prompt}% ");
	}
	last if (!defined $input or $input =~ m/^\s*exit\s*$/);

	$input =~ s/^\s*//;

	my $ttype;
	if ($input =~ m/^cd/) {
	    $ttype = 'update';
	} elsif ($input =~ m/^(read|update|abort_only)\s*$/) {
	    my $mode = $1;
	    $ttype = 'update';
	    $input = sub {
		$o->{ttype} = $mode;
		print "[set for \U$mode]\n";
	    };
	} else {
	    $ttype = $o->{ttype};
	}

	begin($ttype, sub{
	    $o->cache;
	    begin sub {	$o->view->execute($input) if $input; };
	    warn $@ if $@;
	    $o->{prompt} = $o->view->prompt if $ttype ne 'read';
	    $term->addhistory($input) if (!$@ and !ref $input and $input =~ /\S/);
	    $o->uncache($ttype ne 'read');
	});
	die if $@;
    }
}

eval {
    use Term::ReadLine;
    $term = new Term::ReadLine('posh');
    $term->ornaments(1);
    # do completion on perl?  :-)
};
if ($@) {
    print "** warning: Module 'Term::ReadLine' could not be loaded.\n";
    $term = new Posh::FakeTerm;
}
$SIG{INT} = sub { die "ABORT" };
ObjStore::fatal_exceptions(0);
(new Posh())->run;
