/[cvs]/nfo/perl/scripts/serialcom/relaiskarte/Relais.pm
ViewVC logotype

Annotation of /nfo/perl/scripts/serialcom/relaiskarte/Relais.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.1 - (hide annotations)
Thu Jun 5 15:51:47 2003 UTC (20 years, 9 months ago) by joko
Branch: MAIN
CVS Tags: HEAD
initial commit

1 joko 1.1 package Relais;
2    
3     # $Id$
4     # $Log$
5    
6    
7     use strict;
8     use warnings;
9    
10     use Device::SerialPort qw( :PARAM :STAT );
11     use Time::HiRes qw( usleep ualarm gettimeofday tv_interval );
12     use Data::Dumper;
13    
14     # export Relais-API commands
15     use Exporter;
16     our @ISA = qw( Exporter );
17     our @EXPORT_OK = qw(
18     sendCommand
19     shutdownPort
20     getPortCount
21     togglePort
22     disableAllPorts
23     getDeviceState
24     );
25    
26    
27     # ---------------------------- configure here --------
28    
29     # serial port
30     my $cfg_SeriellerPort = '/dev/ttyS0';
31    
32     # device-address (modify for cascaded devices)
33     my $cfg_RelaisAddress = 0;
34    
35     # turn debugging on (1) or off (0)
36     my $debug = 0;
37    
38     # device has X ports
39     my $portcount = 8;
40    
41     # ---------------------------- configure here --------
42    
43    
44     # Konfiguration
45    
46     # Ausgabe auf der Konsole
47     #$cfg_AusgabeZiel = 'STDOUT';
48     # Ausgabe in eine Datei
49     my $cfg_AusgabeZiel = '/usr/local/httpd/htdocs/axquarium/iksdata.htm';
50    
51    
52    
53     # port-state in application
54     my $portstate = {};
55    
56     # current/last response from device
57     my $response;
58     my $response_data;
59    
60     my $PortName = $cfg_SeriellerPort;
61     my $quiet = 0;
62    
63     my $PortObj = new Device::SerialPort ($PortName, $quiet)
64     || die "Can't open $PortName: $^E\n"; # $quiet is
65    
66     # configuring
67    
68     #$PortObj->user_msg($Device::SerialPort::ON);
69     $PortObj->baudrate(19200);
70     $PortObj->databits(8);
71     $PortObj->parity("none");
72     $PortObj->stopbits(1);
73     $PortObj->handshake("none");
74    
75     $PortObj->write_settings || undef $PortObj;
76    
77     # $PortObj->save($Configuration_File_Name);
78     # $PortObj->baudrate(300);
79     # $PortObj->restart($Configuration_File_Name); # back to 9600 baud
80    
81    
82     # operating
83    
84     # command-table initialisieren
85     my $commands = {
86     'NOP' => {
87     cmd => 0,
88     },
89     'SETUP' => {
90     cmd => 1,
91     },
92     'GET PORT' => { cmd => 2 },
93     'SET PORT' => { cmd => 3 },
94     'GET OPTION' => { cmd => 4 },
95     'SET OPTION' => { cmd => 5 },
96     };
97    
98    
99     # Kommunikations-Hilfsfunktionen
100     # lowlevel-send
101     sub sendRequest {
102     my $frame = shift;
103     #print "writing: $frame", "\n";
104     $PortObj->write($frame);
105     $PortObj->write_done(0);
106     #sleep 1;
107    
108     # sleep for 1/3 second
109     usleep 100 * 1000; # milliseconds?
110     }
111    
112     # lowlevel-recieve
113     sub recieveResponse {
114     my $frame = shift;
115     my $frame_decoded = decodeFrame($frame);
116    
117     # debugging
118     my $decoded_dump = join(' - ', @$frame_decoded);
119     print "frame-rcvd: $decoded_dump", "\n" if $debug;
120    
121     $response = $frame_decoded;
122     $response_data = $frame_decoded->[2];
123    
124     return $frame_decoded;
125     }
126    
127     # lowlevel-frame: build
128     sub makeFrame {
129     my $cmd = shift;
130     my $data = shift;
131     my $addr = shift;
132    
133     $cmd ||= 0;
134     $addr ||= $cfg_RelaisAddress;
135     $data ||= 0;
136     my $parity = $cmd ^ $addr ^ $data;
137     print "frame-send: $cmd - $addr - $data - $parity", "\n" if $debug;
138    
139     my $frame = chr($cmd) . chr($addr) . chr($data) . chr($parity);
140     return $frame;
141     }
142    
143     sub decodeFrame {
144     my $frame = shift;
145     my @buffer;
146     for (my $i = 0; $i <= length($frame); $i++) {
147     push @buffer, ord(substr($frame, $i, 1));
148     }
149     return \@buffer;
150     }
151    
152     # highlevel-command
153     sub sendCommand {
154     my $command = shift;
155     my $data = shift;
156     my $frame = makeFrame($commands->{$command}->{cmd}, $data);
157     sendRequest($frame);
158    
159     #sleep 1;
160    
161     # Daten vom seriellen Port abholen
162     my $data_in = $PortObj->input;
163    
164     # abschliessende newlines abtrennen
165     chomp($data_in);
166    
167     # Antwort weiterleiten
168     recieveResponse($data_in);
169    
170     # zwei sekunden warten
171     #sleep(2);
172    
173     #sleep 1;
174    
175     }
176    
177     sub enablePort {
178     my $port = shift;
179     print "enabling port: $port", "\n";
180     $port -= 1;
181     $portstate->{$port} = 1;
182     writePortState();
183     }
184    
185     sub disablePort {
186     my $port = shift;
187     print "disabling port: $port", "\n";
188     $port -= 1;
189     $portstate->{$port} = 0;
190     writePortState();
191     }
192    
193     sub portState {
194     my $port = shift;
195     $port -= 1;
196     return $portstate->{$port};
197     }
198    
199     sub togglePort {
200     my $port = shift;
201     if (!portState($port)) {
202     enablePort($port);
203     } else {
204     disablePort($port);
205     }
206     }
207    
208     sub disableAllPorts {
209     for (1..$portcount) {
210     disablePort($_);
211     }
212     }
213    
214     sub writePortState {
215     my $port = shift;
216     my $bitmask = 0;
217     foreach my $port (keys %$portstate) {
218     if ($portstate->{$port}) {
219     $bitmask += 2 ** $port;
220     }
221     }
222    
223     sendCommand('SET PORT', $bitmask);
224     }
225    
226     sub readPortState {
227     sendCommand('GET PORT');
228     #print Dumper($response);
229    
230     my $val = $response_data;
231    
232     #print "bitmask: $val", "\n";
233    
234     my $rest; # = $val;
235     my $bitcount = 0;
236     while (1) {
237     $rest = $val % 2;
238     #print "bitmask: $val", "\n";
239     #print "rest: ", $rest, "\n";
240     $portstate->{$bitcount} = $rest;
241    
242     $val /= 2;
243     last if int($val) == 0;
244     $bitcount++;
245     }
246    
247     #$val = $val / 2;
248     #print "bitmask: $val", "\n";
249    
250     }
251    
252     sub shutdownPort {
253     $PortObj->close || die "failed to close";
254     undef $PortObj;
255     }
256    
257     sub getPortCount {
258     return $portcount;
259     }
260    
261     sub getDeviceState {
262     readPortState();
263     my @ports = %$portstate;
264     #print Dumper($portstate);
265     #print Dumper(@ports);
266     my $ports;
267     for (1..$portcount) {
268     my $port = $_ - 1;
269     $ports->{$_} = $portstate->{$port};
270     }
271     print Dumper($ports);
272     }
273    
274     1;

MailToCvsAdmin">MailToCvsAdmin
ViewVC Help
Powered by ViewVC 1.1.26 RSS 2.0 feed