12 Netio230B - Control your NETIO-230B PDU with perl
20 our $VERSION = '0.01';
27 my $foo = Netio230B->new(device => "192.168.1.22",
31 my @allports = $foo->get_device_configuration();
32 print Dumper(@allports);
37 The Netio230B is a power distribution unit which can be controled via LAN
38 see http://www.koukaam.se/showproduct.php?article_id=1502
42 This module was build and tested against the firmware version 3.12 of the
43 Netio230B device. This firmware seems to contain some bugs which manifest in
44 hanging requests and sometimes requests which do not hang but return an empty
45 result. Those issues are "handled" using a timeout for the requests
46 and sending the request again and again (max 10 times).
48 Since I upgraded to version 4.1 (which in it self was a PITA, you have to to
49 it with Internet Explorer or it will fail...) I have not seen this behavior
54 At the moment only open authentication method supported.
61 my $ua = LWP::UserAgent->new;
67 Hostname or IP adress of the device.
77 Username used to login at the device.
87 Password used to login at the device.
97 If set to '1' the module logs to STDOUT what it is doing.
98 Default value is '0' (no logging).
109 Timeout in seconds before a request is resent.
110 Default value is '1' (1 second).
117 trigger => \&_set_timeout,
122 =head2 get_device_configuration
124 Returns an array containing the current state of the PDU. Each entry is
125 either 1 (active) or 0 (inactive):
127 my @state = $foo->get_device_configuration();
128 print "port 2 state is '".$port[1]."'\n";
131 sub get_device_configuration {
133 $self->_log("requesting port configuration.");
134 my $url = $base_url . "port=list";
135 my $result = $self->_get($url);
136 @ports = split( ' ', $result );
140 =head2 get_port_state
142 Gets the current state of a single port.
144 my $state = $foo->get_port_state(2);
145 print ("Current state of port 2 is '$state'.\n");
150 my ( $self, $port ) = @_;
151 $self->_log("get_port_state(port=$port)");
152 $self->get_device_configuration();
153 my $state = $ports[ $port - 1 ];
154 $self->_log("port '$port' has state '$state'");
160 Activates a single port.
163 $foo->enable_port(4);
166 my ( $self, $port ) = @_;
167 die("Port number missing. Can not enable") unless $port;
168 $self->_log("enable_port(port=$port)");
169 $self->get_device_configuration();
170 if ( $ports[ $port - 1 ] != 1 ) {
171 $self->set_port( $port, 1, @ports );
177 Deactivates a single port.
180 $foo->disable_port(4);
183 my ( $self, $port ) = @_;
184 die("Port number missing. Can not enable") unless $port;
185 $self->_log("disable_port(port=$port)");
186 $self->get_device_configuration();
187 if ( $ports[ $port - 1 ] != 0 ) {
188 $ports[ $port - 1 ] = 0;
195 Sets the state of a port. Where state is one of '1', '0', 'u' or 'i'.
197 This may be used to interrupt the port:
199 #send interrupt command
200 $foo->set_port(2, 'i');
204 my ( $self, $port, $state ) = @_;
205 die("Port number missing. Can not enable") unless $port;
206 die("State to set is missing. Can not enable") unless $port;
207 die("State '$state' is not known.") unless $state =~ m/[10ui]/;
209 $self->_log("set_port(port=$port,state=$state)");
210 $self->get_device_configuration();
211 $ports[ $port - 1 ] = $state;
217 Deactivates all ports.
224 $self->_log("disable_all()");
225 @ports = ( 0, 0, 0, 0 );
238 $self->_log("enable_all()");
239 @ports = ( 1, 1, 1, 1 );
245 sub _rm_enclosing_htmltag {
247 return "" unless $str;
248 $str =~ s/<html> *//;
249 $str =~ s/ *<\/html>//;
255 $self->_set_timeout( $self->timeout );
256 $self->_build_control_url();
257 # $self->get_device_configuration();
261 my ( $self, $newtimeout, $old ) = @_;
262 my $mess = "using timeout '$newtimeout'";
264 $mess .= " instead of '$old'";
266 $self->_log( $mess . "." );
267 $ua->timeout($newtimeout);
271 my ( $self, $logstring ) = @_;
272 if ( $self->logging ) {
273 my $timestr = DateTime->now()->strftime("%F %T");
274 print $timestr . " Netio230B[" . $self->device . "]: $logstring\n";
278 sub _build_control_url {
283 . "/tgi/control.tgi?" . "l=p:"
284 . $self->username . ":"
285 . $self->password . "&";
290 my $url = $base_url . "port=" . join( '', @ports );
291 my $result = $self->_get($url);
295 my ( $self, $url ) = @_;
296 $self->_log("request '$url'.");
298 for ( my $count = 1; $count <= 10; $count++ ) {
299 $result = $ua->get($url);
300 my $status = $result->code . " " . $result->message;
301 if ( $result->is_error ) {
302 $self->_log( "resending because: " . $status );
304 elsif ( $result->decoded_content() eq "" ) {
306 "resending because decoded answer was empty: " . $status );
312 my $decoded = $result->decoded_content();
313 my $rem = _rm_enclosing_htmltag($decoded);
314 $self->_log("answer: '$rem'");
320 Tobias Maier, C<< <diespambox at gmx.net> >>
324 Please report any bugs or feature requests to C<bug-netio230b at rt.cpan.org>, or through
325 the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Netio230B>. I will be notified, and then you'll
326 automatically be notified of progress on your bug as I make changes.
333 You can find documentation for this module with the perldoc command.
338 You can also look for information at:
342 =item * RT: CPAN's request tracker (report bugs here)
344 L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Netio230B>
348 L<http://search.cpan.org/dist/Netio230B/>
354 =head1 LICENSE AND COPYRIGHT
356 This program is distributed under the WTFPL License:
358 DO WHAT THE FUCK YOU WANT TO PUBLIC LICENSE
359 Version 2, December 2004
361 Copyright 2012 Tobias Maier, C<< <diespambox at gmx.net> >>
363 Everyone is permitted to copy and distribute verbatim or modified
364 copies of this license document, and changing it is allowed as long
365 as the name is changed.
367 DO WHAT THE FUCK YOU WANT TO PUBLIC LICENSE TERMS AND CONDITIONS FOR COPYING,
368 DISTRIBUTION AND MODIFICATION
370 0. You just DO WHAT THE FUCK YOU WANT TO.
374 1; # End of Netio230B