#!/nw/dev/usr/bin/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 ':ADV';
use ObjStore::Peeker;
require ObjStore::Path::Ref;
use base 'ObjStore::HV';
use vars qw($VERSION);
$VERSION = '1.00';

# 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);

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

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->{'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, $path) = @_;
    $o->init;
    chdir($o->{'cwd'}) or $o->{'cwd'} = cwd;
    if ($o->{db}) {
	warn "** If a serious error occurs when re-entering '".$path."',\n";
	warn "** you will need to osrm it and re-run posh (known bug).\n";
	begin sub {
	    $o->fetch_db;
	    $o->{cursor}->open() if $o->{cursor};
	};
	if ($@) {
	    warn "A non-serious error occured while re-entering '$o->{db}':\n$@\n";
	    $o->{cursor} = new ObjStore::Path::Ref($o);
	    $o->{db} = '';
	}
    }
    $o->prompt;
}

sub prompt {
    my ($o) = @_;
    my $p;
    if ($o->{db}) {
	my $db = $o->fetch_db();
	my $cs = $o->{cursor};
	if ($cs and $cs->focus) {
	    $p = "\$at = ".$cs->focus;
	} else {
	    $p = $o->{db};
	}
    } else {
	$p = $o->{'cwd'};
    }
    $p;
}

sub fetch_db {
    my $view = shift;
    my $db;
    $db = ObjStore::lookup($view->{db});
    if (!$db->is_open) {
	begin sub { $db->open('update'); };
	if ($@) {
	    die if $@ !~ m'permission_denied';
	    $db->open('mvcc');
	}
	$db->import if $db->can('import');
    }
    $db;
}

sub pre_eval {
    my $view = shift;
    confess $view if !ref $view;
    $input::view = $view;
    if ($view->{cursor}->_count) {
	$input::cursor = $view->{cursor};
	$input::at = $view->{cursor}->focus;
	$input::db = $input::at->database_of;
    }
    elsif ($view->{db}) {
	$input::at = $view->fetch_db();
	$input::db = $input::at;
    }
}

sub resolve {
    my ($o, $path) = @_;
    my $db = $o->fetch_db;
    my $cs = $o->{cursor};
    my @at = ('/', $db, $cs->map(sub { shift->focus }));
    if ($path =~ m/^\s*$/) {
	('/', $db)
    } elsif ($path =~ m,^[\w\/\.\:]+$,) {
	my @path = split(m'/+', $path);
	for my $c (@path) {
	    next if $c eq '.';
	    if ($c eq '..') {
		pop @at if @at;
	    } else {
		my $at = $at[$#at];
		if ($at->can('POSH_CD')) {
		    $at = $at->POSH_CD($c);
		    return if !defined $at;
		    $at = $at->POSH_ENTER()
			if blessed $at && $at->can('POSH_ENTER');
		}
		push(@at, $at);
	    }
	}
	@at;
    } else {
	local($input::db, $input::at, $input::view, $input::cursor);
	$o->pre_eval;
	my @r = eval $eval_setup.$path;
	if ($@) {
	    print $@;
	    print "# Type 'help' for help!\n";
	    return;
	}
	(@at,(@r>1?\@r:@r));
    }
}

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

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

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

    if (!$o->{db}) {

	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) {
		chdir($path) or warn "chdir $path: $@";
		$o->{'cwd'} = cwd;

	    } 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;
		}
		$o->{db} = $db->get_pathname;
	    }

	    if ($o->{db}) {
		my $at = $o->fetch_db();
		my $cs = $o->{cursor};
		if ($at->can("POSH_ENTER")) {
		    my $at2 = $at->POSH_ENTER();
		    if (!blessed $at2 or !$at2->_is_persistent) {
			warn "$at->POSH_ENTER() returned junk ($at2)\n";
		    } else {
			$cs->_Push($at2->new_ref($cs, 'unsafe'));
		    }
		}
	    }
	    return;
	}
	
    } elsif ($o->{db}) {

	my $cs = $o->{cursor};
	if ($input =~ m/^cd\s*(.*)$/s) {   #cd
	    my $path = $1;
	    my $db = ObjStore::lookup($o->{db});
	    my @at = $o->resolve($path);

	    if (! @at) {
		print "posh: attempt to resolve '$path' failed\n";
		print "# Type 'help' for help!\n";

	    } elsif (@at == 1) {
		while ($cs->depth) { $cs->_Pop }
		$db->close() if $db && $db->is_open;
		$o->{db} = '';

	    } elsif (@at == 2) {
		while ($cs->depth) { $cs->_Pop }

	    } else {
		my $ok=1;
		my $new = new ObjStore::Path::Ref($o);
		shift @at;
		shift @at;
		for my $at (@at) {
		    if (!blessed $at or !$at->isa('ObjStore::UNIVERSAL')) {
			$ok=0;
			print "posh: cannot cd into $at\n";
			last;
		    }
		    $new->_Push($at->new_ref($new, 'unsafe'));
		}
		$o->{cursor} = $new if $ok;
	    }

	    return;

	} elsif ($input =~ m/^(ls|peek|raw)\s*(.*)$/s) {
	    my $cmd = $1;
	    my $path = $2;
	    my @at = (length $path or !$cs->_count)? $o->resolve($path):$cs->focus;
	    my $at = $at[$#at];
	    $Peeker->reset();
	    local $Peeker->{depth} = 10 if $cmd eq 'raw' || $cmd eq 'peek';
	    local $Peeker->{pretty} = 0 if $cmd eq 'raw';
	    $Peeker->Peek($at);
	    # print join(' ', sort grep(!/^_/, keys %{ methods($fo) }))."\n"; XXX
	    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
   raw                 # 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->{db}) {
	print("$view->{'cwd'}\n");
    } else {
	$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));
	}
    }
    ();
}

# 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->wdb->get_pathname);
	$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*//;
	if ($input =~ s/^\!//) {
	    my $st = system($input);
	    print "(status=$st)\n" if $st;
	    next;
	}

	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;
