1 | #!/usr/bin/perl |
---|
2 | # Client-Anwendung fuer Documation M200-PC-UC-Protokoll |
---|
3 | # fuer Linux. Gibt Jones-Cardfile auf STDOUT aus. |
---|
4 | # Sven, 18.03.2012 |
---|
5 | |
---|
6 | # ubuntu: libdevice-serialport-perl |
---|
7 | use Device::SerialPort; |
---|
8 | use Data::Dumper; |
---|
9 | use strict; |
---|
10 | |
---|
11 | $|++; # Disable output buffer (always a good idea) |
---|
12 | |
---|
13 | my $dev_file = "/dev/ttyS0"; |
---|
14 | my $dev = new Device::SerialPort($dev_file) or die "Cannot open $dev_file: $!\n"; |
---|
15 | |
---|
16 | $dev->baudrate(38400); |
---|
17 | $dev->databits(8); |
---|
18 | $dev->stopbits(1); |
---|
19 | $dev->handshake("none"); # oder "rts" |
---|
20 | |
---|
21 | print STDERR "Got it.\n"; |
---|
22 | |
---|
23 | print "H80"; # Jones card prefix |
---|
24 | $dev->write("5"); |
---|
25 | |
---|
26 | while(1) { |
---|
27 | my $line = read_line($dev); |
---|
28 | next if($line =~ /^\s*$/); |
---|
29 | my ($cmd, $text) = parse_line($line); |
---|
30 | |
---|
31 | if($cmd >= 100 && $cmd < 200) { |
---|
32 | print STDERR "[INFO $cmd] $text\n"; |
---|
33 | } elsif($cmd >= 200 && $cmd < 300) { |
---|
34 | print STDERR "[ACK $cmd] $text\n"; |
---|
35 | } elsif($cmd >= 300 && $cmd < 400) { |
---|
36 | print STDERR "[SIGNAL $cmd] $text\n"; |
---|
37 | } elsif($cmd >= 400 && $cmd < 500) { |
---|
38 | print STDERR "[DEUBG $cmd] $text\n"; |
---|
39 | } elsif($cmd >= 500 && $cmd < 600) { |
---|
40 | die "Client implementation error: Cannot parse Hex output ($line)!\n"; |
---|
41 | } elsif($cmd >= 600 && $cmd < 700) { |
---|
42 | die "Client implementation error: Cannot parse Debug output ($line)!\n"; |
---|
43 | } elsif($cmd >= 800 && $cmd < 900) { |
---|
44 | # Binary Jones output. I can parse that! |
---|
45 | if($cmd == 800) { |
---|
46 | print STDERR "[JONES] Starting Binary Card\n"; |
---|
47 | |
---|
48 | # print generic card prefix |
---|
49 | print chr(0x80), chr(0x80), chr(0x80); |
---|
50 | my $cardlen = 123; # binary jones format card length |
---|
51 | my $crap_after = 120; # da wird muell vom uc ausgegeben |
---|
52 | my $read = 0; |
---|
53 | while($read < $cardlen) { |
---|
54 | my ($count, $s) = $dev->read(1); |
---|
55 | if($count == 1) { |
---|
56 | print $s if($read < $crap_after); |
---|
57 | $read++; |
---|
58 | } |
---|
59 | } |
---|
60 | |
---|
61 | # exactly after the 808 must come |
---|
62 | my $line = read_line($dev); |
---|
63 | if($line =~ /^808/) { |
---|
64 | print STDERR "[OK] Card read\n"; |
---|
65 | } else { |
---|
66 | print STDERR "[JONES ERROR] Error, missing 808\n"; |
---|
67 | } |
---|
68 | } elsif($cmd == 808) { |
---|
69 | print STDERR "Finished Card ACK. Would not expect here\n"; |
---|
70 | } |
---|
71 | } elsif($cmd >= 900 && $cmd <= 999) { |
---|
72 | print STDERR "[SERVER CRASH] $text\n"; |
---|
73 | } else { |
---|
74 | print STDERR "[PROTO ERROR] Command $cmd not understood ($text)\n"; |
---|
75 | } |
---|
76 | } |
---|
77 | |
---|
78 | sub read_line { |
---|
79 | my $buffer = ''; |
---|
80 | my $c = ''; my $l = ''; # current char, last char |
---|
81 | my $hardlimit = 1000; # max lines |
---|
82 | my $count = 0; |
---|
83 | my $device = shift; |
---|
84 | while(1) { |
---|
85 | $c = $device->read(1); |
---|
86 | $buffer .= $c; |
---|
87 | return($buffer) if($c eq '' and ++$count > $hardlimit); |
---|
88 | return($buffer) if($l eq "\r" or $c eq "\n"); |
---|
89 | $l = $c; |
---|
90 | } |
---|
91 | } |
---|
92 | |
---|
93 | sub parse_line { |
---|
94 | my $line = shift; |
---|
95 | print STDERR "[PROTO ERROR] Bad line: '$line'\n" |
---|
96 | unless($line =~ /^\s*(\d{3})\s*(.*)\s*$/); |
---|
97 | return( $1, $2 ); # tuple ($number, $text) |
---|
98 | } |
---|