equal
deleted
inserted
replaced
19 # Heiko Schlittermann <hs@schlittermann.de> |
19 # Heiko Schlittermann <hs@schlittermann.de> |
20 |
20 |
21 use strict; |
21 use strict; |
22 use warnings; |
22 use warnings; |
23 use Carp; |
23 use Carp; |
24 use IO::Socket::INET; |
24 use IO::Socket::INET; # FIXME: shold be loaded conditionally |
|
25 use IO::Socket::UNIX; # FIXME: shold be loaded conditionally |
25 |
26 |
26 use Quancom::Result; |
27 use Quancom::Result; |
27 |
28 |
28 our $VERSION = 0.1; |
29 our $VERSION = 0.1; |
29 |
30 |
32 sub new { |
33 sub new { |
33 my $class = ref $_[0] ? ref shift : shift; |
34 my $class = ref $_[0] ? ref shift : shift; |
34 my $self = bless {} => $class; |
35 my $self = bless {} => $class; |
35 |
36 |
36 $self->{peer} = shift or croak "need a peer address!"; |
37 $self->{peer} = shift or croak "need a peer address!"; |
37 $self->{peer} .= ":$DEFAULT_PORT" |
|
38 unless $self->{peer} =~ /:\d+$/; |
|
39 |
38 |
40 $self->{socket} = new IO::Socket::INET( |
39 if ($self->{peer} !~ /\//) { |
41 Proto => "tcp", |
40 $self->{peer} .= ":$DEFAULT_PORT" |
42 PeerAddr => $self->{peer} |
41 unless $self->{peer} =~ /:\d+$/; |
43 ); |
42 |
|
43 $self->{socket} = new IO::Socket::INET( |
|
44 Proto => "tcp", |
|
45 PeerAddr => $self->{peer} |
|
46 ); |
|
47 } |
|
48 else { |
|
49 $self->{socket} = new IO::Socket::UNIX(Peer => $self->{peer}); |
|
50 } |
|
51 |
|
52 $self->{socket} or croak "Can't create socket to $self->{peer}: $!\n"; |
44 |
53 |
45 $self->{job} = 0; |
54 $self->{job} = 0; |
46 $self->{ok} = undef; |
55 $self->{ok} = undef; |
47 |
56 |
48 return $self; |
57 return $self; |
58 $self->_rx($cmd); |
67 $self->_rx($cmd); |
59 |
68 |
60 return $self->{last_result}; |
69 return $self->{last_result}; |
61 } |
70 } |
62 |
71 |
|
72 sub TIESCALAR { |
|
73 my $class = shift; |
|
74 my ($ip) = @_; |
|
75 my $self = bless {} => $class; |
|
76 warn "tied to ip $ip\n"; |
|
77 |
|
78 return $self; |
|
79 } |
|
80 |
|
81 sub STORE { |
|
82 my $self = shift; |
|
83 my ($key, $value) = @_; |
|
84 |
|
85 #croak "invalid value \"$value\" (should be 0 or 1)\n"; |
|
86 warn "Set $key to $value\n"; |
|
87 } |
|
88 |
63 sub _tx { |
89 sub _tx { |
64 my $self = shift; |
90 my $self = shift; |
65 my $cmd = shift; |
91 my $cmd = shift; |
66 |
92 |
67 $self->{job} = ++$self->{job} % 255; # cap the job id on 255; |
93 $self->{job} = ++$self->{job} % 255; # cap the job id on 255; |
68 $cmd = "\x02" . sprintf("%02x", $self->{job}) . $cmd; # add STX and job id |
94 $cmd = "\x02" . sprintf("%02x", $self->{job}) . $cmd; # add STX and job id |
69 $cmd .= sprintf("%02x", unpack("%8C*", $cmd)); # add checksum |
95 $cmd .= sprintf("%02x", unpack("%8C*", $cmd)); # add checksum |
70 |
96 |
71 warn "sending $cmd | " . unpack("H*", $cmd) . "\n"; |
97 warn "sending $cmd\n"; |
72 $self->{socket}->print($cmd . "\r"); |
98 $self->{socket}->print($cmd . "\r"); |
73 } |
99 } |
74 |
100 |
75 sub _rx { |
101 sub _rx { |
76 my $self = shift; |
102 my $self = shift; |
89 |
115 |
90 =head1 SYNOPSIS |
116 =head1 SYNOPSIS |
91 |
117 |
92 use Quancom; |
118 use Quancom; |
93 |
119 |
94 my $quancom = new Quancom 172.16.0.22; |
120 my $quancom = new Quancom "172.16.0.22"; |
95 my $result = $q->cmd("xxxxxx"); |
121 my $result = $q->cmd("xxxxxx"); |
96 if ($result->error) { die $result->error_message } |
122 if ($result->error) { die $result->error_message } |
97 else { print $result->data } |
123 else { print $result->data } |
98 |
124 |
99 |
125 |
100 =head1 METHODS |
126 =head1 METHODS |
101 |
127 |
102 =over |
128 =over |
103 |
129 |
104 =item constructor B<new>( I<ip> ) |
130 =item constructor B<new>( I<ip or socket name> ) |
105 |
131 |
106 This method returns a new Quancom object if the connection was |
132 This method returns a new Quancom object if the connection was |
107 successfully established. |
133 successfully established. For testing you may use "0.0.0.0" as address, |
|
134 this disables the socket communication and just simulates the Quancom |
|
135 module. |
108 |
136 |
109 =item B<cmd>( I<string> ) |
137 =item B<cmd>( I<string> ) |
110 |
138 |
111 Send a Quancom string to the device. The string here should be |
139 Send a Quancom string to the device. The string here should be |
112 B<without> the leading STX and Jobid as well without the trailing CR. |
140 B<without> the leading STX and Jobid as well without the trailing CR. |
124 =back |
152 =back |
125 |
153 |
126 =head1 MORE EXAMPLES |
154 =head1 MORE EXAMPLES |
127 |
155 |
128 use Quancom; |
156 use Quancom; |
129 my $quancom = new Quancom(172.20.20.1); |
157 my $quancom = new Quancom("172.20.20.1"); |
130 die "Sorry" if $quancom->cmd("xxxx")->error; |
158 die "Sorry" if $quancom->cmd("xxxx")->error; |
131 |
159 |
132 =head1 SEE ALSO |
160 =head1 SEE ALSO |
133 |
161 |
134 L<Quancom::Result> |
162 L<Quancom::Result> |