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, 2012 Rocky Bernstein <rocky@cpan.org>

package Devel::Trepan::Client;
use strict;
use rlib;

# require_relative 'default'                # default debugger settings

use Devel::Trepan::Interface::ComCodes;
use Devel::Trepan::Interface::Client;
use Devel::Trepan::Interface::Script;
use English qw( -no_match_vars );

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

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

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

sub run_command($$$$)
{
    my ($self, $intf, $current_command) = @_;
    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 start_client($)
{
    my $options = shift;
    printf "Client option given\n";
    my $client = Devel::Trepan::Client->new(
        {client      => 1,
         cmdfiles    => [],
         initial_dir => $options->{chdir},
         nx          => 1,
         host        => $options->{host},
         port        => $options->{port}}
    );
    my $intf = $client->{intf};
    my ($control_code, $line);
    while (1) {
        eval {
            ($control_code, $line) = $intf->read_remote;
        };
        if ($EVAL_ERROR) {
            $client->msg("Remote debugged process closed connection");
            last;
        }
        # p [control_code, line]
        if (PRINT eq $control_code) {
            $client->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 = $client->{user_inputs}[0]->read_command($line);
                };
                # if ($intf->is_input_eof) {
                #       print "user-side EOF. Quitting...\n";
                #       last;
                # }
                if ($EVAL_ERROR) {
                    if (scalar @{$client->{user_inputs}} == 0) {
                        $client->msg("user-side EOF. Quitting...");
                        last;
                    } else {
                        shift @{$client->{user_inputs}};
                        next;
                    }
                };
                $leave_loop = $client->run_command($intf, $command);
                if ($EVAL_ERROR) {
                    $client->msg("Remote debugged process died");
                    last;
                }
            }
        } elsif (QUIT eq $control_code) { 
            last;
        } elsif (RESTART eq $control_code) { 
            $intf->close;
            # Make another connection..
            $client = Devel::Trepan::Client->new(
                {client      => 1,
                 cmdfiles    => [],
                 initial_dir => $options->{chdir},
                 nx          => 1,
                 host        => $options->{host},
                 port        => $options->{port}}
                );
            $intf = $client->{intf};
        } elsif (SERVERERR eq $control_code) {
            $client->errmsg($line);
        } else {
            $client->errmsg("Unknown control code: '$control_code'");
        }
    }
}

unless (caller) {
    Devel::Trepan::Client::start_client({host=>'127.0.0.1', port=>1954});
}

1;