1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
|
#########################################################################################
# Package HiPi::Device::SerialPort
# Description: Serial Port driver
# Copyright : Copyright (c) 2013-2017 Mark Dootson
# License : This is free software; you can redistribute it and/or modify it under
# the same terms as the Perl 5 programming language system itself.
#########################################################################################
package HiPi::Device::SerialPort;
#########################################################################################
use strict;
use warnings;
use parent qw( HiPi::Device );
use Carp;
use Try::Tiny;
require Device::SerialPort if $^O =~ /^linux$/i;
our $VERSION ='0.81';
__PACKAGE__->create_accessors( qw( portopen baudrate parity stopbits databits serialdriver ) );
sub new {
my( $class, %userparams ) = @_;
my %params = (
# standard device
devicename => '/dev/ttyAMA0',
# serial port
baudrate => 9600,
parity => 'none',
stopbits => 1,
databits => 8,
# this
serialdriver => undef,
portopen => 0,
);
# get user params
foreach my $key( keys (%params) ) {
$params{$key} = $userparams{$key} if exists($userparams{$key});
}
# warn user about unsupported params
foreach my $key( keys (%userparams) ) {
carp(qq(unknown parameter name ) . $key) if not exists($params{$key});
}
my $driver = Device::SerialPort->new( $params{devicename} ) or
croak qq(unable to open device $params{devicename});
try {
$driver->baudrate($params{baudrate});
$driver->parity($params{parity});
$driver->stopbits($params{stopbits});
$driver->databits($params{databits});
$driver->handshake('none');
$driver->write_settings;
} catch {
croak(qq(failed to set serial port params : $_) );
};
$params{serialdriver} = $driver;
$params{portopen} = 1;
my $self = $class->SUPER::new( %params ) ;
return $self;
}
sub write {
my($self, $buffer) = @_;
return unless $self->portopen;
my $result = $self->serialdriver->write($buffer);
$self->serialdriver->write_drain;
return $result;
}
sub can_read {
my $self = shift;
}
sub read {
my($self, $timeout) = @_;
$timeout ||= 0;
}
sub close {
return unless $_[0]->portopen;
$_[0]->portopen( 0 );
$_[0]->serialdriver->close or croak q(failed to close serial port);
$_[0]->serialdriver( undef );
}
1;
__END__
|
