1#!/usr/bin/perl -w
2
3use lib './blib/lib','../blib/lib'; # can run from here or distribution base
4
5use Device::SerialPort 0.05;
6use strict;
7
8sub get_tf {
9    my $result = shift;
10    if ($result) { return "T"; }
11    return "F";
12}
13
14my $file = "/dev/ttyS0";
15my $ob;
16my $full_cfg = 0;
17
18# Constructor
19
20if (@ARGV) {
21    $file = $ARGV[0];
22    $ob = Device::SerialPort->start ($file) or
23        die "could not open port from configuration $file\n";
24    # next test would die at runtime without $ob
25    $full_cfg++;
26}
27else {
28    $ob = Device::SerialPort->new ($file) or
29        die "could not open port from $file\n";
30    # next test would die at runtime without $ob
31}
32
33my @carp_off_please = Device::SerialPort->set_test_mode_active(1);
34
35#### Check Port Settings
36
37my $baud=$ob->baudrate;
38my $par=$ob->parity;
39my $data=$ob->databits;
40my $stop=$ob->stopbits;
41my $hshake=$ob->handshake;
42my $rint="Win32";
43my $rconst=$ob->read_const_time;
44my $rchar=$ob->read_char_time;
45my $wconst="Win32";
46my $wchar="Win32";
47my ($rbuf, $wbuf)= $ob->buffers;
48my $alias=$ob->alias;
49my $xof_l="Win32";
50my $xon_l="Win32";
51
52my $user=get_tf(scalar $ob->user_msg);
53my $error=get_tf(scalar $ob->error_msg);
54my $debug=get_tf(scalar $ob->debug);
55my $bin=get_tf(scalar $ob->binary);
56my $par_e=get_tf(scalar $ob->parity_enable);
57
58my $xon_c="Win32";
59my $xof_c="Win32";
60my $eof_c="Win32";
61my $evt_c="Win32";
62my $err_c="Win32";
63
64## if ($rint == 0xffffffff) { $rint = "OFF "; }
65
66sub update_menu {
67	$baud=$ob->baudrate;
68	$par=$ob->parity;
69	$data=$ob->databits;
70	$stop=$ob->stopbits;
71	$hshake=$ob->handshake;
72## 	$rint=$ob->read_interval;
73	$rconst=$ob->read_const_time;
74	$rchar=$ob->read_char_time;
75## 	$wconst=$ob->write_const_time;
76## 	$wchar=$ob->write_char_time;
77	($rbuf, $wbuf)= $ob->buffers;
78	$alias=$ob->alias;
79## 	$xof_l=$ob->xoff_limit;
80## 	$xon_l=$ob->xon_limit;
81
82	$user=get_tf(scalar $ob->user_msg);
83	$error=get_tf(scalar $ob->error_msg);
84	$debug=get_tf(scalar $ob->debug);
85	$bin=get_tf(scalar $ob->binary);
86	$par_e=get_tf(scalar $ob->parity_enable);
87
88## 	$xon_c=sprintf("0x%x", scalar $ob->xon_char);
89## 	$xof_c=sprintf("0x%x", scalar $ob->xoff_char);
90## 	$eof_c=sprintf("0x%x", scalar $ob->eof_char);
91## 	$evt_c=sprintf("0x%x", scalar $ob->event_char);
92## 	$err_c=sprintf("0x%x", scalar $ob->error_char);
93
94## 	if ($rint == 0xffffffff) { $rint = "OFF "; }
95
96	$-=0;
97	write;
98}
99
100format STDOUT_TOP =
101
102========================  Serial Port Setup ===========================
103
104.
105
106format STDOUT =
107A  Alias:      @<<<<<<<<<<<<      M  Read Interval Time     @>>>>>>> MS
108               $alias,                                      $rint
109B  Baud:       @<<<<<<            N  Read Char. Time        @>>>>>>> MS
110               $baud,                                       $rchar
111C  Binary:     @<                 O  Read Constant Time     @>>>>>>> MS
112               $bin,                                        $rconst
113D  Databits:   @<                 P  Write Char. Time       @>>>>>>> MS
114               $data,                                       $wchar
115E  Parity_En:  @<                 Q  Write Const. Time      @>>>>>>> MS
116               $par_e,                                      $wconst
117F  Parity:     @<<<<              R  Read Buffer Size       @>>>>>>>
118               $par,                                        $rbuf
119G  Error Msg:  @<<                S  Write Buffer Size      @>>>>>>>
120               $error,                                      $wbuf
121H  Handshake:  @<<<<              T  Buffer Send Xon  (top)   @>>>>>
122               $hshake,                                       $xon_l
123I  User Msg:   @<<<<              U  Buffer Send Xoff (bot)   @>>>>>
124               $user,                                         $xof_l
125J  Error Char: @<<<<              V  Xoff Character           @>>>>>
126               $err_c,                                        $xof_c
127K  Event Char: @<<<<              W  Xon Character            @>>>>>
128               $evt_c,                                        $xon_c
129L  Debug:      @<<<<              X  Eof Character            @>>>>>
130               $debug,                                        $eof_c
131.
132
133write;
134
135print "\nWaiting 5 seconds before continuing\n";
136sleep 5;
137
138$ob->user_msg(1);
139$ob->parity("odd");
140$ob->parity_enable(1);
141
142update_menu;
143
144## unless ($full_cfg) {
145##     print "\nParity settings will not update until write_settings complete\n";
146## }
147
148undef $ob;
149