File Coverage

blib/lib/Hardware/UPS/Perl/General.pm

Criterion	Covered	Total	%
statement	29	137	21.1
branch	0	36	0.0
condition			n/a
subroutine	9	20	45.0
pod			n/a
total	38	193	19.6

package Hardware::UPS::Perl::General;

#==============================================================================
# package description:
#==============================================================================
# This package defines the following subroutines to be used in Perl scripts
# dealing with an UPS. For a detailed description see the pod documentation
# included at the end of this file.
#
# Variables:
# ----------
#   $UPSERROR       - the global error text
#
# Subroutines:
# ------------
#   &InitWE         - initializing working environment
#   &Catch          - signal handler
#   &Error          - displaying error messages and exit
#   &Warning        - displaying warning messages
#   &ManPage        - displaying man page of `UPSSCRIPT'
#   &Version        - displaying version information of `UPSSCRIPT'
#   &SetLogger      - setting the logger
#   &SetPID         - setting the PID object
#   &ConnectUPS     - connecting to the UPS
#
#==============================================================================

#==============================================================================
# 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.15 $
# Author          : $Author: creile $
# Last Modified On: $Date: 2007/04/17 19:46:00 $
# Status          : $State: Exp $
#------------------------------------------------------------------------------
# Modifications   :
#------------------------------------------------------------------------------
#
#   $Log: General.pm,v $
#   Revision 1.15  2007/04/17 19:46:00  creile
#   documentation bugfixes.
#
#   Revision 1.14  2007/04/14 09:37:26  creile
#   documentation update.
#
#   Revision 1.13  2007/04/07 15:18:20  creile
#   new function ConnectUPS() added;
#   adaptations to "best practices" style;
#   update of documentation.
#
#   Revision 1.12  2007/03/13 17:04:09  creile
#   new subroutines SetLogger() and SetPID();
#   prototypes removed;
#   restarting by catching signal HUP implemented.
#
#   Revision 1.11  2007/03/03 21:14:31  creile
#   new variable $UPSERROR added;
#   adaptations to revised Constants.pm.
#
#   Revision 1.10  2007/02/05 20:33:17  creile
#   pod documentation revised.
#
#   Revision 1.9  2007/02/04 19:10:25  creile
#   bug fix of pod documentation.
#
#   Revision 1.8  2007/02/04 14:03:31  creile
#   bug fix in pod documentation.
#
#   Revision 1.7  2007/02/03 16:03:58  creile
#   all variables moved to new package
#   Hardware::UPS::Perl::Constants;
#   subroutine SendMail() incorporated into new package
#   Hardware::UPs::Perl::Logging;
#   subroutines WritePIDFile() and DeletePIDFile() removed
#   because of OO PID file handling;
#   cleanup for unnecessary packages;
#   update of documentation.
#
#   Revision 1.6  2007/01/28 21:05:47  creile
#   exclusion of signal TERM from error handling in subroutine
#   &Catch().
#
#   Revision 1.5  2007/01/28 05:26:44  creile
#   bug fix concerning pod documentation.
#
#   Revision 1.4  2007/01/27 16:08:57  creile
#   rename to Hardware::UPS::Perl::General;
#   removal of unnecessary comments;
#   variables exported prepended by UPS.
#
#   Revision 1.3  2007/01/21 15:05:09  creile
#   some beautifications.
#
#   Revision 1.2  2007/01/20 16:05:34  creile
#   subroutine &SendMail() revised
#
#   Revision 1.1  2007/01/20 08:10:54  creile
#   initial revision
#
#
#==============================================================================

#==============================================================================
# module preamble:
#==============================================================================

use strict;

BEGIN {
    use Exporter ();
    use vars     qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);

    $VERSION     = sprintf( "%d.%02d", q$Revision: 1.15 $ =~ /(\d+)\.(\d+)/ );

    @ISA         = qw(Exporter);
    @EXPORT      = qw(
        $UPSERROR
        &InitWE
        &Catch
        &Error
        &Warning
        &ManPage
        &Version
        &SetPID
        &SetLogger
        &ConnectUPS
    );
    @EXPORT_OK   = qw();
    %EXPORT_TAGS = qw();

}

use vars @EXPORT, @EXPORT_OK;

#==============================================================================
# end of module preamble
#==============================================================================

#==============================================================================
# packages required:
#------------------------------------------------------------------------------
#
#   POSIX                           - Perl interface to IEEE Std 1003.1
#
#   Hardware::UPS::Perl::Connection - importing Hardware::UPS::Perl connection
#   Hardware::UPS::Perl::Constants  - importing Hardware::UPS::Perl constants
#   Hardware::UPS::Perl::Driver     - importing Hardware::UPS::Perl driver
#
#==============================================================================

