line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
# You may distribute under the terms of either the GNU General Public License |
2
|
|
|
|
|
|
|
# or the Artistic License (the same terms as Perl itself) |
3
|
|
|
|
|
|
|
# |
4
|
|
|
|
|
|
|
# (C) Paul Evans, 2008-2018 -- leonerd@leonerd.org.uk |
5
|
|
|
|
|
|
|
|
6
|
|
|
|
|
|
|
package IO::Termios; |
7
|
|
|
|
|
|
|
|
8
|
2
|
|
|
2
|
|
68826
|
use strict; |
|
2
|
|
|
|
|
13
|
|
|
2
|
|
|
|
|
56
|
|
9
|
2
|
|
|
2
|
|
11
|
use warnings; |
|
2
|
|
|
|
|
2
|
|
|
2
|
|
|
|
|
44
|
|
10
|
2
|
|
|
2
|
|
41
|
use 5.010; # // |
|
2
|
|
|
|
|
7
|
|
11
|
2
|
|
|
2
|
|
19
|
use base qw( IO::Handle ); |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
1114
|
|
12
|
|
|
|
|
|
|
|
13
|
2
|
|
|
2
|
|
12742
|
use Carp; |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
206
|
|
14
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
our $VERSION = '0.07'; |
16
|
|
|
|
|
|
|
|
17
|
2
|
|
|
2
|
|
15
|
use Exporter 'import'; |
|
2
|
|
|
|
|
2
|
|
|
2
|
|
|
|
|
85
|
|
18
|
|
|
|
|
|
|
|
19
|
2
|
|
|
2
|
|
12
|
use Fcntl qw( O_RDWR ); |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
103
|
|
20
|
2
|
|
|
2
|
|
1003
|
use POSIX qw( TCSANOW ); |
|
2
|
|
|
|
|
12589
|
|
|
2
|
|
|
|
|
11
|
|
21
|
2
|
|
|
2
|
|
3897
|
use IO::Tty; |
|
2
|
|
|
|
|
10588
|
|
|
2
|
|
|
|
|
8
|
|
22
|
2
|
|
|
|
|
430
|
use IO::Tty::Constant qw( |
23
|
|
|
|
|
|
|
TIOCMGET TIOCMSET TIOCMBIC TIOCMBIS |
24
|
|
|
|
|
|
|
TIOCM_DTR TIOCM_DSR TIOCM_RTS TIOCM_CTS TIOCM_CD TIOCM_RI |
25
|
2
|
|
|
2
|
|
260
|
); |
|
2
|
|
|
|
|
4
|
|
26
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
# Linux can support finer-grained control of baud rates if we let it |
28
|
2
|
|
|
2
|
|
17
|
use constant HAVE_LINUX_TERMIOS2 => eval { require Linux::Termios2; }; |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
12
|
|
|
2
|
|
|
|
|
2421
|
|
29
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
=head1 NAME |
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
C - supply F methods to C objects |
33
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
=head1 SYNOPSIS |
35
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
use IO::Termios; |
37
|
|
|
|
|
|
|
|
38
|
|
|
|
|
|
|
my $term = IO::Termios->open( "/dev/ttyS0", "9600,8,n,1" ) |
39
|
|
|
|
|
|
|
or die "Cannot open ttyS0 - $!"; |
40
|
|
|
|
|
|
|
|
41
|
|
|
|
|
|
|
$term->print( "Hello world\n" ); # Still an IO::Handle |
42
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
while( <$term> ) { |
44
|
|
|
|
|
|
|
print "A line from ttyS0: $_"; |
45
|
|
|
|
|
|
|
} |
46
|
|
|
|
|
|
|
|
47
|
|
|
|
|
|
|
=head1 DESCRIPTION |
48
|
|
|
|
|
|
|
|
49
|
|
|
|
|
|
|
This class extends the generic C object class by providing methods |
50
|
|
|
|
|
|
|
which access the system's terminal control C operations. These |
51
|
|
|
|
|
|
|
methods are primarily of interest when dealing with TTY devices, including |
52
|
|
|
|
|
|
|
serial ports. |
53
|
|
|
|
|
|
|
|
54
|
|
|
|
|
|
|
The flag-setting methods will apply to any TTY device, such as a pseudo-tty, |
55
|
|
|
|
|
|
|
and are useful for controlling such flags as the C flag, to disable |
56
|
|
|
|
|
|
|
local echo. |
57
|
|
|
|
|
|
|
|
58
|
|
|
|
|
|
|
my $stdin = IO::Termios->new( \*STDIN ); |
59
|
|
|
|
|
|
|
$stdin->setflag_echo( 0 ); |
60
|
|
|
|
|
|
|
|
61
|
|
|
|
|
|
|
When dealing with a serial port the line mode method is useful for setting the |
62
|
|
|
|
|
|
|
basic serial parameters such as baud rate, and the modem line control methods |
63
|
|
|
|
|
|
|
can be used to access the hardware handshaking lines. |
64
|
|
|
|
|
|
|
|
65
|
|
|
|
|
|
|
my $ttyS0 = IO::Termios->open( "/dev/ttyS0" ); |
66
|
|
|
|
|
|
|
$ttyS0->set_mode( "19200,8,n,1" ); |
67
|
|
|
|
|
|
|
$ttyS0->set_modem({ dsr => 1, cts => 1 }); |
68
|
|
|
|
|
|
|
|
69
|
|
|
|
|
|
|
=head2 Arbitrary Baud Rates on Linux |
70
|
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
F supports a non-POSIX extension to the usual C interface, |
72
|
|
|
|
|
|
|
which allows arbitrary baud rates to be set. C can automatically |
73
|
|
|
|
|
|
|
make use of this ability if the L module is installed. If so, |
74
|
|
|
|
|
|
|
this will be used automatically and transparently, to allow the C |
75
|
|
|
|
|
|
|
methods to set any rate allowed by the kernel/driver. If not, then only the |
76
|
|
|
|
|
|
|
POSIX-compatible rates may be used. |
77
|
|
|
|
|
|
|
|
78
|
|
|
|
|
|
|
=cut |
79
|
|
|
|
|
|
|
|
80
|
|
|
|
|
|
|
=head1 CONSTRUCTORS |
81
|
|
|
|
|
|
|
|
82
|
|
|
|
|
|
|
=cut |
83
|
|
|
|
|
|
|
|
84
|
|
|
|
|
|
|
=head2 new |
85
|
|
|
|
|
|
|
|
86
|
|
|
|
|
|
|
$term = IO::Termios->new() |
87
|
|
|
|
|
|
|
|
88
|
|
|
|
|
|
|
Construct a new C object around the terminal for the program. |
89
|
|
|
|
|
|
|
This is found by checking if any of C, C or C are a |
90
|
|
|
|
|
|
|
terminal. The first one that's found is used. An error occurs if no terminal |
91
|
|
|
|
|
|
|
can be found by this method. |
92
|
|
|
|
|
|
|
|
93
|
|
|
|
|
|
|
=head2 new (handle) |
94
|
|
|
|
|
|
|
|
95
|
|
|
|
|
|
|
$term = IO::Termios->new( $handle ) |
96
|
|
|
|
|
|
|
|
97
|
|
|
|
|
|
|
Construct a new C object around the given filehandle. |
98
|
|
|
|
|
|
|
|
99
|
|
|
|
|
|
|
=cut |
100
|
|
|
|
|
|
|
|
101
|
|
|
|
|
|
|
sub new |
102
|
|
|
|
|
|
|
{ |
103
|
1
|
|
|
1
|
1
|
1246
|
my $class = shift; |
104
|
1
|
|
|
|
|
2
|
my ( $handle ) = @_; |
105
|
|
|
|
|
|
|
|
106
|
1
|
50
|
|
|
|
4
|
if( not $handle ) { |
107
|
|
|
|
|
|
|
# Try to find a terminal - STDIN, STDOUT, STDERR are good candidates |
108
|
0
|
0
|
|
|
|
0
|
return $class->SUPER::new_from_fd( fileno STDIN, "w+" ) if -t STDIN; |
109
|
0
|
0
|
|
|
|
0
|
return $class->SUPER::new_from_fd( fileno STDOUT, "w+" ) if -t STDOUT; |
110
|
0
|
0
|
|
|
|
0
|
return $class->SUPER::new_from_fd( fileno STDERR, "w+" ) if -t STDERR; |
111
|
|
|
|
|
|
|
|
112
|
0
|
|
|
|
|
0
|
die "TODO: Need to find a terminal\n"; |
113
|
|
|
|
|
|
|
} |
114
|
|
|
|
|
|
|
|
115
|
1
|
50
|
|
|
|
4
|
croak '$handle is not a filehandle' unless defined fileno $handle; |
116
|
|
|
|
|
|
|
|
117
|
1
|
|
|
|
|
6
|
my $self = $class->SUPER::new_from_fd( $handle, "w+" ); |
118
|
|
|
|
|
|
|
|
119
|
1
|
|
|
|
|
91
|
return $self; |
120
|
|
|
|
|
|
|
} |
121
|
|
|
|
|
|
|
|
122
|
|
|
|
|
|
|
=head2 open |
123
|
|
|
|
|
|
|
|
124
|
|
|
|
|
|
|
$term = IO::Termios->open( $path, $modestr, $flags ) |
125
|
|
|
|
|
|
|
|
126
|
|
|
|
|
|
|
Open the given path, and return a new C object around the |
127
|
|
|
|
|
|
|
filehandle. If the C call fails, C is returned. |
128
|
|
|
|
|
|
|
|
129
|
|
|
|
|
|
|
If C<$modestr> is provided, the constructor will pass it to the C |
130
|
|
|
|
|
|
|
method before returning. |
131
|
|
|
|
|
|
|
|
132
|
|
|
|
|
|
|
If C<$flags> is provided, it will be passed on to the underlying C |
133
|
|
|
|
|
|
|
call used to open the filehandle. It should contain a bitwise-or combination |
134
|
|
|
|
|
|
|
of C flags from the L module - for example C or |
135
|
|
|
|
|
|
|
C. The value C will be added to this; the caller does not |
136
|
|
|
|
|
|
|
need to specify it directly. For example: |
137
|
|
|
|
|
|
|
|
138
|
|
|
|
|
|
|
use Fcntl qw( O_NOCTTY O_NDELAY ); |
139
|
|
|
|
|
|
|
|
140
|
|
|
|
|
|
|
$term = IO::Termios->open( "/dev/ttyS0", O_NOCTTY|O_NDELAY ); |
141
|
|
|
|
|
|
|
$term->setflag_clocal( 1 ); |
142
|
|
|
|
|
|
|
$term->blocking( 1 ); |
143
|
|
|
|
|
|
|
|
144
|
|
|
|
|
|
|
=cut |
145
|
|
|
|
|
|
|
|
146
|
|
|
|
|
|
|
sub open |
147
|
|
|
|
|
|
|
{ |
148
|
0
|
|
|
0
|
1
|
0
|
my $class = shift; |
149
|
0
|
|
|
|
|
0
|
my ( $path, $modestr, $flags ) = @_; |
150
|
|
|
|
|
|
|
|
151
|
0
|
|
0
|
|
|
0
|
$flags //= 0; |
152
|
|
|
|
|
|
|
|
153
|
0
|
0
|
|
|
|
0
|
sysopen my $tty, $path, O_RDWR | $flags, or return undef; |
154
|
0
|
0
|
|
|
|
0
|
my $self = $class->new( $tty ) or return undef; |
155
|
|
|
|
|
|
|
|
156
|
0
|
0
|
|
|
|
0
|
$self->set_mode( $modestr ) if defined $modestr; |
157
|
|
|
|
|
|
|
|
158
|
0
|
|
|
|
|
0
|
return $self; |
159
|
|
|
|
|
|
|
} |
160
|
|
|
|
|
|
|
|
161
|
|
|
|
|
|
|
=head1 METHODS |
162
|
|
|
|
|
|
|
|
163
|
|
|
|
|
|
|
=cut |
164
|
|
|
|
|
|
|
|
165
|
|
|
|
|
|
|
=head2 getattr |
166
|
|
|
|
|
|
|
|
167
|
|
|
|
|
|
|
$attrs = $term->getattr |
168
|
|
|
|
|
|
|
|
169
|
|
|
|
|
|
|
Makes a C call on the underlying filehandle, and returns a |
170
|
|
|
|
|
|
|
C object. |
171
|
|
|
|
|
|
|
|
172
|
|
|
|
|
|
|
If the C call fails, C is returned. |
173
|
|
|
|
|
|
|
|
174
|
|
|
|
|
|
|
=cut |
175
|
|
|
|
|
|
|
|
176
|
|
|
|
|
|
|
sub getattr |
177
|
|
|
|
|
|
|
{ |
178
|
8
|
|
|
8
|
1
|
59
|
my $self = shift; |
179
|
|
|
|
|
|
|
|
180
|
8
|
|
|
|
|
23
|
my $attrs = IO::Termios::Attrs->new; |
181
|
8
|
50
|
|
|
|
23
|
$attrs->getattr( $self->fileno ) or return undef; |
182
|
|
|
|
|
|
|
|
183
|
8
|
|
|
|
|
132
|
return $attrs; |
184
|
|
|
|
|
|
|
} |
185
|
|
|
|
|
|
|
|
186
|
|
|
|
|
|
|
=head2 setattr |
187
|
|
|
|
|
|
|
|
188
|
|
|
|
|
|
|
$term->setattr( $attrs ) |
189
|
|
|
|
|
|
|
|
190
|
|
|
|
|
|
|
Makes a C call on the underlying file handle, setting attributes |
191
|
|
|
|
|
|
|
from the given C object. |
192
|
|
|
|
|
|
|
|
193
|
|
|
|
|
|
|
If the C call fails, C is returned. Otherwise, a true |
194
|
|
|
|
|
|
|
value is returned. |
195
|
|
|
|
|
|
|
|
196
|
|
|
|
|
|
|
=cut |
197
|
|
|
|
|
|
|
|
198
|
|
|
|
|
|
|
sub setattr |
199
|
|
|
|
|
|
|
{ |
200
|
4
|
|
|
4
|
1
|
6
|
my $self = shift; |
201
|
4
|
|
|
|
|
7
|
my ( $attrs ) = @_; |
202
|
|
|
|
|
|
|
|
203
|
4
|
|
|
|
|
11
|
return $attrs->setattr( $self->fileno, TCSANOW ); |
204
|
|
|
|
|
|
|
} |
205
|
|
|
|
|
|
|
|
206
|
|
|
|
|
|
|
=head2 set_mode |
207
|
|
|
|
|
|
|
|
208
|
|
|
|
|
|
|
=head2 get_mode |
209
|
|
|
|
|
|
|
|
210
|
|
|
|
|
|
|
$term->set_mode( $modestr ) |
211
|
|
|
|
|
|
|
|
212
|
|
|
|
|
|
|
$modestr = $term->get_mode |
213
|
|
|
|
|
|
|
|
214
|
|
|
|
|
|
|
Accessor for the derived "mode string", which is a comma-joined concatenation |
215
|
|
|
|
|
|
|
of the baud rate, character size, parity mode, and stop size in a format such |
216
|
|
|
|
|
|
|
as |
217
|
|
|
|
|
|
|
|
218
|
|
|
|
|
|
|
19200,8,n,1 |
219
|
|
|
|
|
|
|
|
220
|
|
|
|
|
|
|
When setting the mode string, trailing components may be omitted meaning their |
221
|
|
|
|
|
|
|
value will not be affected. |
222
|
|
|
|
|
|
|
|
223
|
|
|
|
|
|
|
=cut |
224
|
|
|
|
|
|
|
|
225
|
|
|
|
|
|
|
sub set_mode |
226
|
|
|
|
|
|
|
{ |
227
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
228
|
0
|
|
|
|
|
0
|
my ( $modestr ) = @_; |
229
|
|
|
|
|
|
|
|
230
|
0
|
|
|
|
|
0
|
my ( $baud, $csize, $parity, $stop ) = split m/,/, $modestr; |
231
|
|
|
|
|
|
|
|
232
|
0
|
|
|
|
|
0
|
my $attrs = $self->getattr; |
233
|
|
|
|
|
|
|
|
234
|
0
|
0
|
|
|
|
0
|
$attrs->setbaud ( $baud ) if defined $baud; |
235
|
0
|
0
|
|
|
|
0
|
$attrs->setcsize ( $csize ) if defined $csize; |
236
|
0
|
0
|
|
|
|
0
|
$attrs->setparity( $parity ) if defined $parity; |
237
|
0
|
0
|
|
|
|
0
|
$attrs->setstop ( $stop ) if defined $stop; |
238
|
|
|
|
|
|
|
|
239
|
0
|
|
|
|
|
0
|
$self->setattr( $attrs ); |
240
|
|
|
|
|
|
|
} |
241
|
|
|
|
|
|
|
|
242
|
|
|
|
|
|
|
sub get_mode |
243
|
|
|
|
|
|
|
{ |
244
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
245
|
|
|
|
|
|
|
|
246
|
0
|
|
|
|
|
0
|
my $attrs = $self->getattr; |
247
|
0
|
|
|
|
|
0
|
return join ",", |
248
|
|
|
|
|
|
|
$attrs->getibaud, |
249
|
|
|
|
|
|
|
$attrs->getcsize, |
250
|
|
|
|
|
|
|
$attrs->getparity, |
251
|
|
|
|
|
|
|
$attrs->getstop; |
252
|
|
|
|
|
|
|
} |
253
|
|
|
|
|
|
|
|
254
|
|
|
|
|
|
|
=head2 tiocmget |
255
|
|
|
|
|
|
|
|
256
|
|
|
|
|
|
|
=head2 tiocmset |
257
|
|
|
|
|
|
|
|
258
|
|
|
|
|
|
|
$bits = $term->tiocmget |
259
|
|
|
|
|
|
|
|
260
|
|
|
|
|
|
|
$term->tiocmset( $bits ) |
261
|
|
|
|
|
|
|
|
262
|
|
|
|
|
|
|
Accessor for the modem line control bits. Takes or returns a bitmask of |
263
|
|
|
|
|
|
|
values. |
264
|
|
|
|
|
|
|
|
265
|
|
|
|
|
|
|
=cut |
266
|
|
|
|
|
|
|
|
267
|
|
|
|
|
|
|
sub tiocmget |
268
|
|
|
|
|
|
|
{ |
269
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
270
|
|
|
|
|
|
|
|
271
|
0
|
|
|
|
|
0
|
my $bitstr = pack "i!", 0; |
272
|
0
|
0
|
|
|
|
0
|
ioctl( $self, TIOCMGET, $bitstr ) or |
273
|
|
|
|
|
|
|
croak "Cannot ioctl(TIOCMGET) - $!"; |
274
|
|
|
|
|
|
|
|
275
|
0
|
|
|
|
|
0
|
return unpack "i!", $bitstr; |
276
|
|
|
|
|
|
|
} |
277
|
|
|
|
|
|
|
|
278
|
|
|
|
|
|
|
sub tiocmset |
279
|
|
|
|
|
|
|
{ |
280
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
281
|
0
|
|
|
|
|
0
|
my ( $bits ) = @_; |
282
|
|
|
|
|
|
|
|
283
|
0
|
|
|
|
|
0
|
my $bitstr = pack "i!", $bits; |
284
|
0
|
0
|
|
|
|
0
|
ioctl( $self, TIOCMSET, $bitstr ) |
285
|
|
|
|
|
|
|
or croak "Cannot ioctl(TIOCMSET) - $!"; |
286
|
|
|
|
|
|
|
} |
287
|
|
|
|
|
|
|
|
288
|
|
|
|
|
|
|
=head2 tiocmbic |
289
|
|
|
|
|
|
|
|
290
|
|
|
|
|
|
|
=head2 tiocmbis |
291
|
|
|
|
|
|
|
|
292
|
|
|
|
|
|
|
$term->tiocmbic( $bits ) |
293
|
|
|
|
|
|
|
|
294
|
|
|
|
|
|
|
$term->tiocmbis( $bits ) |
295
|
|
|
|
|
|
|
|
296
|
|
|
|
|
|
|
Bitwise mutator methods for the modem line control bits. C will |
297
|
|
|
|
|
|
|
clear just the bits provided and leave the others unchanged; C will |
298
|
|
|
|
|
|
|
set them. |
299
|
|
|
|
|
|
|
|
300
|
|
|
|
|
|
|
=cut |
301
|
|
|
|
|
|
|
|
302
|
|
|
|
|
|
|
sub tiocmbic |
303
|
|
|
|
|
|
|
{ |
304
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
305
|
0
|
|
|
|
|
0
|
my ( $bits ) = @_; |
306
|
|
|
|
|
|
|
|
307
|
0
|
|
|
|
|
0
|
my $bitstr = pack "i!", $bits; |
308
|
0
|
0
|
|
|
|
0
|
ioctl( $self, TIOCMBIC, $bitstr ) |
309
|
|
|
|
|
|
|
or croak "Cannot ioctl(TIOCMBIC) - $!"; |
310
|
|
|
|
|
|
|
} |
311
|
|
|
|
|
|
|
|
312
|
|
|
|
|
|
|
sub tiocmbis |
313
|
|
|
|
|
|
|
{ |
314
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
315
|
0
|
|
|
|
|
0
|
my ( $bits ) = @_; |
316
|
|
|
|
|
|
|
|
317
|
0
|
|
|
|
|
0
|
my $bitstr = pack "i!", $bits; |
318
|
0
|
0
|
|
|
|
0
|
ioctl( $self, TIOCMBIS, $bitstr ) |
319
|
|
|
|
|
|
|
or croak "Cannot ioctl(TIOCMBIS) - $!"; |
320
|
|
|
|
|
|
|
} |
321
|
|
|
|
|
|
|
|
322
|
|
|
|
|
|
|
my %_bit2modem; |
323
|
|
|
|
|
|
|
my %_modem2bit; |
324
|
|
|
|
|
|
|
foreach (qw( dtr dsr rts cts cd ri )) { |
325
|
|
|
|
|
|
|
my $bit = IO::Tty::Constant->${\"TIOCM_\U$_"}; |
326
|
|
|
|
|
|
|
$_bit2modem{$bit} = $_; |
327
|
|
|
|
|
|
|
$_modem2bit{$_} = $bit; |
328
|
|
|
|
|
|
|
|
329
|
|
|
|
|
|
|
my $getmodem = sub { |
330
|
0
|
|
|
0
|
|
0
|
my $self = shift; |
331
|
0
|
|
|
|
|
0
|
return !!($self->tiocmget & $bit); |
332
|
|
|
|
|
|
|
}; |
333
|
|
|
|
|
|
|
my $setmodem = sub { |
334
|
0
|
|
|
0
|
|
0
|
my $self = shift; |
335
|
0
|
|
|
|
|
0
|
my ( $set ) = @_; |
336
|
0
|
0
|
|
|
|
0
|
$set ? $self->tiocmbis( $bit ) |
337
|
|
|
|
|
|
|
: $self->tiocmbic( $bit ); |
338
|
|
|
|
|
|
|
}; |
339
|
|
|
|
|
|
|
|
340
|
2
|
|
|
2
|
|
14
|
no strict 'refs'; |
|
2
|
|
|
|
|
6
|
|
|
2
|
|
|
|
|
677
|
|
341
|
|
|
|
|
|
|
*{"getmodem_$_"} = $getmodem; |
342
|
|
|
|
|
|
|
*{"setmodem_$_"} = $setmodem; |
343
|
|
|
|
|
|
|
} |
344
|
|
|
|
|
|
|
|
345
|
|
|
|
|
|
|
=head2 get_modem |
346
|
|
|
|
|
|
|
|
347
|
|
|
|
|
|
|
$flags = $term->get_modem |
348
|
|
|
|
|
|
|
|
349
|
|
|
|
|
|
|
Returns a hash reference containing named flags corresponding to the modem |
350
|
|
|
|
|
|
|
line control bits. Any bit that is set will yield a key in the returned hash |
351
|
|
|
|
|
|
|
of the same name. The bit names are |
352
|
|
|
|
|
|
|
|
353
|
|
|
|
|
|
|
dtr dsr rts cts cd ri |
354
|
|
|
|
|
|
|
|
355
|
|
|
|
|
|
|
=cut |
356
|
|
|
|
|
|
|
|
357
|
|
|
|
|
|
|
sub get_modem |
358
|
|
|
|
|
|
|
{ |
359
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
360
|
0
|
|
|
|
|
0
|
my $bits = $self->tiocmget; |
361
|
|
|
|
|
|
|
|
362
|
|
|
|
|
|
|
return +{ |
363
|
0
|
0
|
|
|
|
0
|
map { $bits & $_modem2bit{$_} ? ( $_ => 1 ) : () } keys %_modem2bit |
|
0
|
|
|
|
|
0
|
|
364
|
|
|
|
|
|
|
}; |
365
|
|
|
|
|
|
|
} |
366
|
|
|
|
|
|
|
|
367
|
|
|
|
|
|
|
=head2 set_modem |
368
|
|
|
|
|
|
|
|
369
|
|
|
|
|
|
|
$term->set_modem( $flags ) |
370
|
|
|
|
|
|
|
|
371
|
|
|
|
|
|
|
Changes the modem line control bit flags as given by the hash reference. Each |
372
|
|
|
|
|
|
|
bit to be changed should be represented by a key in the C<$flags> hash of the |
373
|
|
|
|
|
|
|
names given above. False values will be cleared, true values will be set. |
374
|
|
|
|
|
|
|
Other flags will not be altered. |
375
|
|
|
|
|
|
|
|
376
|
|
|
|
|
|
|
=cut |
377
|
|
|
|
|
|
|
|
378
|
|
|
|
|
|
|
sub set_modem |
379
|
|
|
|
|
|
|
{ |
380
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
381
|
0
|
|
|
|
|
0
|
my ( $flags ) = @_; |
382
|
|
|
|
|
|
|
|
383
|
0
|
|
|
|
|
0
|
my $bits = $self->tiocmget; |
384
|
0
|
|
|
|
|
0
|
foreach ( keys %$flags ) { |
385
|
0
|
0
|
|
|
|
0
|
my $bit = $_modem2bit{$_} or croak "Unrecognised modem line control bit $_"; |
386
|
|
|
|
|
|
|
|
387
|
0
|
0
|
|
|
|
0
|
$flags->{$_} ? ( $bits |= $bit ) |
388
|
|
|
|
|
|
|
: ( $bits &= ~$bit ); |
389
|
|
|
|
|
|
|
} |
390
|
|
|
|
|
|
|
|
391
|
0
|
|
|
|
|
0
|
$self->tiocmset( $bits ); |
392
|
|
|
|
|
|
|
} |
393
|
|
|
|
|
|
|
|
394
|
|
|
|
|
|
|
=head2 getmodem_BIT |
395
|
|
|
|
|
|
|
|
396
|
|
|
|
|
|
|
=head2 setmodem_BIT |
397
|
|
|
|
|
|
|
|
398
|
|
|
|
|
|
|
$set = $term->getmodem_BIT |
399
|
|
|
|
|
|
|
|
400
|
|
|
|
|
|
|
$term->setmodem_BIT( $set ) |
401
|
|
|
|
|
|
|
|
402
|
|
|
|
|
|
|
Accessor methods for each of the modem line control bits. A set of methods |
403
|
|
|
|
|
|
|
exists for each of the named modem control bits given above. |
404
|
|
|
|
|
|
|
|
405
|
|
|
|
|
|
|
=head1 FLAG-ACCESSOR METHODS |
406
|
|
|
|
|
|
|
|
407
|
|
|
|
|
|
|
Theses methods are implemented in terms of the lower level methods, but |
408
|
|
|
|
|
|
|
provide an interface which is more abstract, and easier to re-implement on |
409
|
|
|
|
|
|
|
other non-POSIX systems. These should be used in preference to the lower ones. |
410
|
|
|
|
|
|
|
|
411
|
|
|
|
|
|
|
For efficiency, when getting or setting a large number of flags, it may be |
412
|
|
|
|
|
|
|
more efficient to call C, then operate on the returned object, |
413
|
|
|
|
|
|
|
before possibly passing it to C. The returned C |
414
|
|
|
|
|
|
|
object supports the same methods as documented here. |
415
|
|
|
|
|
|
|
|
416
|
|
|
|
|
|
|
The following two sections of code are therefore equivalent, though the latter |
417
|
|
|
|
|
|
|
is more efficient as it only calls C once. |
418
|
|
|
|
|
|
|
|
419
|
|
|
|
|
|
|
$term->setbaud( 38400 ); |
420
|
|
|
|
|
|
|
$term->setcsize( 8 ); |
421
|
|
|
|
|
|
|
$term->setparity( 'n' ); |
422
|
|
|
|
|
|
|
$term->setstop( 1 ); |
423
|
|
|
|
|
|
|
|
424
|
|
|
|
|
|
|
Z<> |
425
|
|
|
|
|
|
|
|
426
|
|
|
|
|
|
|
my $attrs = $term->getattr; |
427
|
|
|
|
|
|
|
$attrs->setbaud( 38400 ); |
428
|
|
|
|
|
|
|
$attrs->setcsize( 8 ); |
429
|
|
|
|
|
|
|
$attrs->setparity( 'n' ); |
430
|
|
|
|
|
|
|
$attrs->setstop( 1 ); |
431
|
|
|
|
|
|
|
$term->setattr( $attrs ); |
432
|
|
|
|
|
|
|
|
433
|
|
|
|
|
|
|
However, a convenient shortcut method is provided for the common case of |
434
|
|
|
|
|
|
|
setting the baud rate, character size, parity and stop size all at the same |
435
|
|
|
|
|
|
|
time. This is C: |
436
|
|
|
|
|
|
|
|
437
|
|
|
|
|
|
|
$term->set_mode( "38400,8,n,1" ); |
438
|
|
|
|
|
|
|
|
439
|
|
|
|
|
|
|
=cut |
440
|
|
|
|
|
|
|
|
441
|
|
|
|
|
|
|
=head2 getibaud |
442
|
|
|
|
|
|
|
|
443
|
|
|
|
|
|
|
=head2 getobaud |
444
|
|
|
|
|
|
|
|
445
|
|
|
|
|
|
|
=head2 setibaud |
446
|
|
|
|
|
|
|
|
447
|
|
|
|
|
|
|
=head2 setobaud |
448
|
|
|
|
|
|
|
|
449
|
|
|
|
|
|
|
=head2 setbaud |
450
|
|
|
|
|
|
|
|
451
|
|
|
|
|
|
|
$baud = $term->getibaud |
452
|
|
|
|
|
|
|
|
453
|
|
|
|
|
|
|
$baud = $term->getobaud |
454
|
|
|
|
|
|
|
|
455
|
|
|
|
|
|
|
$term->setibaud( $baud ) |
456
|
|
|
|
|
|
|
|
457
|
|
|
|
|
|
|
$term->setobaud( $baud ) |
458
|
|
|
|
|
|
|
|
459
|
|
|
|
|
|
|
$term->setbaud( $baud ) |
460
|
|
|
|
|
|
|
|
461
|
|
|
|
|
|
|
Convenience accessors for the C and C. C<$baud> is an integer |
462
|
|
|
|
|
|
|
directly giving the line rate, instead of one of the C> constants. |
463
|
|
|
|
|
|
|
|
464
|
|
|
|
|
|
|
=head2 getcsize |
465
|
|
|
|
|
|
|
|
466
|
|
|
|
|
|
|
=head2 setcsize |
467
|
|
|
|
|
|
|
|
468
|
|
|
|
|
|
|
$bits = $term->getcsize |
469
|
|
|
|
|
|
|
|
470
|
|
|
|
|
|
|
$term->setcsize( $bits ) |
471
|
|
|
|
|
|
|
|
472
|
|
|
|
|
|
|
Convenience accessor for the C bits of C. C<$bits> is an |
473
|
|
|
|
|
|
|
integer 5 to 8. |
474
|
|
|
|
|
|
|
|
475
|
|
|
|
|
|
|
=head2 getparity |
476
|
|
|
|
|
|
|
|
477
|
|
|
|
|
|
|
=head2 setparity |
478
|
|
|
|
|
|
|
|
479
|
|
|
|
|
|
|
$parity = $term->getparity |
480
|
|
|
|
|
|
|
|
481
|
|
|
|
|
|
|
$term->setparity( $parity ) |
482
|
|
|
|
|
|
|
|
483
|
|
|
|
|
|
|
Convenience accessor for the C and C bits of C. |
484
|
|
|
|
|
|
|
C<$parity> is C, C or C. |
485
|
|
|
|
|
|
|
|
486
|
|
|
|
|
|
|
=head2 getstop |
487
|
|
|
|
|
|
|
|
488
|
|
|
|
|
|
|
=head2 setstop |
489
|
|
|
|
|
|
|
|
490
|
|
|
|
|
|
|
$stop = $term->getstop |
491
|
|
|
|
|
|
|
|
492
|
|
|
|
|
|
|
$term->setstop( $stop ) |
493
|
|
|
|
|
|
|
|
494
|
|
|
|
|
|
|
Convenience accessor for the C bit of C. C<$stop> is 1 or 2. |
495
|
|
|
|
|
|
|
|
496
|
|
|
|
|
|
|
=head2 cfmakeraw |
497
|
|
|
|
|
|
|
|
498
|
|
|
|
|
|
|
$term->cfmakeraw |
499
|
|
|
|
|
|
|
|
500
|
|
|
|
|
|
|
I |
501
|
|
|
|
|
|
|
|
502
|
|
|
|
|
|
|
Adjusts several bit flags to put the terminal into a "raw" mode. Input is |
503
|
|
|
|
|
|
|
available a character at a time, echo is disabled, and all special processing |
504
|
|
|
|
|
|
|
of input and output characters is disabled. |
505
|
|
|
|
|
|
|
|
506
|
|
|
|
|
|
|
=cut |
507
|
|
|
|
|
|
|
|
508
|
|
|
|
|
|
|
foreach my $name (qw( ibaud obaud csize parity stop )) { |
509
|
|
|
|
|
|
|
my $getmethod = "get$name"; |
510
|
|
|
|
|
|
|
my $setmethod = "set$name"; |
511
|
|
|
|
|
|
|
|
512
|
2
|
|
|
2
|
|
17
|
no strict 'refs'; |
|
2
|
|
|
|
|
5
|
|
|
2
|
|
|
|
|
362
|
|
513
|
|
|
|
|
|
|
*$getmethod = sub { |
514
|
0
|
|
|
0
|
|
0
|
my ( $self ) = @_; |
515
|
0
|
0
|
|
|
|
0
|
my $attrs = $self->getattr or croak "Cannot getattr - $!"; |
516
|
0
|
|
|
|
|
0
|
return $attrs->$getmethod; |
517
|
|
|
|
|
|
|
}; |
518
|
|
|
|
|
|
|
*$setmethod = sub { |
519
|
0
|
|
|
0
|
|
0
|
my ( $self, $val ) = @_; |
520
|
0
|
0
|
|
|
|
0
|
my $attrs = $self->getattr or croak "Cannot getattr - $!"; |
521
|
0
|
|
|
|
|
0
|
$attrs->$setmethod( $val ); |
522
|
0
|
0
|
|
|
|
0
|
$self->setattr( $attrs ) or croak "Cannot setattr - $!"; |
523
|
|
|
|
|
|
|
}; |
524
|
|
|
|
|
|
|
} |
525
|
|
|
|
|
|
|
|
526
|
|
|
|
|
|
|
foreach my $method (qw( setbaud cfmakeraw )) { |
527
|
2
|
|
|
2
|
|
41
|
no strict 'refs'; |
|
2
|
|
|
|
|
5
|
|
|
2
|
|
|
|
|
400
|
|
528
|
|
|
|
|
|
|
*$method = sub { |
529
|
0
|
|
|
0
|
|
0
|
my $self = shift; |
530
|
0
|
0
|
|
|
|
0
|
my $attrs = $self->getattr or croak "Cannot getattr - $!"; |
531
|
0
|
|
|
|
|
0
|
$attrs->$method( @_ ); |
532
|
0
|
0
|
|
|
|
0
|
$self->setattr( $attrs ) or croak "Cannot setattr - $!"; |
533
|
|
|
|
|
|
|
}; |
534
|
|
|
|
|
|
|
} |
535
|
|
|
|
|
|
|
|
536
|
|
|
|
|
|
|
=head2 getflag_opost |
537
|
|
|
|
|
|
|
|
538
|
|
|
|
|
|
|
=head2 setflag_opost |
539
|
|
|
|
|
|
|
|
540
|
|
|
|
|
|
|
$mode = $term->getflag_opost |
541
|
|
|
|
|
|
|
|
542
|
|
|
|
|
|
|
$term->setflag_opost( $mode ) |
543
|
|
|
|
|
|
|
|
544
|
|
|
|
|
|
|
I |
545
|
|
|
|
|
|
|
|
546
|
|
|
|
|
|
|
Accessor for the C bit of the C. This enables system-specific |
547
|
|
|
|
|
|
|
post-processing on output. |
548
|
|
|
|
|
|
|
|
549
|
|
|
|
|
|
|
=head2 getflag_cread |
550
|
|
|
|
|
|
|
|
551
|
|
|
|
|
|
|
=head2 setflag_cread |
552
|
|
|
|
|
|
|
|
553
|
|
|
|
|
|
|
$mode = $term->getflag_cread |
554
|
|
|
|
|
|
|
|
555
|
|
|
|
|
|
|
$term->setflag_cread( $mode ) |
556
|
|
|
|
|
|
|
|
557
|
|
|
|
|
|
|
Accessor for the C bit of the C. This enables the receiver. |
558
|
|
|
|
|
|
|
|
559
|
|
|
|
|
|
|
=head2 getflag_hupcl |
560
|
|
|
|
|
|
|
|
561
|
|
|
|
|
|
|
=head2 setflag_hupcl |
562
|
|
|
|
|
|
|
|
563
|
|
|
|
|
|
|
$mode = $term->getflag_hupcl |
564
|
|
|
|
|
|
|
|
565
|
|
|
|
|
|
|
$term->setflag_hupcl( $mode ) |
566
|
|
|
|
|
|
|
|
567
|
|
|
|
|
|
|
Accessor for the C bit of the C. This lowers the modem control |
568
|
|
|
|
|
|
|
lines after the last process closes the device. |
569
|
|
|
|
|
|
|
|
570
|
|
|
|
|
|
|
=head2 getflag_clocal |
571
|
|
|
|
|
|
|
|
572
|
|
|
|
|
|
|
=head2 setflag_clocal |
573
|
|
|
|
|
|
|
|
574
|
|
|
|
|
|
|
$mode = $term->getflag_clocal |
575
|
|
|
|
|
|
|
|
576
|
|
|
|
|
|
|
$term->setflag_clocal( $mode ) |
577
|
|
|
|
|
|
|
|
578
|
|
|
|
|
|
|
Accessor for the C bit of the C. This controls whether local |
579
|
|
|
|
|
|
|
mode is enabled; which if set, ignores modem control lines. |
580
|
|
|
|
|
|
|
|
581
|
|
|
|
|
|
|
=cut |
582
|
|
|
|
|
|
|
|
583
|
|
|
|
|
|
|
=head2 getflag_icanon |
584
|
|
|
|
|
|
|
|
585
|
|
|
|
|
|
|
=head2 setflag_icanon |
586
|
|
|
|
|
|
|
|
587
|
|
|
|
|
|
|
$mode = $term->getflag_icanon |
588
|
|
|
|
|
|
|
|
589
|
|
|
|
|
|
|
$term->setflag_icanon( $mode ) |
590
|
|
|
|
|
|
|
|
591
|
|
|
|
|
|
|
Accessor for the C bit of C. This is called "canonical" mode |
592
|
|
|
|
|
|
|
and controls whether the terminal's line-editing feature will be used to |
593
|
|
|
|
|
|
|
return a whole line (if true), or if individual bytes from keystrokes will be |
594
|
|
|
|
|
|
|
returned as they are available (if false). |
595
|
|
|
|
|
|
|
|
596
|
|
|
|
|
|
|
=cut |
597
|
|
|
|
|
|
|
|
598
|
|
|
|
|
|
|
=head2 getflag_echo |
599
|
|
|
|
|
|
|
|
600
|
|
|
|
|
|
|
=head2 setflag_echo |
601
|
|
|
|
|
|
|
|
602
|
|
|
|
|
|
|
$mode = $term->getflag_echo |
603
|
|
|
|
|
|
|
|
604
|
|
|
|
|
|
|
$term->setflag_echo( $mode ) |
605
|
|
|
|
|
|
|
|
606
|
|
|
|
|
|
|
Accessor for the C bit of C. This controls whether input |
607
|
|
|
|
|
|
|
characters are echoed back to the terminal. |
608
|
|
|
|
|
|
|
|
609
|
|
|
|
|
|
|
=cut |
610
|
|
|
|
|
|
|
|
611
|
|
|
|
|
|
|
my @flags = ( |
612
|
|
|
|
|
|
|
# oflag |
613
|
|
|
|
|
|
|
[ opost => qw( OPOST o ) ], |
614
|
|
|
|
|
|
|
# cflag |
615
|
|
|
|
|
|
|
[ cread => qw( CREAD c ) ], |
616
|
|
|
|
|
|
|
[ clocal => qw( CLOCAL c ) ], |
617
|
|
|
|
|
|
|
[ hupcl => qw( HUPCL c ) ], |
618
|
|
|
|
|
|
|
# lflag |
619
|
|
|
|
|
|
|
[ icanon => qw( ICANON l ) ], |
620
|
|
|
|
|
|
|
[ echo => qw( ECHO l ) ], |
621
|
|
|
|
|
|
|
); |
622
|
|
|
|
|
|
|
|
623
|
|
|
|
|
|
|
foreach ( @flags ) { |
624
|
|
|
|
|
|
|
my ( $name ) = @$_; |
625
|
|
|
|
|
|
|
|
626
|
|
|
|
|
|
|
my $getmethod = "getflag_$name"; |
627
|
|
|
|
|
|
|
my $setmethod = "setflag_$name"; |
628
|
|
|
|
|
|
|
|
629
|
2
|
|
|
2
|
|
15
|
no strict 'refs'; |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
364
|
|
630
|
|
|
|
|
|
|
*$getmethod = sub { |
631
|
4
|
|
|
4
|
|
79
|
my ( $self ) = @_; |
632
|
4
|
50
|
|
|
|
9
|
my $attrs = $self->getattr or croak "Cannot getattr - $!"; |
633
|
4
|
|
|
|
|
15
|
return $attrs->$getmethod; |
634
|
|
|
|
|
|
|
}; |
635
|
|
|
|
|
|
|
*$setmethod = sub { |
636
|
4
|
|
|
4
|
|
3258
|
my ( $self, $set ) = @_; |
637
|
4
|
50
|
|
|
|
12
|
my $attrs = $self->getattr or croak "Cannot getattr - $!"; |
638
|
4
|
|
|
|
|
20
|
$attrs->$setmethod( $set ); |
639
|
4
|
50
|
|
|
|
11
|
$self->setattr( $attrs ) or croak "Cannot setattr - $!"; |
640
|
|
|
|
|
|
|
}; |
641
|
|
|
|
|
|
|
} |
642
|
|
|
|
|
|
|
|
643
|
|
|
|
|
|
|
package # hide from CPAN |
644
|
|
|
|
|
|
|
IO::Termios::Attrs; |
645
|
|
|
|
|
|
|
|
646
|
2
|
|
|
2
|
|
37
|
use Carp; |
|
2
|
|
|
|
|
5
|
|
|
2
|
|
|
|
|
148
|
|
647
|
2
|
|
|
|
|
17
|
use POSIX qw( |
648
|
|
|
|
|
|
|
CSIZE CS5 CS6 CS7 CS8 PARENB PARODD CSTOPB |
649
|
|
|
|
|
|
|
IGNBRK BRKINT PARMRK ISTRIP INLCR IGNCR ICRNL IXON OPOST ECHO ECHONL ICANON ISIG IEXTEN |
650
|
2
|
|
|
2
|
|
14
|
); |
|
2
|
|
|
|
|
3
|
|
651
|
|
|
|
|
|
|
# IO::Tty has more B<\d> constants than POSIX has |
652
|
2
|
|
|
2
|
|
297
|
use IO::Tty; |
|
2
|
|
|
|
|
5
|
|
|
2
|
|
|
|
|
11
|
|
653
|
|
|
|
|
|
|
|
654
|
|
|
|
|
|
|
# Simple XS-implemented classes tend not to respect subclassing |
655
|
|
|
|
|
|
|
sub new |
656
|
|
|
|
|
|
|
{ |
657
|
8
|
|
|
8
|
|
12
|
my $class = shift; |
658
|
8
|
|
|
|
|
33
|
my $self = $class->SUPER::new; |
659
|
8
|
|
|
|
|
15
|
bless $self, $class; |
660
|
8
|
|
|
|
|
13
|
return $self; |
661
|
|
|
|
|
|
|
} |
662
|
|
|
|
|
|
|
|
663
|
|
|
|
|
|
|
if( IO::Termios::HAVE_LINUX_TERMIOS2 ) { |
664
|
|
|
|
|
|
|
our @ISA = qw( Linux::Termios2 ); |
665
|
|
|
|
|
|
|
|
666
|
|
|
|
|
|
|
# baud is directly applicable |
667
|
|
|
|
|
|
|
*getibaud = __PACKAGE__->can( 'getispeed' ); |
668
|
|
|
|
|
|
|
*getobaud = __PACKAGE__->can( 'getospeed' ); |
669
|
|
|
|
|
|
|
|
670
|
|
|
|
|
|
|
*setibaud = __PACKAGE__->can( 'setispeed' ); |
671
|
|
|
|
|
|
|
*setobaud = __PACKAGE__->can( 'setospeed' ); |
672
|
|
|
|
|
|
|
} |
673
|
|
|
|
|
|
|
else { |
674
|
|
|
|
|
|
|
our @ISA = qw( POSIX::Termios ); |
675
|
|
|
|
|
|
|
|
676
|
|
|
|
|
|
|
# baud needs converting to/from the speed_t constants |
677
|
|
|
|
|
|
|
|
678
|
|
|
|
|
|
|
my %_speed2baud = map { IO::Tty::Constant->${\"B$_"} => $_ } |
679
|
|
|
|
|
|
|
qw( 0 50 75 110 134 150 200 300 600 1200 2400 4800 9600 19200 38400 57600 115200 230400 ); |
680
|
|
|
|
|
|
|
my %_baud2speed = reverse %_speed2baud; |
681
|
|
|
|
|
|
|
|
682
|
0
|
|
|
0
|
|
0
|
*getibaud = sub { $_speed2baud{ $_[0]->getispeed } }; |
683
|
0
|
|
|
0
|
|
0
|
*getobaud = sub { $_speed2baud{ $_[0]->getospeed } }; |
684
|
|
|
|
|
|
|
|
685
|
|
|
|
|
|
|
*setibaud = sub { |
686
|
0
|
|
0
|
0
|
|
0
|
$_[0]->setispeed( $_baud2speed{$_[1]} // die "Unrecognised baud rate" ); |
687
|
|
|
|
|
|
|
}; |
688
|
|
|
|
|
|
|
*setobaud = sub { |
689
|
0
|
|
0
|
0
|
|
0
|
$_[0]->setospeed( $_baud2speed{$_[1]} // die "Unrecognised baud rate" ); |
690
|
|
|
|
|
|
|
}; |
691
|
|
|
|
|
|
|
|
692
|
|
|
|
|
|
|
} |
693
|
|
|
|
|
|
|
|
694
|
|
|
|
|
|
|
sub setbaud |
695
|
|
|
|
|
|
|
{ |
696
|
0
|
|
|
0
|
|
0
|
$_[0]->setibaud( $_[1] ); $_[0]->setobaud( $_[1] ); |
|
0
|
|
|
|
|
0
|
|
697
|
|
|
|
|
|
|
} |
698
|
|
|
|
|
|
|
|
699
|
|
|
|
|
|
|
foreach ( @flags ) { |
700
|
|
|
|
|
|
|
my ( $name, $const, $member ) = @$_; |
701
|
|
|
|
|
|
|
|
702
|
|
|
|
|
|
|
$const = POSIX->$const(); |
703
|
|
|
|
|
|
|
|
704
|
|
|
|
|
|
|
my $getmethod = "getflag_$name"; |
705
|
|
|
|
|
|
|
my $getflag = "get${member}flag"; |
706
|
|
|
|
|
|
|
|
707
|
|
|
|
|
|
|
my $setmethod = "setflag_$name"; |
708
|
|
|
|
|
|
|
my $setflag = "set${member}flag"; |
709
|
|
|
|
|
|
|
|
710
|
2
|
|
|
2
|
|
1004
|
no strict 'refs'; |
|
2
|
|
|
|
|
3
|
|
|
2
|
|
|
|
|
1390
|
|
711
|
|
|
|
|
|
|
*$getmethod = sub { |
712
|
4
|
|
|
4
|
|
8
|
my ( $self ) = @_; |
713
|
4
|
|
|
|
|
25
|
$self->$getflag & $const |
714
|
|
|
|
|
|
|
}; |
715
|
|
|
|
|
|
|
*$setmethod = sub { |
716
|
4
|
|
|
4
|
|
17
|
my ( $self, $set ) = @_; |
717
|
4
|
100
|
|
|
|
31
|
$set ? $self->$setflag( $self->$getflag | $const ) |
718
|
|
|
|
|
|
|
: $self->$setflag( $self->$getflag & ~$const ); |
719
|
|
|
|
|
|
|
}; |
720
|
|
|
|
|
|
|
} |
721
|
|
|
|
|
|
|
|
722
|
|
|
|
|
|
|
sub getcsize |
723
|
|
|
|
|
|
|
{ |
724
|
0
|
|
|
0
|
|
|
my $self = shift; |
725
|
0
|
|
|
|
|
|
my $cflag = $self->getcflag; |
726
|
|
|
|
|
|
|
return { |
727
|
|
|
|
|
|
|
CS5, 5, |
728
|
|
|
|
|
|
|
CS6, 6, |
729
|
|
|
|
|
|
|
CS7, 7, |
730
|
|
|
|
|
|
|
CS8, 8, |
731
|
0
|
|
|
|
|
|
}->{ $cflag & CSIZE }; |
732
|
|
|
|
|
|
|
} |
733
|
|
|
|
|
|
|
|
734
|
|
|
|
|
|
|
sub setcsize |
735
|
|
|
|
|
|
|
{ |
736
|
0
|
|
|
0
|
|
|
my $self = shift; |
737
|
0
|
|
|
|
|
|
my ( $bits ) = @_; |
738
|
0
|
|
|
|
|
|
my $cflag = $self->getcflag; |
739
|
|
|
|
|
|
|
|
740
|
0
|
|
|
|
|
|
$cflag &= ~CSIZE; |
741
|
|
|
|
|
|
|
$cflag |= { |
742
|
|
|
|
|
|
|
5, CS5, |
743
|
|
|
|
|
|
|
6, CS6, |
744
|
|
|
|
|
|
|
7, CS7, |
745
|
|
|
|
|
|
|
8, CS8, |
746
|
0
|
|
|
|
|
|
}->{ $bits }; |
747
|
|
|
|
|
|
|
|
748
|
0
|
|
|
|
|
|
$self->setcflag( $cflag ); |
749
|
|
|
|
|
|
|
} |
750
|
|
|
|
|
|
|
|
751
|
|
|
|
|
|
|
sub getparity |
752
|
|
|
|
|
|
|
{ |
753
|
0
|
|
|
0
|
|
|
my $self = shift; |
754
|
0
|
|
|
|
|
|
my $cflag = $self->getcflag; |
755
|
0
|
0
|
|
|
|
|
return 'n' unless $cflag & PARENB; |
756
|
0
|
0
|
|
|
|
|
return 'o' if $cflag & PARODD; |
757
|
0
|
|
|
|
|
|
return 'e'; |
758
|
|
|
|
|
|
|
} |
759
|
|
|
|
|
|
|
|
760
|
|
|
|
|
|
|
sub setparity |
761
|
|
|
|
|
|
|
{ |
762
|
0
|
|
|
0
|
|
|
my $self = shift; |
763
|
0
|
|
|
|
|
|
my ( $parity ) = @_; |
764
|
0
|
|
|
|
|
|
my $cflag = $self->getcflag; |
765
|
|
|
|
|
|
|
|
766
|
0
|
0
|
|
|
|
|
$parity eq 'n' ? $cflag &= ~PARENB : |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
767
|
|
|
|
|
|
|
$parity eq 'o' ? $cflag |= PARENB|PARODD : |
768
|
|
|
|
|
|
|
$parity eq 'e' ? ($cflag |= PARENB) &= ~PARODD : |
769
|
|
|
|
|
|
|
croak "Unrecognised parity '$parity'"; |
770
|
|
|
|
|
|
|
|
771
|
0
|
|
|
|
|
|
$self->setcflag( $cflag ); |
772
|
|
|
|
|
|
|
} |
773
|
|
|
|
|
|
|
|
774
|
|
|
|
|
|
|
sub getstop |
775
|
|
|
|
|
|
|
{ |
776
|
0
|
|
|
0
|
|
|
my $self = shift; |
777
|
0
|
0
|
|
|
|
|
return 2 if $self->getcflag & CSTOPB; |
778
|
0
|
|
|
|
|
|
return 1; |
779
|
|
|
|
|
|
|
} |
780
|
|
|
|
|
|
|
|
781
|
|
|
|
|
|
|
sub setstop |
782
|
|
|
|
|
|
|
{ |
783
|
0
|
|
|
0
|
|
|
my $self = shift; |
784
|
0
|
|
|
|
|
|
my ( $stop ) = @_; |
785
|
0
|
|
|
|
|
|
my $cflag = $self->getcflag; |
786
|
|
|
|
|
|
|
|
787
|
0
|
0
|
|
|
|
|
$stop == 1 ? $cflag &= ~CSTOPB : |
|
|
0
|
|
|
|
|
|
788
|
|
|
|
|
|
|
$stop == 2 ? $cflag |= CSTOPB : |
789
|
|
|
|
|
|
|
croak "Unrecognised stop '$stop'"; |
790
|
|
|
|
|
|
|
|
791
|
0
|
|
|
|
|
|
$self->setcflag( $cflag ); |
792
|
|
|
|
|
|
|
} |
793
|
|
|
|
|
|
|
|
794
|
|
|
|
|
|
|
sub cfmakeraw |
795
|
|
|
|
|
|
|
{ |
796
|
0
|
|
|
0
|
|
|
my $self = shift; |
797
|
|
|
|
|
|
|
|
798
|
|
|
|
|
|
|
# Coped from bit manipulations in termios(3) |
799
|
0
|
|
|
|
|
|
$self->setiflag( $self->getiflag & ~( IGNBRK | BRKINT | PARMRK | ISTRIP | INLCR | IGNCR | ICRNL | IXON ) ); |
800
|
0
|
|
|
|
|
|
$self->setoflag( $self->getoflag & ~( OPOST ) ); |
801
|
0
|
|
|
|
|
|
$self->setlflag( $self->getlflag & ~( ECHO | ECHONL | ICANON | ISIG | IEXTEN ) ); |
802
|
0
|
|
|
|
|
|
$self->setcflag( $self->getcflag & ~( CSIZE | PARENB ) | CS8 ); |
803
|
|
|
|
|
|
|
} |
804
|
|
|
|
|
|
|
|
805
|
|
|
|
|
|
|
=head1 TODO |
806
|
|
|
|
|
|
|
|
807
|
|
|
|
|
|
|
=over 4 |
808
|
|
|
|
|
|
|
|
809
|
|
|
|
|
|
|
=item * |
810
|
|
|
|
|
|
|
|
811
|
|
|
|
|
|
|
Adding more getflag_*/setflag_* convenience wrappers |
812
|
|
|
|
|
|
|
|
813
|
|
|
|
|
|
|
=item * |
814
|
|
|
|
|
|
|
|
815
|
|
|
|
|
|
|
Automatically upgrading STDIN/STDOUT/STDERR if appropriate, given a flag. |
816
|
|
|
|
|
|
|
|
817
|
|
|
|
|
|
|
use IO::Termios -upgrade; |
818
|
|
|
|
|
|
|
|
819
|
|
|
|
|
|
|
STDIN->setflag_echo( 0 ); |
820
|
|
|
|
|
|
|
|
821
|
|
|
|
|
|
|
=back |
822
|
|
|
|
|
|
|
|
823
|
|
|
|
|
|
|
=head1 SEE ALSO |
824
|
|
|
|
|
|
|
|
825
|
|
|
|
|
|
|
=over 4 |
826
|
|
|
|
|
|
|
|
827
|
|
|
|
|
|
|
=item * |
828
|
|
|
|
|
|
|
|
829
|
|
|
|
|
|
|
L - Import Tty control constants |
830
|
|
|
|
|
|
|
|
831
|
|
|
|
|
|
|
=back |
832
|
|
|
|
|
|
|
|
833
|
|
|
|
|
|
|
=head1 AUTHOR |
834
|
|
|
|
|
|
|
|
835
|
|
|
|
|
|
|
Paul Evans |
836
|
|
|
|
|
|
|
|
837
|
|
|
|
|
|
|
=cut |
838
|
|
|
|
|
|
|
|
839
|
|
|
|
|
|
|
0x55AA; |