AnySerialPort.pm 3.33 KB
Newer Older
1
2
3
4
#-----------------------------------------------------------------------
# Fault InJection Instrumenter (FIJI)
# https://embsys.technikum-wien.at/projects/vecs/fiji
#
5
6
7
8
# The creation of this file has been supported by the publicly funded
# R&D project Josef Ressel Center for Verification of Embedded Computing
# Systems (VECS) managed by the Christian Doppler Gesellschaft (CDG).
#
9
10
11
12
13
14
15
16
17
18
19
20
21
# Copyright (C) 2017 Christian Fibich <fibich@technikum-wien.at>
# Copyright (C) 2017 Stefan Tauner <tauner@technikum-wien.at>
#
# This module is free software; you can redistribute it and/or modify
# it under the same terms as Perl itself.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
#
# See the LICENSE file for more details.
#-----------------------------------------------------------------------
#
Stefan Tauner's avatar
Stefan Tauner committed
22
23
24
# Lets serial port programs written for either Windows or Unix
# work on the other kind of system without modification.
# By Ned Konz, ned@bike-nomad.com, http://bike-nomad.com
Stefan Tauner's avatar
Stefan Tauner committed
25
26
27
# Put into public domain on 2016-02-05 as of private correspondence
# with Stefan Tauner.
#
Stefan Tauner's avatar
Stefan Tauner committed
28
29
30
31
32
33
34
35
36
37
38
39
# This script must have only LF line endings to work cross-platform.
# usage:
#  perl -MAnySerialPort myProgram.pl
#
# This will map port names between Linux and Windows; if your system doesn't
# use the same mappings, you can call
# Device::SerialPort::mapPorts
# or
# Win32::SerialPort::mapPorts
# to change it:
# Device::SerialPort->mapPorts('COM1:' => '/dev/magicSerial0',
#         'COM2' => '/dev/magicSerial1');
40
package FIJI::AnySerialPort;
Stefan Tauner's avatar
Stefan Tauner committed
41
42
43
use strict;
use vars '@ISA';

44
45
46
47
BEGIN {
    my %portMap;
    my $oldNew;
    my $onWindows = 0;
Stefan Tauner's avatar
Stefan Tauner committed
48

Christian Fibich's avatar
Christian Fibich committed
49
    if ($^O eq 'MSWin32')    # running on Win32
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
    {
        $onWindows = 1;
        eval "use Win32::SerialPort";
        *main::Device::SerialPort::  = *main::Win32::SerialPort::;
        $oldNew                      = \&Win32::SerialPort::new;
        $INC{'Device/SerialPort.pm'} = $INC{'Win32/SerialPort.pm'};
        %portMap                     = (
            '/dev/ttyS0' => 'COM1:',
            '/dev/ttyS1' => 'COM2:',
            '/dev/ttyS2' => 'COM3:',
            '/dev/ttyS3' => 'COM4:',
        );
    } else    # running on Unix
    {
        eval "use Device::SerialPort";
        *main::Win32::SerialPort::  = *main::Device::SerialPort::;
        $oldNew                     = \&Device::SerialPort::new;
        $INC{'Win32/SerialPort.pm'} = $INC{'Device/SerialPort.pm'};
        %portMap                    = (
            'COM1:' => '/dev/ttyS0',
            'COM2:' => '/dev/ttyS1',
            'COM3:' => '/dev/ttyS2',
            'COM4:' => '/dev/ttyS3',
        );
    }
Stefan Tauner's avatar
Stefan Tauner committed
75

76
77
    die "$@\n" if $@;
    @ISA = 'Device::SerialPort';
Stefan Tauner's avatar
Stefan Tauner committed
78

79
80
81
82
83
    # Hook the constructor so we can map the port names
    # and class if needed
    *main::Device::SerialPort::new = sub {
        my $class    = shift;
        my $portName = shift;
Christian Fibich's avatar
Christian Fibich committed
84
        if ($onWindows != ($class eq 'Win32::SerialPort')) {
85
86
87
            $portName = $portMap{$portName} || $portName;
            $class = $onWindows ? 'Win32::SerialPort' : 'Device::SerialPort';
        }
Christian Fibich's avatar
Christian Fibich committed
88
        $oldNew->($class, $portName, @_);
89
    };
Stefan Tauner's avatar
Stefan Tauner committed
90

91
92
93
94
    # Gets and/or modifies the port mapping
    # Returns a hash
    sub Device::SerialPort::mapPorts {
        my $self = shift;
Christian Fibich's avatar
Christian Fibich committed
95
        %portMap = (%portMap, @_);
96
    }
Stefan Tauner's avatar
Stefan Tauner committed
97
98
99
}

1;