use POSIX qw(
    :signal_h sigprocmask
);

use Hardware::UPS::Perl::Connection;
use Hardware::UPS::Perl::Constants qw(
    UPSEXECUTABLE
    UPSSCRIPT
);
use Hardware::UPS::Perl::Driver;

#==============================================================================
# defining exported variables:
#==============================================================================

$UPSERROR  = q{};

#==============================================================================
# defining user invisible package variables:
#------------------------------------------------------------------------------
#
#   @SCRIPTARGUMENTS                - list of arguments
#   $LOGGER                         - the logger object used
#   $PID                            - the PID object used
#
#==============================================================================

my @SCRIPTARGUMENTS = (
);

my $LOGGER          = undef;
my $PID             = undef;

#==============================================================================
# defining exported subroutines:
#==============================================================================

sub InitWE {

    # subroutine for initializing working environment for Perl scripts
    # dealing with an UPS

    # the argument list
    @SCRIPTARGUMENTS = @ARGV;

    # special signal case: hangup detected (restart)
    #
    # POSIX unmasks the sigprocmask properly
    my $sigset = POSIX::SigSet->new();
    my $action = POSIX::SigAction->new(\&Catch, $sigset, &POSIX::SA_NODEFER);

    POSIX::sigaction(&POSIX::SIGHUP, $action);

    # catching all other signals
    $SIG{ INT  } = \&Catch;     # Interrupt from keyboard
    $SIG{ QUIT } = \&Catch;     # Quit from keyboard
    $SIG{ PIPE } = \&Catch;     # Broken pipe: write to pipe with no readers
    $SIG{ TERM } = \&Catch;     # Termination signal

} # end of subroutine "InitWE"

sub Catch {

    # subroutine for catching signals and performing actions
    #
    # parameter: $signal (input) - signal to be caught

    # input as hidden local variable
    my $signal = shift;

    # hidden local variables
    my %signalHandler;      # the signal handler

    # setting up the signal handler
    %signalHandler = (
        HUP     =>  sub {   # restarting

                        # deactivate signals
                        DEACTIVATE:
                        for my $sig (qw(HUP INT QUIT PIPE TERM)) {
                            $SIG{$sig} = sub {};
                        }

                        # restoring signals
                        my $s = POSIX::SigSet->new();
                        my $t = POSIX::SigSet->new();
                        sigprocmask(SIG_BLOCK, $s, $t);

                        # deleting PID file
                        if (defined $PID) {
                            $PID->delete();
                        }

                        # restart
                        if (defined $LOGGER) {
                            $LOGGER->info("restarting ...")
                        }

                        exec ${\(UPSEXECUTABLE)} => @SCRIPTARGUMENTS
                            or Error("restart failed -- $!");

                    },
        TERM    =>  sub {   # normal exit
                        exit 0;
                    },
    );

    # signal handling
    if (exists $signalHandler{$signal}) {
        $signalHandler{$signal}->();
    }
    else {
        Error("caught a SIG$signal -- stopping execution");
    }

} # end of subroutine "Catch"

sub Error {

    # subroutine for displaying any error message, cleaning up and exit
    #
    # parameter: $errorMessage (input) - error message to be displayed

    # input as hidden local variable
    my $errorMessage = shift;

    # displaying error message
    print STDERR "${\(UPSSCRIPT)}: $errorMessage\n";

    # exiting with error
    exit 1;

} # end of subroutine "Error"

sub Warning {

    # subroutine for displaying a warning message to STDERR without exiting
    # the program
    #
    # parameter: $warningMessage (input) - warning message to be displayed

    # input as hidden local variable
    my $warningMessage = shift;

    # displaying warning message
    print STDERR "${\(UPSSCRIPT)}: $warningMessage\n";

} # end of subroutine "Warning"

sub ManPage {

    # subroutine for displaying the man page of the calling main program
    # and exiting without error

    # displaying man page
    CORE::system("pod2man $0 | groff -man -Tlatin1 | less");

    # exiting without error
    exit 0;

} # end of subroutine "ManPage"

sub Version {

    # subroutine for displaying the version information on the calling Perl
    # script and exiting without error
    #
    # parameter: $version     (input) - revision number
    #            $date        (input) - revison date
    #            $description (input) - short description of calling script

    # input as hidden local variables
    my $version     = shift;
    my $date        = shift;
    my $description = shift;

    # displaying version information
    print <
${\(UPSSCRIPT)}, $description

    Version $version, $date

    Copyright (c) 2007 by Christian Reile

    This is free software; you can redistribute it and/or modify it under the
    terms of the GNU General Public License as published by the Free Software
    Foundation.

    This program is distributed in the hope that it will be useful, but
    WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
    or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
    for more details.

${\(UPSSCRIPT)}: For help, type `${\(UPSSCRIPT)} -h' or `${\(UPSSCRIPT)} --help'.

EOF

    # exiting without error
    exit 0;

} # end of subroutine "Version"

