1# UPS::Nut - a class to talk to a UPS via the Network Utility Tools upsd.
2# Original author Kit Peters <perl@clownswilleatyou.com>
3# Rewritten by Gabor Kiss <kissg@ssg.ki.iif.hu>
4# Idea to implement TLS:http://www.logix.cz/michal/devel/smtp-cli/smtp-client.pl
5
6# ### changelog: made debug messages slightly more descriptive, improved
7# ### changelog: comments in code
8# ### changelog: Removed timeleft() function.
9
10package UPS::Nut;
11use strict;
12use Carp;
13use FileHandle;
14use IO::Socket;
15use IO::Select;
16use Dumpvalue; my $dumper = Dumpvalue->new;
17
18# The following globals dictate whether the accessors and instant-command
19# functions are created.
20# ### changelog: tie hash interface and AUTOLOAD contributed by
21# ### changelog: Wayne Wylupski
22
23my $_eol = "\n";
24
25BEGIN {
26    use Exporter ();
27    use vars qw ($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
28    $VERSION     = 1.51;
29    @ISA         = qw(Exporter IO::Socket::INET);
30    @EXPORT      = qw();
31    @EXPORT_OK   = qw();
32    %EXPORT_TAGS = ();
33}
34
35sub new {
36# Author: Kit Peters
37  my $proto = shift;
38  my $class = ref($proto) || $proto;
39  my %arg = @_; # hash of arguments
40  my $self = {};	# _initialize will fill it later
41  bless $self, $class;
42  unless ($self->_initialize(%arg)) { # can't initialize
43    carp "Can't initialize: $self->{err}";
44    return undef;
45  }
46  return $self;
47}
48
49# accessor functions.  Return a value if successful, return undef
50# otherwise.
51
52sub BattPercent { # get battery percentage
53	return shift->GetVar('battery.charge');
54}
55
56sub LoadPercent { # get load percentage
57	my $self = shift;
58	my $context = shift;
59	$context = "L$context" if $context =~ /^[123]$/;
60	$context = ".$context" if $context;
61	return $self->GetVar("output$context.power.percent");
62}
63
64sub LineVoltage { # get line voltage
65	my $self = shift;
66	my $context = shift;
67	$context = "L$context-N" if $context =~ /^[123]$/;
68	$context = ".$context" if $context;
69	return $self->GetVar("input$context.voltage");
70}
71
72sub Status { # get status of UPS
73	return shift->GetVar('ups.status');
74}
75
76sub Temperature { # get the internal temperature of UPS
77	return shift->GetVar('battery.temperature');
78}
79
80# control functions: they control our relationship to upsd, and send
81# commands to upsd.
82
83sub Login { # login to upsd, so that it won't shutdown unless we say we're
84            # ok.  This should only be used if you're actually connected
85            # to the ups that upsd is monitoring.
86
87# Author: Kit Peters
88# ### changelog: modified login logic a bit.  Now it doesn't check to see
89# ### changelog: if we got OK, ERR, or something else from upsd.  It
90# ### changelog: simply checks for a response beginning with OK from upsd.
91# ### changelog: Anything else is an error.
92#
93# ### changelog: uses the new _send command
94#
95  my $self = shift; # myself
96  my $user = shift; # username
97  my $pass = shift; # password
98  my $errmsg; # error message, sent to _debug and $self->{err}
99  my $ans; # scalar to hold responses from upsd
100
101  $self->Authenticate($user, $pass) or return;
102  $ans = $self->_send( "LOGIN $self->{name}" );
103  if (defined $ans && $ans =~ /^OK/) { # Login successful.
104    $self->_debug("LOGIN successful.");
105    return 1;
106  }
107  if (defined $ans) {
108      $errmsg = "LOGIN failed. Last message from upsd: $ans";
109  }
110  else {
111      $errmsg = "Network error: $!";
112  }
113  $self->_debug($self->{err} = $errmsg);
114  return undef;
115}
116
117sub Authenticate { # Announce to the UPS who we are to set up the proper
118                   # management level.  See upsd.conf man page for details.
119
120# Contributor: Wayne Wylupski
121  my $self = shift; # myself
122  my $user = shift; # username
123  my $pass = shift; # password
124
125  my $errmsg; # error message, sent to _debug and $self->{err}
126  my $ans; # scalar to hold responses from upsd
127
128  # only attempt authentication if username and password given
129  if (defined $user and defined $pass) {
130    $ans = $self->_send("USERNAME $user");
131    if (defined $ans && $ans =~ /^OK/) { # username OK, send password
132
133      $ans = $self->_send("PASSWORD $pass");
134      return 1 if (defined $ans && $ans =~ /^OK/);
135    }
136  }
137  if (defined $ans) {
138      $errmsg = "Authentication failed. Last message from upsd: $ans";
139  }
140  else {
141      $errmsg = "Network error: $!";
142  }
143  $self->_debug($self->{err} = $errmsg);
144  return undef;
145}
146
147sub Logout { # logout of upsd
148# Author: Kit Peters
149# ### changelog: uses the new _send command
150#
151  my $self = shift;
152  if ($self->{srvsock}) { # are we still connected to upsd?
153    my $ans = $self->_send( "LOGOUT" );
154    close ($self->{srvsock});
155    delete ($self->{srvsock});
156  }
157}
158
159# internal functions.  These are only used by UPS::Nut internally, so
160# please don't use them otherwise.  If you really think an internal
161# function should be externalized, let me know.
162
163sub _initialize {
164# Author: Kit Peters
165  my $self = shift;
166  my %arg = @_;
167  my $host = $arg{HOST}     || 'localhost'; # Host running upsd and probably drivers
168  my $port = $arg{PORT}     || '3493'; # 3493 is IANA assigned port for NUT
169  my $proto = $arg{PROTO}   || 'tcp'; # use tcp unless user tells us to
170  my $user = $arg{USERNAME} || undef; # username passed to upsd
171  my $pass = $arg{PASSWORD} || undef; # password passed to upsd
172  my $login = $arg{LOGIN}   || 0; # login to upsd on init?
173
174
175  $self->{name} = $arg{NAME} || 'default'; # UPS name in etc/ups.conf on $host
176  $self->{timeout} = $arg{TIMEOUT} || 30; # timeout
177  $self->{debug} = $arg{DEBUG} || 0; # debugging?
178  $self->{debugout} = $arg{DEBUGOUT} || undef; # where to send debug messages
179
180  my $srvsock = $self->{srvsock} = # establish connection to upsd
181    IO::Socket::INET->new(
182      PeerAddr => $host,
183      PeerPort => $port,
184      Proto    => $proto
185    );
186
187  unless ( defined $srvsock) { # can't connect
188    $self->{err} = "Unable to connect via $proto to $host:$port: $!";
189    return undef;
190  }
191
192  $self->{select} = IO::Select->new( $srvsock );
193
194  if ($user and $pass) { # attempt login to upsd if that option is specified
195    if ($login) { # attempt login to upsd if that option is specified
196      $self->Login($user, $pass) or carp $self->{err};
197    }
198    else {
199      $self->Authenticate($user, $pass) or carp $self->{err};
200    }
201  }
202
203  # get a hash of vars for both the TIE functions as well as for
204  # expanding vars.
205  $self->{vars} = $self->ListVar;
206
207  unless ( defined $self->{vars} ) {
208    $self->{err} = "Network error: $!";
209    return undef;
210  }
211
212  return $self;
213}
214
215#
216# _send
217#
218# Sends a command to the server and retrieves the results.
219# If there was a network error, return undef; $! will contain the
220# error.
221sub _send
222{
223# Contributor: Wayne Wylupski
224    my $self = shift;
225    my $cmd = shift;
226    my @handles;
227    my $result;		# undef by default
228
229    my $socket = $self->{srvsock};
230    my $select = $self->{select};
231
232    @handles = IO::Select->select( undef, $select, $select, $self->{timeout} );
233    return undef if ( !scalar $handles[1] );
234
235    $socket->print( $cmd . $_eol );
236
237    @handles = IO::Select->select( $select, undef, $select, $self->{timeout} );
238    return undef if ( !scalar  $handles[0]);
239
240    $result = $socket->getline;
241    return undef if ( !defined ( $result ) );
242    chomp $result;
243
244    return $result;
245}
246
247sub _getline
248{
249# Contributor: Wayne Wylupski
250    my $self = shift;
251    my $result;		# undef by default
252
253    my $socket = $self->{srvsock};
254    my $select = $self->{select};
255
256    # Different versions of IO::Socket has different error detection routines.
257    return undef if ( $IO::Socket::{has_error} && $select->has_error(0) );
258    return undef if ( $IO::Socket::{has_exception} && $select->has_exception(0) );
259
260    chomp ( $result = $socket->getline );
261    return $result;
262}
263
264# Compatibility layer
265sub Request { goto &GetVar; }
266
267sub GetVar { # request a variable from the UPS
268# Author: Kit Peters
269  my $self = shift;
270# ### changelog: 8/3/2002 - KP - Request() now returns undef if not
271# ### changelog: connected to upsd via $srvsock
272# ### changelog: uses the new _send command
273#
274# Modified by Gabor Kiss according to protocol version 1.5+
275  my $var = shift;
276  my $req = "GET VAR $self->{name} $var"; # build request
277  my $ans = $self->_send( $req );
278
279  unless (defined $ans) {
280      $self->{err} = "Network error: $!";
281      return undef;
282  };
283
284  if ($ans =~ /^ERR/) {
285    $self->{err} = "Error: $ans.  Requested $var.";
286    return undef;
287  }
288  elsif ($ans =~ /^VAR/) {
289    my $checkvar; # to make sure the var we asked for is the var we got.
290    my $retval; # returned value for requested VAR
291    (undef, undef, $checkvar, $retval) = split(' ', $ans, 4);
292        # get checkvar and retval from the answer
293    if ($checkvar ne $var) { # did not get expected var
294      $self->{err} = "requested $var, received $checkvar";
295      return undef;
296    }
297    $retval =~ s/^"(.*)"$/$1/;
298    return $retval; # return the requested value
299  }
300  else { # unrecognized response
301    $self->{err} = "Unrecognized response from upsd: $ans";
302    return undef;
303  }
304}
305
306sub Set {
307# Contributor: Wayne Wylupski
308# ### changelog: uses the new _send command
309#
310  my $self = shift;
311  my $var = shift;
312  (my $value = shift) =~ s/^"?(.*)"?$/"$1"/;	# add quotes if missing
313
314  my $req = "SET VAR $self->{name} $var $value"; # build request
315  my $ans = $self->_send( $req );
316
317  unless (defined $ans) {
318      $self->{err} = "Network error: $!";
319      return undef;
320  };
321
322  if ($ans =~ /^ERR/) {
323    $self->{err} = "Error: $ans";
324    return undef;
325  }
326  elsif ($ans =~ /^OK/) {
327    return $value;
328  }
329  else { # unrecognized response
330    $self->{err} = "Unrecognized response from upsd: $ans";
331    return undef;
332  }
333}
334
335sub FSD { # set forced shutdown flag
336# Author: Kit Peters
337# ### changelog: uses the new _send command
338#
339  my $self = shift;
340
341  my $req = "FSD $self->{name}"; # build request
342  my $ans = $self->_send( $req );
343
344  unless (defined $ans) {
345      $self->{err} = "Network error: $!";
346      return undef;
347  };
348
349  if ($ans =~ /^ERR/) { # can't set forced shutdown flag
350    $self->{err} = "Can't set FSD flag.  Upsd reports: $ans";
351    return undef;
352  }
353  elsif ($ans =~ /^OK FSD-SET/) { # forced shutdown flag set
354    $self->_debug("FSD flag set successfully.");
355    return 1;
356  }
357  else {
358    $self->{err} = "Unrecognized response from upsd: $ans";
359    return undef;
360  }
361}
362
363sub InstCmd { # send instant command to ups
364# Contributor: Wayne Wylupski
365  my $self = shift;
366
367  chomp (my $cmd = shift);
368
369  my $req = "INSTCMD $self->{name} $cmd";
370  my $ans = $self->_send( $req );
371
372  unless (defined $ans) {
373      $self->{err} = "Network error: $!";
374      return undef;
375  };
376
377  if ($ans =~ /^ERR/) { # error reported from upsd
378    $self->{err} = "Can't send instant command $cmd. Reason: $ans";
379    return undef;
380  }
381  elsif ($ans =~ /^OK/) { # command successful
382    $self->_debug("Instant command $cmd sent successfully.");
383    return 1;
384  }
385  else { # unrecognized response
386    $self->{err} = "Can't send instant command $cmd. Unrecognized response from upsd: $ans";
387    return undef;
388  }
389}
390
391sub ListUPS {
392	my $self = shift;
393	return $self->_get_list("LIST UPS", 2, 1);
394}
395
396sub ListVar {
397	my $self = shift;
398	my $vars = $self->_get_list("LIST VAR $self->{name}", 3, 2);
399	return $vars unless @_;			# return all variables
400	return {map { $_ => $vars->{$_} } @_};	# return selected ones
401}
402
403sub ListRW {
404	my $self = shift;
405	return $self->_get_list("LIST RW $self->{name}", 3, 2);
406}
407
408sub ListCmd {
409	my $self = shift;
410	return $self->_get_list("LIST CMD $self->{name}", 2);
411}
412
413sub ListEnum {
414	my $self = shift;
415	my $var = shift;
416	return $self->_get_list("LIST ENUM $self->{name} $var", 3);
417}
418
419sub _get_list {
420	my $self = shift;
421	my ($req, $valueidx, $keyidx) = @_;
422	my $ans = $self->_send($req);
423
424	unless (defined $ans) {
425		$self->{err} = "Network error: $!";
426		return undef;
427	};
428
429	if ($ans =~ /^ERR/) {
430		$self->{err} = "Error: $ans";
431		return undef;
432	}
433	elsif ($ans =~ /^BEGIN LIST/) { # command successful
434		my $retval = $keyidx ? {} : [];
435		my $line;
436		while ($line = $self->_getline) {
437			last if $line =~ /^END LIST/;
438			my @fields = split(' ', $line, $valueidx+1);
439			(my $value = $fields[$valueidx]) =~ s/^"(.*)"$/$1/;
440			if ($keyidx) {
441				$retval->{$fields[$keyidx]} = $value;
442			}
443			else {
444				push(@$retval, $value);
445			}
446		}
447		unless ($line) {
448			$self->{err} = "Network error: $!";
449			return undef;
450		};
451		$self->_debug("$req command sent successfully.");
452		return $retval;
453	}
454	else { # unrecognized response
455		$self->{err} = "Can't send $req. Unrecognized response from upsd: $ans";
456		return undef;
457	}
458}
459
460# Compatibility layer
461sub VarDesc { goto &GetDesc; }
462
463sub GetDesc {
464# Contributor: Wayne Wylupski
465# Modified by Gabor Kiss according to protocol version 1.5+
466    my $self = shift;
467    my $var = shift;
468
469    my $req = "GET DESC $self->{name} $var";
470    my $ans = $self->_send( $req );
471    unless (defined $ans) {
472        $self->{err} = "Network error: $!";
473        return undef;
474    };
475
476    if ($ans =~ /^ERR/) {
477      $self->{err} = "Error: $ans";
478      return undef;
479    }
480    elsif ($ans =~ /^DESC/) { # command successful
481      $self->_debug("$req command sent successfully.");
482      (undef, undef, undef, $ans) = split(' ', $ans, 4);
483      $ans =~ s/^"(.*)"$/$1/;
484      return $ans;
485    }
486    else { # unrecognized response
487      $self->{err} = "Can't send $req. Unrecognized response from upsd: $ans";
488      return undef;
489    }
490}
491
492# Compatibility layer
493sub VarType { goto &GetType; }
494
495sub GetType {
496# Contributor: Wayne Wylupski
497# Modified by Gabor Kiss according to protocol version 1.5+
498    my $self = shift;
499    my $var = shift;
500
501    my $req = "GET TYPE $self->{name} $var";
502    my $ans = $self->_send( $req );
503    unless (defined $ans) {
504        $self->{err} = "Network error: $!";
505        return undef;
506    };
507
508    if ($ans =~ /^ERR/) {
509      $self->{err} = "Error: $ans";
510      return undef;
511    }
512    elsif ($ans =~ /^TYPE/) { # command successful
513      $self->_debug("$req command sent successfully.");
514      (undef, undef, undef, $ans) = split(' ', $ans, 4);
515      return $ans;
516    }
517    else { # unrecognized response
518      $self->{err} = "Can't send $req. Unrecognized response from upsd: $ans";
519      return undef;
520    }
521}
522
523# Compatibility layer
524sub InstCmdDesc { goto &GetCmdDesc; }
525
526sub GetCmdDesc {
527# Contributor: Wayne Wylupski
528# Modified by Gabor Kiss according to protocol version 1.5+
529    my $self = shift;
530    my $cmd = shift;
531
532    my $req = "GET CMDDESC $self->{name} $cmd";
533    my $ans = $self->_send( $req );
534    unless (defined $ans) {
535        $self->{err} = "Network error: $!";
536        return undef;
537    };
538
539    if ($ans =~ /^ERR/) {
540      $self->{err} = "Error: $ans";
541      return undef;
542    }
543    elsif ($ans =~ /^DESC/) { # command successful
544      $self->_debug("$req command sent successfully.");
545      (undef, undef, undef, $ans) = split(' ', $ans, 4);
546      $ans =~ s/^"(.*)"$/$1/;
547      return $ans;
548    }
549    else { # unrecognized response
550      $self->{err} = "Can't send $req. Unrecognized response from upsd: $ans";
551      return undef;
552    }
553}
554
555sub DESTROY { # destructor, all it does is call Logout
556# Author: Kit Peters
557  my $self = shift;
558  $self->_debug("Object destroyed.");
559  $self->Logout();
560}
561
562sub _debug { # print debug messages to stdout or file
563# Author: Kit Peters
564  my $self = shift;
565  if ($self->{debug}) {
566    chomp (my $msg = shift);
567    my $out; # filehandle for output
568    if ($self->{debugout}) { # if filename is given, use that
569      $out = new FileHandle ($self->{debugout}, ">>") or warn "Error: $!";
570    }
571    if ($out) { # if out was set to a filehandle, create nifty timestamp
572      my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime();
573      $year = sprintf("%02d", $year % 100); # Y2.1K compliant, even!
574      my $timestamp = join '/', ($mon + 1), $mday, $year; # today
575      $timestamp .= " ";
576      $timestamp .= join ':', $hour, $min, $sec;
577      print $out "$timestamp $msg\n";
578    }
579    else { print "DEBUG: $msg\n"; } # otherwise, print to stdout
580  }
581}
582
583sub Error { # what was the last thing that went bang?
584# Author: Kit Peters
585  my $self = shift;
586  if ($self->{err}) { return $self->{err}; }
587  else { return "No error explanation available."; }
588}
589
590sub Master { # check for MASTER level access
591# Author: Kit Peters
592# ### changelog: uses the new _send command
593#
594# TODO: API change pending to replace MASTER with PRIMARY
595# (and backwards-compatible alias handling)
596  my $self = shift;
597
598  my $req = "MASTER $self->{name}"; # build request
599  my $ans = $self->_send( $req );
600
601  unless (defined $ans) {
602      $self->{err} = "Network error: $!";
603      return undef;
604  };
605
606  if ($ans =~ /^OK/) { # access granted
607    $self->_debug("MASTER level access granted.  Upsd reports: $ans");
608    return 1;
609  }
610  else { # access denied, or unrecognized reponse
611    $self->{err} = "MASTER level access denied.  Upsd responded: $ans";
612# ### changelog: 8/3/2002 - KP - Master() returns undef rather than 0 on
613# ### failure.  this makes it consistent with other methods
614    return undef;
615  }
616}
617
618sub AUTOLOAD {
619# Contributor: Wayne Wylupski
620    my $self = shift;
621    my $name = $UPS::Nut::AUTOLOAD;
622    $name =~ s/^.*:://;
623
624    # for a change we will only load cmds if needed.
625    if (!defined $self->{cmds} ) {
626        %{$self->{cmds}} = map{ $_ =>1 } @{$self->ListCmd};
627    }
628
629    croak "No such InstCmd: $name" if (! $self->{cmds}{$name} );
630
631    return $self->InstCmd( $name );
632}
633
634#-------------------------------------------------------------------------
635# tie hash interface
636#
637# The variables of the array, including the hidden 'numlogins' can
638# be accessed as a hash array through this method.
639#
640# Example:
641#  tie %ups, 'UPS::Nut',
642#      NAME => "myups",
643#      HOST => "somemachine.somewhere.com",
644#      ... # same options as new();
645#  ;
646#
647#  $ups{UPSIDENT} = "MyUPS";
648#  print $ups{MFR}, " " $ups{MODEL}, "\n";
649#
650#-------------------------------------------------------------------------
651sub TIEHASH {
652    my $class = shift || 'UPS::Nut';
653    return $class->new( @_ );
654}
655
656sub FETCH {
657    my $self = shift;
658    my $key = shift;
659
660    return $self->Request( $key );
661}
662
663sub STORE {
664    my $self = shift;
665    my $key = shift;
666    my $value = shift;
667
668    return $self->Set( $key, $value );
669}
670
671sub DELETE {
672    croak "DELETE operation not supported";
673}
674
675sub CLEAR {
676    croak "CLEAR operation not supported";
677}
678
679sub EXISTS {
680    exists shift->{vars}{shift};
681}
682
683sub FIRSTKEY {
684    my $self = shift;
685    my $a = keys %{$self->{vars}};
686    return scalar each %{$self->{vars}};
687}
688
689sub NEXTKEY {
690    my $self = shift;
691    return scalar each %{$self->{vars}};
692}
693
694sub UNTIE {
695    $_[0]->Logout;
696}
697
698=head1 NAME
699
700Nut - a module to talk to a UPS via NUT (Network UPS Tools) upsd
701
702=head1 SYNOPSIS
703
704 use UPS::Nut;
705
706 $ups = new UPS::Nut( NAME => "myups",
707                      HOST => "somemachine.somewhere.com",
708                      PORT => "3493",
709                      USERNAME => "upsuser",
710                      PASSWORD => "upspasswd",
711                      TIMEOUT => 30,
712                      DEBUG => 1,
713                      DEBUGOUT => "/some/file/somewhere",
714                    );
715 if ($ups->Status() =~ /OB/) {
716    print "Oh, no!  Power failure!\n";
717 }
718
719 tie %other_ups, 'UPS::Nut',
720     NAME => "myups",
721     HOST => "somemachine.somewhere.com",
722     ... # same options as new();
723 ;
724
725 print $other_ups{MFR}, " ", $other_ups{MODEL}, "\n";
726
727=head1 DESCRIPTION
728
729This is an object-oriented (whoo!) interface between Perl and upsd from
730the Network UPS Tools package version 1.5 and above
731(http://www.networkupstools.org/).
732Note that it only talks to upsd for you in a Perl-ish way.
733It doesn't monitor the UPS continously.
734
735=head1 CONSTRUCTOR
736
737Shown with defaults: new UPS::Nut( NAME => "default",
738                                   HOST => "localhost",
739                                   PORT => "3493",
740                                   USERNAME => "",
741                                   PASSWORD => "",
742                                   DEBUG => 0,
743                                   DEBUGOUT => "",
744                                 );
745* NAME is the name of the UPS to monitor, as specified in ups.conf
746* HOST is the host running upsd
747* PORT is the port that upsd is running on
748* USERNAME and PASSWORD are those that you use to login to upsd.  This
749  gives you the right to do certain things, as specified in upsd.conf.
750* DEBUG turns on debugging output, set to 1 or 0
751* DEBUGOUT is de thing you do when de s*** hits the fan.  Actually, it's
752  the filename where you want debugging output to go.  If it's not
753  specified, debugging output comes to standard output.
754
755=head1 Important notice
756
757This version of UPS::Nut is not compatible with version 0.04. It is totally
758rewritten in order to talk the new protocol of NUT 1.5+. You should not use
759this module as a drop-in replacement of previous version from 2002.
760Allmost all method has changed slightly.
761
762=head1 Methods
763
764Unlike in version 0.04 no methods return list values but a
765single reference or undef.
766
767=head2 Methods for querying UPS status
768
769=over 4
770
771=item Getvar($varname)
772
773returns value of the specified variable. Returns undef if variable
774unsupported.
775Old method named Request() is also supported for compatibility.
776
777=item Set($varname, $value)
778
779sets the value of the specified variable. Returns undef if variable
780unsupported, or if variable cannot be set for some other reason. See
781Authenticate() if you wish to use this function.
782
783=item BattPercent()
784
785returns percentage of battery left. Returns undef if we can't get
786battery percentage for some reason. Same as GetVar('battery.charge').
787
788=item LoadPercent($context)
789
790returns percentage of the load on the UPS. Returns undef if load
791percentage is unavailable. $context is a selector of 3 phase systems.
792Possibled values are 1, 2, 3, 'L1', 'L2', 'L3'. It should be omitted
793in case of single phase UPS.
794
795=item LineVoltage($context)
796
797returns input line (e.g. the outlet) voltage. Returns undef if line
798voltage is unavailable. $context is a selector of 3 phase systems.
799Possibled values are 1, 2, 3, 'L1', 'L2', 'L3'. It should be omitted
800in case of single phase UPS.
801
802=item Status()
803
804returns UPS status, one of OL or OB. OL or OB may be followed by LB,
805which signifies low battery state. OL or OB may also be followed by
806FSD, which denotes that the forced shutdown state
807( see UPS::Nut->FSD() ) has been set on upsd. Returns undef if status
808unavailable. Same as GetVar('ups.status').
809
810=item Temperature()
811
812returns UPS internal temperature. Returns undef if internal
813temperature unavailable. Same as GetVar('battery.temperature').
814
815=back
816
817=head2 Other methods
818
819These all operate on the UPS specified in the NAME argument to the
820constructor.
821
822=over 4
823
824=item Authenticate($username, $password)
825
826With NUT certain operations are only available if the user has the
827privilege. The program has to authenticate with one of the accounts
828defined in upsd.conf.
829
830=item Login($username, $password)
831
832Notify upsd that client is drawing power from the given UPS.
833It is automatically done if new() is called with USERNAME, PASSWORD
834and LOGIN parameters.
835
836=item Logout()
837
838Notify upsd that client is released UPS. (E.g. it is shutting down.)
839It is automatically done if connection closed.
840
841=item Master()
842
843Use this to find out whether or not we have MASTER privileges for
844this UPS. Returns 1 if we have MASTER privileges, returns 0 otherwise.
845
846TODO: API change pending to replace MASTER with PRIMARY
847(and backwards-compatible alias handling)
848
849=item ListVar($variable, ...)
850
851This is an implementation of "LIST VAR" command.
852Returns a hash reference to selected variable names and values supported
853by the UPS. If no variables given it returns all.
854Returns undef if "LIST VAR" failed.
855(Note: This method significally differs from the old ListVars()
856and ListRequest().)
857
858=item ListRW()
859
860Similar to ListVar() but cares only with read/writeable variables.
861
862=item ListEnum($variable)
863
864Returns a reference to the list of all possible values of $variable.
865List is empty if $variable is not an ENUM type. (See GetType().)
866Returns undef if error occurred.
867
868=item ListCmd()
869
870Returns a reference to the list of all instant commands supported
871by the UPS. Returns undef if these are unavailable.
872This method replaces the old ListInstCmds().
873
874=item InstCmd($command)
875
876Send an instant command to the UPS. Returns 1 on success. Returns
877undef if the command can't be completed.
878
879=item FSD()
880
881Set the FSD (forced shutdown) flag for the UPS. This means that we're
882planning on shutting down the UPS very soon, so the attached load should
883be shut down as well. Returns 1 on success, returns undef on failure.
884This cannot be unset, so don't set it unless you mean it.
885
886=item Error()
887
888why did the previous operation fail? The answer is here. It will
889return a concise, well-written, and brilliantly insightful few words as
890to why whatever you just did went bang.
891
892=item GetDesc($variable)
893
894Returns textual description of $variable or undef in case of error.
895Old method named VarDesc() is also supported for compatibility.
896
897=item GetCmdDesc($command)
898
899This is like GetDesc() above but applies to the instant commands.
900Old method named InstCmdDesc() is also supported for compatibility.
901
902=item GetType($variable)
903
904Returns a string UNKNOWN or constructed one or more words of RW,
905ENUM and STRING:n (where n is a number). (Seems to be not working
906perfectly at upsd 2.2.)
907Old method named VarType() is also supported for compatibility.
908
909=item ListUPS()
910
911Returns a reference to hash of all available UPS names and descriptions.
912
913=back
914
915=head1 AUTOLOAD
916
917The "instant commands" are available as methods of the UPS object. They
918are AUTOLOADed when called. For example, if the instant command is FPTEST,
919then it can be called by $ups->FPTEST.
920
921=head1 TIE Interface
922
923If you wish to simply query or set values, you can tie a hash value to
924UPS::Nut and pass as extra options what you need to connect to the host.
925If you need to exercise an occasional command, you may find the return
926value of 'tie' useful, as in:
927
928  my %ups;
929  my $ups_obj = tie %ups, 'UPS::Nut', HOSTNAME=>"firewall";
930
931  print $ups{UPSIDENT}, "\n";
932
933  $ups_obj->Authenticate( "user", "pass" );
934
935  $ups{UPSIDENT} = "MyUPS";
936
937=head1 AUTHOR
938
939  Original version made by Kit Peters
940  perl@clownswilleatyou.com
941  http://www.awod.com/staff/kpeters/perl/
942
943  Rewritten by Gabor Kiss <kissg@ssg.ki.iif.hu>.
944
945=head1 CREDITS
946
947Developed with the kind support of A World Of Difference, Inc.
948<http://www.awod.com/>
949
950Many thanks to Ryan Jessen <rjessen@cyberpowersystems.com> at CyberPower
951Systems for much-needed assistance.
952
953Thanks to Wayne Wylupski <wayne@connact.com> for the code to make
954accessor methods for all supported vars.
955
956=head1 LICENSE
957
958This module is distributed under the same license as Perl itself.
959
960=cut
961
9621;
963__END__
964
965