package Hardware::UPS::Perl::Utils; #============================================================================== # package description: #============================================================================== # This package supplies a set of usefull functions used in packages dealing # with an UPS. For a detailed description see the pod documentation # included at the end of this file. # # List of functions: # ------------------ # configure - configures options # error - dealing with errors # warning - dealing with warnings # #============================================================================== #============================================================================== # Copyright: #============================================================================== # Copyright (c) 2007 Christian Reile, . All # rights reserved. This program is free software; you can redistribute it # and/or modify it under the same terms as Perl itself. #============================================================================== #============================================================================== # Entries for Revision Control: #============================================================================== # Revision : $Revision: 1.8 $ # Author : $Author: creile $ # Last Modified On: $Date: 2007/04/14 09:37:26 $ # Status : $State: Exp $ #------------------------------------------------------------------------------ # Modifications : #------------------------------------------------------------------------------ # # $Log: Utils.pm,v $ # Revision 1.8 2007/04/14 09:37:26 creile # documentation update. # # Revision 1.7 2007/04/07 15:14:45 creile # adaptations to "best practices" style; # update of documentation. # # Revision 1.6 2007/03/03 21:15:53 creile # typing error removed. # # Revision 1.5 2007/02/05 20:37:31 creile # pod documentation revised. # # Revision 1.4 2007/02/04 14:01:32 creile # bug fix in pod documentation. # # Revision 1.3 2007/02/03 15:36:03 creile # package Hardware::UPS::Perl::General removed, as we # use OO PID files now; # update of pod documentation. # # Revision 1.2 2007/01/28 05:24:05 creile # bug fix concerning pod documentation. # # Revision 1.1 2007/01/28 04:17:41 creile # initial version. # # #============================================================================== #============================================================================== # module preamble: #============================================================================== use strict; BEGIN { use Exporter (); use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); $VERSION = sprintf( "%d.%02d", q$Revision: 1.8 $ =~ /(\d+)\.(\d+)/ ); @ISA = qw(Exporter); @EXPORT = qw(); @EXPORT_OK = qw( &configure &error &warning ); %EXPORT_TAGS = qw(); } #============================================================================== # end of module preamble #============================================================================== #============================================================================== # packages required: #------------------------------------------------------------------------------ # # Carp - warn of errors (from perspective of # caller) # #============================================================================== use Carp; #============================================================================== # public functions: #============================================================================== sub configure { # subroutine to configure the connection # # parameters: $actions (input) - anonymous hash; the action table # $arguments (input) - anonymous array; arguments supplied # input as hidden local variables my ($actions, $arguments) = @_ ; # hidden local variables my $opt; # current option my $arg; # current argument my @return; # return list of of builtin Perl function `grep' my @options; # the option list # processing options @options = keys %{$actions}; PROCESS_OPTIONS: while (@{$arguments}) { $opt = shift(@{$arguments}); @return = grep(/^$opt/, @options); if (1 != @return) { error("unknown or ambiguous option -- $opt"); } $arg = shift(@{$arguments}); $actions->{$return[0]}->($arg); } } # end of subroutine "configure" sub error { # subroutine to display internal error messages # # parameters: $errorMessage (input) - error message to be displayed # input as hidden local variable my $errorMessage = shift; # hidden local variables my $i = 1; # calling level my $method = (caller($i))[3]; # calling public method # determine calling subroutine METHOD: while ($method =~ /::_/) { $method = (caller(++$i))[3]; } # displaying error message and die croak("$method: $errorMessage"); } # end of subroutine "error" sub warning { # subroutine to display internal warning messages # # parameters: $warningMessage (input) - warning message to be displayed # input as hidden local variable my $warningMessage = shift; # hidden local variables my $i = 1; # calling level my $method = (caller($i))[3]; # calling public method # determine calling subroutine METHOD: while ($method =~ /::_/) { $method = (caller(++$i))[3]; } # displaying error message and continue carp("$method: $warningMessage"); } # end of subroutine "warning" #============================================================================== # package return: #============================================================================== 1; __END__ #============================================================================== # embedded pod documentation: #============================================================================== =pod =head1 NAME Hardware::UPS::Perl::Utils - utility functions for packages dealing with an UPS =head1 SYNOPSIS use Hardware::UPS::Perl::Utils qw( configure error warning ); =head1 DESCRIPTION B provides functions for packages dealing with an UPS. =head1 LIST OF FUNCTIONS =head2 configure =over 4 =item B configure - processes arguments =item B &configure($actions, \@arguments); =item B B processes arguments C<@arguments> using the action table C<$actions > being an anonymous hash of anonymous subroutines. =item B =over 4 =item C<< $actions >> the action table; supplies a set of anonymous subroutines to process the options. =item C<< $arguments >> anonymous array of arguments. =back =back =head2 error =over 4 =item B error - displays internal error messages and dies =item B &error($errorMessage); =item B B displays the error message $errorMessage with respect to the calling method and dies using C. =item B =over 4 =item C<< $errorMessage >> string; the error message. =back =item B L<"warning"> =back =head2 warning =over 4 =item B warning - displays internal error messages =item B &warning($warningMessage); =item B B displays the error message $warningMessage with respect to the calling method using C. =item B =over 4 =item C<< $warningMessage >> string; the warning message. =back =item B L<"error"> =back =head1 SEE ALSO Carp(3pm), Hardware::UPS::Perl::Connection(3pm), Hardware::UPS::Perl::Connection::Net(3pm), Hardware::UPS::Perl::Connection::Serial(3pm) Hardware::UPS::Perl::Constants(3pm), Hardware::UPS::Perl::Driver(3pm), Hardware::UPS::Perl::Driver::Megatec(3pm), Hardware::UPS::Perl::General(3pm), Hardware::UPS::Perl::Logging(3pm), Hardware::UPS::Perl::PID(3pm), =head1 NOTES B was inspired by the B program by Bernd Holzhauer, Ewww.cc-c.deE. The latest version of this program can be obtained from http://www.cc-c.de/german/linux/linux_usv.php Another great resource was the B site, which can be found at http://www.networkupstools.org B was developed using B on a B Linux distribution. =head1 BUGS There are plenty of them for sure. Maybe the embedded pod documentation has to be revised a little bit. Suggestions to improve B are welcome, though due to the lack of time it might take a while to incorporate them. =head1 AUTHOR Copyright (c) 2007 by Christian Reile, EChristian.Reile@t-online.deE. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. For further licensing details, please see the file COPYING in the distribution. =cut