sub SetLogger {

    # subroutine to set the logging object
    #
    # parameters: $logger (input) - the logger

    # input as hidden variable
    my $logger = shift;

    # hidden local variables
    my $refType;            # a reference type

    # checking logger
    if (defined $logger) {
        $refType = ref($logger);
        if ($refType ne "Hardware::UPS::Perl::Logging") {
            Error("no logger -- <$refType>");
        }
    }
    else {
        Error("no logger defined");
    }

    # setting logger
    $LOGGER = $logger;

} # end of subroutine "SetLogger"

sub SetPID {

    # subroutine to set the PID object
    #
    # parameters: $pidObject (input) - the PID object

    # input as hidden variable
    my $pidObject = shift;

    # hidden local variables
    my $refType;            # a reference type

    # checking logger
    if (defined $pidObject) {
        $refType = ref($pidObject);
        if ($refType ne "Hardware::UPS::Perl::PID") {
            Error("no PID object -- <$refType>");
        }
    }
    else {
        Error("no PID object defined");
    }

    # setting PID object
    $PID = $pidObject;

} # end of subroutine "SetPID"

sub ConnectUPS {

    # subroutine to connect to the UPS
    #
    # parameters: $options (input) - anonymous hash; options
    #
    # The following option keys are recognized:
    #
    #   Host        ($) - the remote host; string; optional
    #   TCPPort     ($) - the TCP port to use; required, if host is specified
    #   SerialPort  ($) - the serial port to use; required, if host is not
    #                     specified
    #   DebugLevel  ($) - the debug level; natural number; optional
    #   Driver      ($) - the driver; string; required
    #   Logger      ($) - Hardware::UPS::Perl::Logging object; the logger to
    #                     use; required

    # input as hidden local variable
    my $options = shift;

    # hidden local variables
    my $refType;            # a reference type
    my $host;               # the remote host
    my $port;               # the TCP or serial port
    my $debugLevel;         # the debug level
    my $driverName;         # the name of the driver to use
    my $logger;             # the logger to use
    my $connectionType;     # the connection type
    my $connectionOptions;  # the connection options
    my $connection;         # the connection object
    my $driver;             # the driver object
    my $ups;                # the UPS object

    # checking options
    $refType = ref($options);
    if ($refType ne 'HASH') {
        Error("not a hash reference -- <$refType>");
    }

    # processing options
    #
    # the host
    $host = delete $options->{Host};

    # the driver
    $driverName = delete $options->{Driver};
    if (!defined $driverName) {
        Error("driver missing");
    }

    # the debug level
    $debugLevel = delete $options->{DebugLevel};
    if (!defined $debugLevel) {
        $debugLevel = 0;
    }

    # the logger
    $logger = delete $options->{Logger};
    if (!defined $logger) {
        Error("logger missing");
    }

    # getting connection
    if (defined $host) {

        # remotely via TCP
        $connectionType    = "net";

        $port = delete $options->{TCPPort};
        if (!defined $port) {
            Error("TCP port missing");
        }

        $connectionOptions = {
            Host        => $host  ,
            TCPPort     => $port  ,
            Logger      => $logger,
        };

    }
    else {

        # locally via a serial port
        $connectionType    = "serial";

        $port = delete $options->{SerialPort};
        if (!defined $port) {
            Error("serial port missing");
        }

        $connectionOptions = {
            SerialPort  => $port  ,
            Logger      => $logger,
        };

    }

    # getting connection
    $connection = Hardware::UPS::Perl::Connection->new({
        Type    =>  $connectionType   ,
        Options =>  $connectionOptions,
        Logger  =>  $logger           ,
    });
    if (!defined $connection) {
        Error("creating connection failed -- $UPSERROR");
    }

    # getting driver
    $driver = Hardware::UPS::Perl::Driver->new({
        Driver      =>  $driverName,
        Options     =>  {
                            Connection  => $connection,
                            Logger      => $logger,
                        },
        Logger      =>  $logger,
    });
    if (!defined $driver) {
        Error("creating driver failed -- $UPSERROR");
    }

    # connecting to UPS
    $ups = $driver->getDriverHandle();
    if (!defined $ups) {
        Error("creating UPS object failed -- ".$driver->getErrorMessage());
    }

    # setting debug level
    $ups->setDebugLevel($debugLevel);

    # flushing UPS buffer
    $ups->flush();

    # returning UPS object
    return $ups;

} # end of subroutine "ConnectUPS"

#==============================================================================
# package return:
#==============================================================================
1;

__END__