#!/usr/bin/perl -w

use strict;

use Term::ReadLine;
use YAML;
use vars qw($prompt);
$prompt = 'ysh > ';
my $round_trip = 1;
my $force = 0;
my $log = 0;
$| = 1;

while (my $arg = shift @ARGV) {
    $round_trip = 2 if $arg =~ /^-r$/;
    $round_trip = 0 if $arg =~ /^-R$/;
    $log = 1 if $arg =~ /^-l$/;
    $log = 2 if $arg =~ /^-L$/;
    $force = 1 if $arg =~ /^-F$/;
}

check_install() unless $force;

if ($log) {
    if ($log == 2) {
        open LOGFILE, "> ./ysh.log" or die $!;
    }
    else {
        open LOGFILE, ">> ./ysh.log" or die $!;
    }
    print LOGFILE "\nYAML.pm Version $YAML::VERSION\n";
    print LOGFILE "Begin logging at ", scalar localtime, "\n\n";
}

sub Print {
    print @_;
    print LOGFILE @_ if $log;
}
local $SIG{__WARN__} = sub { Print @_ };

Print "Welcome to the YAML Test Shell. Type ':help' for more information\n\n";

{
    my $sh = Term::ReadLine::->new('The YAML Shell');
    $readline::rl_completion_function =
	$readline::rl_completion_function = sub { () };
    sub my_readline {
        print LOGFILE $prompt if $log;
	$sh->readline($prompt) . "\n";
    }
}

while ($_ = my_readline()) {
    print LOGFILE $_ if $log;
    next if /^\s*$/;
    handle_command($_),next if /^:/;
    handle_yaml($_),next if /^--\S/;
    handle_yaml(''),next if /^===$/;
    handle_perl($_,1),next if /^;/;
    handle_perl($_,0),next;
    Print "Unknown command. Type ':help' for instructions.\n";
}
    
sub handle_perl {
    my ($perl, $multi) = @_;
    my (@objects, $yaml, $yaml2);
    local $prompt = 'perl> ';
    if ($multi) {
        my $line = $perl;
        while ($line !~ /^;$/) {
	    $line = my_readline();
	    print LOGFILE $line if $log;
            $perl .= $line;
        }
    }
    @objects = eval "no strict;$perl";
    Print("Bad Perl expression:\n$@"), return if $@;
    eval { $yaml = Store(@objects) };
    $@ =~ s/^ at.*\Z//sm if $@;
    Print("Store failed:\n$@"), return if $@;
    # my $yaml1 = $yaml;  #
    # $yaml1 =~ s/ /_/g;  #
    # $yaml1 =~ s/\n/+/g; #
    # Print $yaml1, "\n"; #
    Print $yaml;
    if ($round_trip) {
        eval { $yaml2 = Store(Load($yaml)) };
        $@ =~ s/^ at.*\Z//sm if $@;
        Print("Load failed:\n$@"), return if $@;
        if ($yaml eq $yaml2) {
            if ($round_trip > 1) {
	        Print "\nData roundtripped OK!!!\n";
	    }
        }
        else {
	    Print "================\n";
	    Print "after roundtrip:\n";
	    Print "================\n";
	    # $yaml2 =~ s/ /_/g;  #
	    # $yaml2 =~ s/\n/+/g; #
	    # Print $yaml2, "\n"; #
	    Print $yaml2;
	    Print "=========================\n";
            Print "Data did NOT roundtrip...\n";
        }
    }
}

sub handle_yaml {
    my $yaml = shift;
    eval "use Data::Dumper";
    die $@ if $@;
    my $line = $yaml;
    my (@objects);
    local $prompt = 'yaml> ';
    $line = my_readline();
    print LOGFILE $line if $log;
    $line = '' unless defined $line;
    while ($line !~ /^\.{3}$/) {
	$yaml .= $line;
	$line = my_readline();
        print LOGFILE $line if $log;
	last unless defined $line;
    }
    eval { @objects = Load($yaml) };
    $@ =~ s/^ at.*\Z//sm if $@;
    $@ =~ s/^/  /gm if $@;
    Print("YAML Load Failed:\n$@"), return if $@;
    Print Data::Dumper::Dumper(@objects);
}

sub handle_command {
    my $line = shift;
    chomp $line;
    my ($cmd, $args);
    if ($line =~ /^:(\w+)\s*(.*)$/) {
     	$cmd = $1;
     	$args = $2;
        exit if $cmd =~ /^(exit|q(uit)?)$/;
        handle_help(),return if $cmd eq 'help';
        print `clear`,return if $cmd =~ /^c(lear)?$/;
    }
    Print "Invalid command\n";
}

sub handle_help {
    Print <<END;
                      Welcome to the YAML Test Shell.

   When you to type in Perl, you get back YAML. And vice versa.

   By default, every line you type is a one line Perl program, the
   return value of which will be displayed as YAML.

   To enter multi-line Perl code start the first line with ';' and use
   as many lines as needed. Terminate with a line containing just ';'.

   To enter YAML text, start with a valid YAML separator/header line
   which is typically '---'. Use '===' to indicate that there is no YAML
   header. Enter as many lines as needed. Terminate with a line
   containing just '...'.

   Shell Commands:             (Begin with ':')
      :exit or :q(uit) - leave the shell
      :help - get this help screen

END
}

sub check_install {
    if (-f "./YAML.pm" && -f "./pm_to_blib" &&
        -M "./YAML.pm" <  -M "./pm_to_blib"
       ) {
        die "You need to 'make install'!\n";
    }
}

1;
