#!/usr/bin/perl -w

use lib './t','../t','./blib/lib','../blib/lib';
	# can run from here or distribution base

use Device::SerialPort 0.06;
require "DefaultPort.pm";
use strict;

# tests start using file created by test1.t unless overridden

my $file = "/dev/ttyS0";
if ($SerialJunk::Makefile_Test_Port) {
    $file = $SerialJunk::Makefile_Test_Port;
}
if (exists $ENV{Makefile_Test_Port}) {
    $file = $ENV{Makefile_Test_Port};
}
if (@ARGV) {
    $file = shift @ARGV;
}

my $cfgfile = $file."_test.cfg";
$cfgfile =~ s/.*\///;

if (-e "../t/$cfgfile") { $cfgfile = "../t/$cfgfile"; }
elsif (-e "../$cfgfile") { $cfgfile = "../$cfgfile"; }
elsif (-e "t/$cfgfile") { $cfgfile = "t/$cfgfile"; }
else { die "$cfgfile not found" unless (-e $cfgfile); }

# Constructor

my $head	= "\r\n\r\n+++++++++++ Tied FileHandle Demo ++++++++++\r\n";
my $e="\r\n....Bye\r\n";

# =============== execution begins here =======================

    # constructor = TIEHANDLE method
my $tie_ob = tie(*PORT,'Device::SerialPort', $cfgfile)
                 || die "Can't start $cfgfile\n";

    # timeouts
$tie_ob->read_char_time(0);
$tie_ob->read_const_time(10000);
### $tie_ob->read_interval(0);
### $tie_ob->write_char_time(0);
### $tie_ob->write_const_time(3000);
### 
###     # match parameters
### $tie_ob->are_match("\n");
$tie_ob->lookclear;
### $tie_ob->is_prompt("\r\nPrompt! ");

    # other parameters
$tie_ob->error_msg(1);		# use built-in error messages
$tie_ob->user_msg(1);
$tie_ob->handshake("xoff");
### $tie_ob->handshake("rts");   # will cause output timeouts if no connect
### $tie_ob->stty_onlcr(1);		# depends on terminal
### $tie_ob->stty_opost(1);		# depends on terminal
$tie_ob->stty_icrnl(1);		# depends on terminal
$tie_ob->stty_echo(0);		# depends on terminal

    # Print Prompts to Port and Main Screen
print $head;
print PORT $head;

    # tie to PRINT method
print PORT "\r\nEnter one character (10 seconds): "
    or print "PRINT timed out\n\n";

    # tie to GETC method
my $char = getc PORT;
if (!defined $char) {
    print "GETC timed out\n";
    print PORT "...GETC timed_out\r\n";
}
else {
    print PORT "$char\r\n";
}

    # tie to WRITE method
if ( $] < 5.005 ) {
    print "syswrite tie to WRITE not supported in this Perl\n\n";
}
else {
    my $out = "\r\nThis is a 'syswrite' test\r\n\r\n";
    syswrite PORT, $out, length($out), 0
        or print "WRITE timed out\n\n";
}


    # tie to READLINE method
$tie_ob->stty_echo(1);		# depends on terminal
print PORT "enter line: ";
my $line = <PORT>;
if (defined $line) {
    print "READLINE received: $line"; # no chomp
    print PORT "\r\nREADLINE received: $line\r";
}
else {
    print "READLINE timed out\n\n";
    print PORT "...READLINE timed out\r\n";
    my ($patt, $after, $match, $instead) = $tie_ob->lastlook;  ## NEW
    print "got_instead = $instead\n" if ($instead);            ## NEW
}

    # tie to READ method
my $in = "FIRST:12345, SECOND:67890, END";
$tie_ob->stty_echo(0);		# depends on terminal
print PORT "\r\nenter 5 char (no echo): ";
unless (defined sysread (PORT, $in, 5, 6)) {
    print "READ timed out:\n";
    print PORT "...READ timed out\r\n";
}

$tie_ob->stty_echo(1);		# depends on terminal
print PORT "\r\nenter 5 more char (with echo): ";
unless (defined sysread (PORT, $in, 5, 20)) {
    print "READ timed out:\n";
    print PORT "...READ timed out\r\n";
}

    # tie to PRINTF method
printf PORT "\r\nreceived: %s\r\n", $in
    or print "PRINTF timed out\n\n";

    # PORT-specific versions of the $, and $\ variables
my $n1 = ".number1_";
my $n2 = ".number2_";
my $n3 = ".number3_";

print PORT $n1, $n2, $n3;
print PORT "\r\n";

$tie_ob->output_field_separator("COMMA");
print PORT $n1, $n2, $n3;
print PORT "\r\n";

$tie_ob->output_record_separator("RECORD");
print PORT $n1, $n2, $n3;
$tie_ob->output_record_separator("");
print PORT "\r\n";
    # the $, and $\ variables will also work

print PORT $e;

    # destructor = CLOSE method
if ( $] < 5.005 ) {
    print "close tie to CLOSE not supported in this Perl\n\n";
    $tie_ob->close || print "port close failed\n\n";
}
else {
    close PORT || print "CLOSE failed\n\n";
}

    # destructor = DESTROY method
undef $tie_ob;	# Don't forget this one!!
untie *PORT;

print $e;