package Hardware::UPS::Perl::Connection;
#==============================================================================
# package description:
#==============================================================================
# This package supplies a set of methods to load a connection. For a detailed
# description see the pod documentation included at the end of this file.
#
# List of public methods:
# -----------------------
# new - initializing a Hardware::UPS::Perl::Connection
# object
# setLogger - setting the current logger
# getLogger - getting the current logger
# setConnectionOptions - setting the connection options
# getConnectionOptions - getting the connection options
# setConnectionHandle - setting the connection handle
# getConnectionHandle - getting the current connection handle
# getErrorMessage - getting internal error messages
#
#==============================================================================
#==============================================================================
# Copyright:
#==============================================================================
# Copyright (c) 2007 Christian Reile, <Christian.Reile@t-online.de>. 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.6 $
# Author : $Author: creile $
# Last Modified On: $Date: 2007/04/17 19:45:01 $
# Status : $State: Exp $
#------------------------------------------------------------------------------
# Modifications :
#------------------------------------------------------------------------------
#
# $Log: Connection.pm,v $
# Revision 1.6 2007/04/17 19:45:01 creile
# missing import of Hardware::UPS::Perl::Logging added.
#
# Revision 1.5 2007/04/14 09:37:26 creile
# documentation update.
#
# Revision 1.4 2007/04/07 15:13:24 creile
# adaptations to "best practices" style;
# update of documentation.
#
# Revision 1.3 2007/03/13 17:17:23 creile
# options as anonymous hashes;
# reconnect fix.
#
# Revision 1.2 2007/03/03 21:22:45 creile
# new variable $UPSERROR added;
# "return undef" replaced by "return";
# adaptations to new Constants.pm;
# option "Connection" of method new() changed to "Type".
#
# Revision 1.1 2007/02/25 17:02:44 creile
# initial revision.
#
#
#==============================================================================
#==============================================================================
# module preamble:
#==============================================================================
use strict;
BEGIN {
use vars qw($VERSION @ISA);
$VERSION = sprintf( "%d.%02d", q$Revision: 1.6 $ =~ /(\d+)\.(\d+)/ );
@ISA = qw();
}
#==============================================================================
# end of module preamble
#==============================================================================
#==============================================================================
# packages required:
#------------------------------------------------------------------------------
#
# Hardware::UPS::Perl::General - importing Hardware::UPS::Perl variables
# and functions for scripts
# Hardware::UPS::Perl::Logging - importing Hardware::UPS::Perl methods
# dealing with logfiles
# Hardware::UPS::Perl::Utils - importing Hardware::UPS::Perl utility
# functions for packages
#
#==============================================================================
use Hardware::UPS::Perl::General qw(
$UPSERROR
);
use Hardware::UPS::Perl::Logging;
use Hardware::UPS::Perl::Utils qw(
error
);
#==============================================================================
# public methods:
#==============================================================================
sub new {
# public method to construct a connection object
#
# parameters: $class (input) - class
# $options (input) - anonymous hash; options
#
# The following option keys are recognized:
#
# Type ($) - string; the connection type to load; optional;
# Options ($) - anonymous array; the options of the connection to
# load; optional;
# Logger ($) - Hardware::UPS::Perl::Logging object; the logger to
# use; optional.
# input as hidden local variables
my $class = shift;
my $options = @_ ? shift : {};
# hidden local variables
my $self = {}; # referent to be blessed
my $option; # an option
my $refType; # a reference type
my $logger; # the logger object
my $connectionType; # the connection type
my $connectionOptions; # the connection options
# blessing connection object
bless $self, $class;
# checking options
$refType = ref($options);
if ($refType ne 'HASH') {
error("not a hash reference -- <$refType>");
}
# the logger; if we don't have one, we have to create our own with output
# on STDERR
$logger = delete $options->{Logger};
unless (defined $logger) {
$logger = Hardware::UPS::Perl::Logging->new()
or return;
}
$self->setLogger($logger);
# the connection options
$connectionOptions = delete $options->{Options};
if (defined $connectionOptions) {
$refType = ref($connectionOptions);
if ($refType ne 'HASH') {
error("no hash reference -- <$refType>");
}
}
else {
$connectionOptions = {};
}
# the connection type
$connectionType = delete $options->{Type};
# checking for misspelled options
foreach $option (keys %{$options}) {
error("option unknown -- $option");
}
# initializing the error message
$self->{errorMessage} = q{};
# setting the connection
$self->setConnectionOptions($connectionOptions);
if (defined $connectionType) {
$self->setConnectionHandle($connectionType)
or do {
$UPSERROR = $self->getErrorMessage();
return;
};
}
# returning blessed connection object
return $self;
} # end of public method "new"
sub DESTROY {
# the destructor will do nothing, actually
} # end of the destructor
sub getErrorMessage {
# public method to get the current error message
#
# parameters: $self (input) - referent to a connection object
# input as hidden local variable
my $self = shift;
# getting the error message
if (exists $self->{errorMessage}) {
return $self->{errorMessage};
}
else {
return;
}
} # end of public method "getErrorMessage"
sub getLogger {
# public method to get the logger
#
# parameters: $self (input) - referent to a connection object
# input as hidden local variable
my $self = shift;
# getting logger
if (exists $self->{logger}) {
return $self->{logger};
}
else {
return;
}
} # end of public method "getLogger"
sub setLogger {
# public method to set the logger
#
# parameters: $self (input) - referent to a connection object
# $logger (input) - the logging object
# input as hidden local variables
my $self = shift;
1 == @_ or error("usage: setLogger(LOGGER)");
my $logger = shift;
if (defined $logger) {
my $loggerRefType = ref($logger);
if ($loggerRefType ne 'Hardware::UPS::Perl::Logging') {
error("no logger -- <$loggerRefType>");
}
}
# getting old logger
my $oldLogger = $self->getLogger();
# setting the logger
$self->{logger} = $logger;
# returning old logger
return $oldLogger;
} # end of public method "setLogger"
sub getConnectionOptions {
# public method to get the options of the connection
#
# parameters: $self (input) - referent to a connection object
# input as hidden local variable
my $self = shift;
# getting connection options
if (exists $self->{options}) {
return $self->{options};
}
else {
return;
}
} # end of public method "getConnectionOptions"
sub setConnectionOptions {
# public method to set the options for connection to load
#
# parameters: $self (input) - referent to a connection object
# $options (input) - anonymous hash; the connection options
# input as hidden local variables
my $self = shift;
( (1 == @_) and (ref($_[0]) eq 'HASH'))
or error("usage: setConnectionOptions(\%options)");
my $options = shift;
# getting old connection options
my $oldConnectionOptions = $self->getConnectionOptions();
# setting connection options
$self->{options} = $options;
# returning old connection option
return $oldConnectionOptions;
} # end of public method "setConnectionOptions"
sub getConnectionHandle {
# public method to get the connection handle
#
# parameters: $self (input) - referent to a connection object
# input as hidden local variable
my $self = shift;
# getting connection handle
if (exists $self->{connection}) {
return $self->{connection};
}
else {
return;
}
} # end of public method "getConnectionHandle"
sub setConnectionHandle {
# public method to load the connection handle
#
# parameters: $self (input) - referent to a connection object
# $connection (input) - string; the name of the connection to
# load
# input as hidden local variables
my $self = shift;
(1 == @_) or error("usage: setConnectionHandle(connection)");
my $connection = shift;
# hidden local variables
my $connectionClass; # the connection class
my $connectionHandle; # the connection handle
# getting connection class, making allowance for case-insensitivity
$connectionClass =
"Hardware::UPS::Perl::Connection::".ucfirst(lc($connection));
eval qq{
use $connectionClass; # load the connection
};
# checking eval error
if ($@) {
$self->{errorMessage} = "eval failed -- $@";
return 0;
}
# setting up connection object
$connectionHandle = eval {
$connectionClass->new($self->getConnectionOptions())
};
if (!$connectionHandle or !ref($connectionHandle) or $@) {
$self->{errorMessage} = "$connectionClass initialisation failed -- $@";
return 0;
}
$self->{connection} = $connectionHandle;
return 1;
} # end of public method "setConnectionHandle"
sub connect {
# public method to connect to an UPA agent or the serial port an UPS
# resides
#
# parameters: $self (input) - referent to a connection object
# input as hidden local variable
my $self = shift;
# getting connection handle
my $connectionHandle = $self->getConnectionHandle();
if (!$connectionHandle->connect(@_)) {
$self->{errorMessage}
= "connection failed -- ".$connectionHandle->getErrorMessage();
return 0;
}
return 1;
} # end of public method "connect"
sub connected {
# public method to test the connection status
#
# parameters: $self (input) - referent to a connection object
# input as hidden local variable
my $self = shift;
# hidden local variables
my $connectionHandle; # the connection
# checking for connection
$connectionHandle = $self->getConnectionHandle();
if (defined $connectionHandle) {
return $connectionHandle->connected();
}
else {
return 0;
}
} # end of public method "connected"
sub disconnect {
# public method to disconnect from an UPS agent or the serial
# port a local UPS resides
#
# parameters: $self (input) - referent to an UPS object
# input as hidden local variable
my $self = shift;
# deleting connection if connected
if ($self->connected()) {
# deleting connection
$self->getConnectionHandle()->disconnect();
return 1;
}
else {
# error: UPS was not connected
$self->{errorMessage} = "not connected to UPS";
return 0;
}
} # end of public method "disconnect"
sub sendCommand {
# public method to send a command to the UPS and getting its response
#
# parameters: $self (input) - referent to an UPS object
# $command (input) - command sent to UPS
# $response (input) - response from UPS (anonymous reference)
# $responseSize (input) - size of response from UPS
# input as hidden local variable
my $self = shift;
my $command = shift;
my $response = shift;
my $responseSize = shift;
# hidden local variables
my $connectionHandle; # the connection
# getting connection
$connectionHandle = $self->getConnectionHandle();
unless (defined $connectionHandle) {
$self->{errorMessage} = "no connection handle available";
return 0;
}
# send message to UPS
if ($connectionHandle->sendCommand($command, $response, $responseSize)) {
return 1;
}
else {
$self->{errorMessage} = $connectionHandle->getErrorMessage();
return 0;
}
} # end of public method "sendCommand"
#==============================================================================
# package return:
#==============================================================================
1;
__END__
#==============================================================================
# embedded pod documentation:
#==============================================================================
=pod
=head1 NAME
Hardware::UPS::Perl::Connection - package of methods to load a
Hardware::UPS::Perl connection.
=head1 SYNOPSIS
use Hardware::UPS::Perl::Connection;
$connection = Hardware::UPS::Perl::Connection->new({
Type => "serial",
Options => \%options,
Logger => $Logger,
});
$connectionHandle = $connection->getConnectionHandle();
$connection = Hardware::UPS::Perl::Connection->new();
$connection->setConnectionOptions(\%options);
$connection->setLogger($Logger);
$connection->setConnectionHandle("serial");
$connectionHandle = $connection->getConnectionHandle();
=head1 DESCRIPTION
B<Hardware::UPS::Perl::Connection> provides methods to load a
Hardware::UPS::Perl connection into the namespace of the calling script.
=head1 LIST OF METHODS
=head2 new
=over 4
=item B<Name:>
new - creates a new connection object
=item B<Synopsis:>
$connection = Hardware::UPS::Perl::Connection->new();
$connection = Hardware::UPS::Perl::Connection->new({
Type => $connectionType,
Options => \%connectionOptions,
Logger => $Logger,
});
=item B<Description:>
B<new> initializes connection object used to load an existing
Hardware::UPS::Perl connection, i.e. a package below
B<Hardware::UPS::Perl::Connection>, into the namespace of the calling script.
B<new> expects the options as an anonymous hash.
=item B<Arguments:>
=over 4
=item C<< Type => $connectionType >>
optional; string; the connection type to load; the type is
case-insensitive.
=item C<< Options => \%connectionOptions >>
optional; anonymous hash; the options passed on to the connection to load.
=item C<< Logger => $logger >>
optional; a B<Hardware::UPS::Perl::Logging> object; defines a logger; if not
specified, a logger sending its output to F<STDERR> is created.
=back
=item B<See Also:>
L<"getConnectionHandle">,
L<"getConnectionOptions">,
L<"getLogger">,
L<"setConnectionHandle">,
L<"setConnectionOptions">,
L<"setLogger">
=back
=head2 setLogger
=over 4
=item B<Name:>
setLogger - sets the logger to use
=item B<Synopsis:>
$connection = Hardware::UPS::Perl::Connection->new();
$connection->setLogger($logger);
=item B<Description:>
B<setLogger> sets the logger, i.e. a B<Hardware::UPS::Perl::Logging> object
used for logging. B<setLogger> returns the previous logger used.
=item B<Arguments:>
=over 4
=item C<$logger>
required; a B<Hardware::UPS::Perl:Logging> object; defines the logger for
logging.
=back
=item B<See Also:>
L<"new">,
L<"getLogger">
=back
=head2 getLogger
=over 4
=item B<Name:>
getLogger - gets the current logger for logging
=item B<Synopsis:>
$connection = Hardware::UPS::Perl::Connection->new();
$logger = $connection->getLogger();
=item B<Description:>
B<getLogger> returns the current logger, a B<Hardware::UPS::Perl::Logging>
object used for logging, if defined, undef otherwise.
=item B<See Also:>
L<"new">,
L<"setLogger">
=back
=head2 setConnectionOptions
=over 4
=item B<Name:>
setConnectionOptions - sets the connection options for a new connection handle
=item B<Synopsis:>
$connection = Hardware::UPS::Perl::Connection->new();
$connection->setConnectionOptions(\%connectionOptions);
=item B<Description:>
B<setConnectionOptions> sets the options of the connection.
B<setConnectionoptions> returns an anonymous array of the connection options
previously used. The connection options are not promoted to the current
connection handle so far.
=item B<Arguments:>
=over 4
=item C<\%connectionOptions>
required; an anonymous hash; defines the options used to create a new
connection handle.
=back
=item B<See Also:>
L<"new">,
L<"getConnectionOptions">,
L<"getConnectionHandle">,
L<"setConnectionHandle">
=back
=head2 getConnectionOptions
=over 4
=item B<Name:>
getConnectionOptions - gets the connection options for a new connection handle
=item B<Synopsis:>
$connection = Hardware::UPS::Perl::Connection->new();
$connection->getConnectionOptions();
=item B<Description:>
B<getConnectionOptions> returns the options, an anonymous array, currently
used for the connection handle.
=item B<See Also:>
L<"new">,
L<"getConnectionHandle">,
L<"setConnectionHandle">,
L<"setConnectionOptions">
=back
=head2 setConnection
=over 4
=item B<Name:>
setConnectionHandle - sets the connection
=item B<Synopsis:>
$connection = Hardware::UPS::Perl::Connection->new();
$connection->setConnectionOptions(\%connectionOptions);
$connection->setConnectionHandle("Serial");
=item B<Description:>
B<setConnectionHandle> sets the UPS connection, i.e. defines the connection
package below F<Hardware::UPS::Perl::Connection>. It returns 1 on success, and
0, if something went wrong setting the internal error message.
=item B<Arguments:>
=over 4
=item C<$connection>
required; string; the case-insensitive name of the connection, i.e. it defines
the connection package F<Hardware::UPS::Perl::Connection::C<$connection>> to
use to connect to the UPS.
=back
=item B<See Also:>
L<"new">,
L<"getConnectionHandle">,
L<"getConnectionOptions">,
L<"getErrorMessage">
=back
=head2 getConnectionHandle
=over 4
=item B<Name:>
getConnectionHandle - gets the UPS connection
=item B<Synopsis:>
$connection = Hardware::UPS::Perl::Connection->new();
$connection->setConnectionOptions(\%connectionOptions);
$connection->setConnectionHandle("Net");
# a Hardware::UPS::Perl:Connection::Net object
$ups = $connection->getConnectionHandle();
$connection = Hardware::UPS::Perl::Connection->new({
Connection => "Serial",
Options => \%connectionOptions,
});
# a Hardware::UPS::Perl:Connection::Serial object
$ups = $connection->getConnectionHandle();
=item B<Description:>
B<getConnectionHandle> returns the current UPS connection, i.e. it loads the
object required to coonect to the UPS into the namespace of the calling
script.
=item B<See Also:>
L<"new">,
L<"getConnectionOptions">,
L<"setConnectionHandle">,
L<"setConnectionOptions">
=back
=head2 getErrorMessage
=over 4
=item B<Name:>
getErrorMessage - gets the internal error message
=item B<Synopsis:>
$connection = Hardware::UPS::Perl::Connection->new();
if (!$connection->setConnectionHandle("serial")) {
print STDERR $connection->getErrorMessage(), "\n";
exit 1;
}
=item B<Description:>
B<getErrorMessage> returns the internal error message, if something went
wrong.
=back
=head1 SEE ALSO
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),
Hardware::UPS::Perl::Utils(3pm)
=head1 NOTES
B<Hardware::UPS::Perl::Connection> was inspired by the Perl5 extension package
B<DBI>.
Another great resource was the B<Network UPS Tools> site, which can be found
at
http://www.networkupstools.org
B<Hardware::UPS::Perl::Connection> was developed using B<perl 5.8.8> on a
B<SuSE 10.1> 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<Hardware::UPS::Perl::Connection> 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, E<lt>Christian.Reile@t-online.deE<gt>.
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