The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
# -*- coding: utf-8 -*-
# Copyright (C) 2011-2014 Rocky Bernstein <rocky@cpan.org>

package Devel::Trepan::Client;
use strict;
use English qw( -no_match_vars );

BEGIN {
    my @OLD_INC = @INC;
    use rlib '../..';
    use Devel::Trepan::Interface::ComCodes;
    use Devel::Trepan::Interface::Client;
    use Devel::Trepan::Interface::Script;
    @INC = @OLD_INC;
}

sub new
{
    my ($class, $settings) = @_;
    my $opts = $settings;
    my  $intf = Devel::Trepan::Interface::Client->new(
        undef, undef, undef, $settings );
    my $self = {
	leave_loop    => 0,
	options       => $settings,
        intf          => $intf,
        user_inputs   => [$intf->{user}],
    };
    bless $self, $class;
}

sub handle_server_reponse($$$);

sub errmsg($$)
{
    my ($self, $msg) = @_;
    $self->{intf}{user}->errmsg($msg);
}

sub msg($$)
{
    my ($self, $msg) = @_;
    chomp $msg;
    $self->{intf}{user}->msg($msg);
}

sub list_complete {
    print "List complete called\n", join(", ", @_), "\n";
}

sub complete($$$$$) {
    my ($self, $text, $line, $start, $end) = @_;
    my $intf = $self->{intf};
    # print "complete called: text: $text, line: " .
    #       $line, start: $start, end: $end\n");
    eval {
        $intf->write_remote(COMMAND, "complete " . $line);
    };
    my ($control_code, $line);
    my @complete;
    eval {
	($control_code, $line) = $intf->read_remote;
	while (PROMPT ne $control_code) {
	    if (PRINT eq $control_code) {
		chomp $line;
		push @complete, $line;
		($control_code, $line) = $intf->read_remote;
	    } else {
		$self->errmsg("Was expecting a print response, got $control_code\n+++ $line");
		return $line;
	    }
	}
    };
    chomp $line;
    return @complete;
}

sub run_command($$$$)
{
    my ($self, $current_command) = @_;
    my $intf = $self->{intf};
    if (substr($current_command, 0, 1) eq '.') {
        $current_command = substr($current_command, 1);
        my @args = split(' ', $current_command);
        my $cmd_name = shift @args;
        my $script_file = shift @args;
        if ('source' eq $cmd_name) {
            my $result =
                Devel::Trepan::Util::invalid_filename($script_file);
            unless (defined $result) {
                $self->errmsg($result);
                return 0;
            }
            my $script_intf =
                Devel::Trepan::Interface::Script->new($script_file);
            unshift @{$self->{user_inputs}}, $script_intf->{input};
            $current_command = $script_intf->read_command;
        } else {
            $self->errmsg(sprintf "Unknown command: '%s'", $cmd_name);
            return 0;
        };
    } eval {
        $intf->write_remote(COMMAND, $current_command);
    };
    return 1;
}

sub handle_server_reponse($$$) {
    my ($self, $control_code, $line) = @_;
    my $intf = $self->{intf};
    my $options = $self->{options};

    # p [control_code, line]
    if (PRINT eq $control_code) {
	$self->msg($line);
    } elsif (CONFIRM_TRUE eq $control_code) {
	my $response = $intf->confirm($line, 1);
	$intf->write_remote(CONFIRM_REPLY, $response ? 'Y' : 'N');
    } elsif (CONFIRM_FALSE eq $control_code) {
	my $response = $intf->confirm($line, 1);
	$intf->write_remote(CONFIRM_REPLY, $response ? 'Y' : 'N');
    } elsif (PROMPT eq $control_code) {
	my $command;
	my $leave_loop = 0;
	until ($leave_loop) {
	    eval {
		$command = $self->{user_inputs}[0]->read_command($line);
	    };
	    # if ($intf->is_input_eof) {
	    #       print "user-side EOF. Quitting...\n";
	    #       last;
	    # }
	    if ($EVAL_ERROR) {
		if (scalar @{$self->{user_inputs}} == 0) {
		    $self->msg("user-side EOF. Quitting...");
		    $self->{leave_loop} = 1;
		    return;
		} else {
		    shift @{$self->{user_inputs}};
		    next;
		}
	    };
	    $leave_loop = $self->run_command($command);
	    if ($EVAL_ERROR) {
		$self->msg("Remote debugged process died");
		$self->{leave_loop} = 1;
		return;
	    }
	}
    } elsif (QUIT eq $control_code) {
	$self->{leave_loop} = 1;
	return;
    } elsif (RESTART eq $control_code) {
	$intf->close;
	# Make another connection..
	$self = Devel::Trepan::Client->new(
	    {client      => 1,
	     cmdfiles    => [],
	     initial_dir => $options->{chdir},
	     nx          => 1,
	     host        => $options->{host},
	     port        => $options->{port}}
	    );
	$intf = $self->{intf};
    } elsif (SERVERERR eq $control_code) {
	$self->errmsg($line);
    } else {
	$self->errmsg("Unknown control code: '$control_code'");
    }
}

sub start_client($)
{
    my $options = shift;
    printf "Client option given\n";
    my $client = Devel::Trepan::Client->new($options);

    my $intf = $client->{intf};
    if ($intf->has_completion) {
        my $list_completion = sub {
            my($text, $state) = @_;
            list_complete($text, $state);
        };
        my $completion = sub {
            my ($text, $line, $start, $end) = @_;
            $client->complete($text, $line, $start, $end);
        };
        $intf->set_completion($completion, $list_completion);
    }

    my ($control_code, $line);
    until ($client->{leave_loop}) {
	eval {
	    ($control_code, $line) = $intf->read_remote;
	};
	if ($EVAL_ERROR) {
	    $client->msg("$EVAL_ERROR");
	    $client->msg("Remote debugged process may have closed connection");
	    last;
	}
	$client->handle_server_reponse($control_code, $line);
    }
}

unless (caller) {
    # Devel::Trepan::Client::start_client(
    # {client =>['tcp', '127.0.0.1', port=>1954]});
    # Devel::Trepan::Client::start_client(
    # {client =>['tty'], logger => \*STDOUT});
    Devel::Trepan::Client::start_client(
	{client=>['tty', '/dev/pts/4', '/dev/pts/2'],
	 logger => \*STDOUT});
}
1;