Hardware::UPS::Perl::Connection::Serial - package of methods dealing with

    use Hardware::UPS::Perl::Connection::Serial;

    $port   = '/dev/ttyS0';
    $serial = new Hardware::UPS::Perl::Connection::Serial $port;

    undef $serial;                        # disconnects

   http://www.cc-c.de/german/linux/linux_usv.php

   http://www.networkupstools.org

package Hardware::UPS::Perl::Connection::Serial;

#==============================================================================
# package description:
#==============================================================================
# This package supplies a set of methods to connect to a serial port. For a
# detailed description see the pod documentation included at the end of this
# file.
#
# List of public methods:
# -----------------------
#   new                     - initializing a serial object
#   setPort                 - setting the serial port to connected to
#   getPort                 - getting the serial port connected to
#   setDebugLevel           - setting the debug level
#   getDebugLevel           - getting the debug level
#   setLogger               - setting the current logger
#   getLogger               - getting the current logger
#   getErrorMessage         - getting the error message
#   connect                 - connecting to serial port
#   connected               - connection status to serial port
#   disconnect              - disconnecting from serial port
#   sendCommand             - sending a command to the serial port
#
#==============================================================================

#==============================================================================
# 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.12 $
# Author          : $Author: creile $
# Last Modified On: $Date: 2007/04/14 09:37:26 $
# Status          : $State: Exp $
#------------------------------------------------------------------------------
# Modifications   :
#------------------------------------------------------------------------------
#
#   $Log: Serial.pm,v $
#   Revision 1.12  2007/04/14 09:37:26  creile
#   documentation update.
#
#   Revision 1.11  2007/04/07 15:12:44  creile
#   adaptations to "best practices" style;
#   update of documentation.
#
#   Revision 1.10  2007/03/13 17:11:18  creile
#   usage of Perl pragma constant for ENDCHAR and
#   READ_TIMEOUT instead of variables;
#   options as anonymous hashes.
#
#   Revision 1.9  2007/03/03 21:23:31  creile
#   new variable $UPSERROR added;
#   "return undef" replaced by "return";
#   adaptations to new Constants.pm.
#
#   Revision 1.8  2007/02/25 17:09:17  creile
#   option handling redesigned.
#
#   Revision 1.7  2007/02/06 16:55:01  creile
#   renamed to Hardware::UPS::Perl::Connection::Serial.
#
#   Revision 1.6  2007/02/05 20:37:09  creile
#   pod documentation revised.
#
#   Revision 1.5  2007/02/04 14:01:53  creile
#   bug fix in pod documentation.
#
#   Revision 1.4  2007/02/04 06:13:01  creile
#   documentation revised.
#
#   Revision 1.3  2007/02/03 22:05:23  creile
#   logging support added;
#   serial port will be locked using flock();
#   read timeout of serial port raised to 2;
#   options for method new() revised;
#   select() in method sendCommand() ignores error EINTR now;
#   update of documentation.
#
#   Revision 1.2  2007/01/28 05:23:15  creile
#   bug fix concerning pod documentation.
#
#   Revision 1.1  2007/01/27 16:03:23  creile
#   initial revision.
#
#
#==============================================================================

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

use strict;

BEGIN {

    use vars qw($VERSION @ISA);

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

    @ISA     = qw();

}

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

#==============================================================================
# packages required:
#------------------------------------------------------------------------------
#
#   constant                        - Perl pragma to declare constants
#   Errno                           - System errno constants
#   Fcntl                           - load the C Fcntl.h defines
#   FileHandle                      - supply object methods for filehandles
#   IO::Select                      - OO interface to the select system call
#   IO::Stty                        - setting terminal parameters
#
#   Hardware::UPS::Perl::Constants  - importing Hardware::UPS::Perl constants
#   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 Errno qw(
    EINTR
);
use Fcntl qw(
    :DEFAULT
    :flock
);
use FileHandle;
use IO::Select;
use IO::Stty;

use Hardware::UPS::Perl::Constants qw(
    UPSPORT
);
use Hardware::UPS::Perl::General qw(
    $UPSERROR
);
use Hardware::UPS::Perl::Logging;
use Hardware::UPS::Perl::Utils qw(
    error
);

#==============================================================================
# defining constants:
#------------------------------------------------------------------------------
# 
#   ENDCHAR                         - the end character
#   READ_TIMEOUT                    - timeout for reading from serial port in
#                                     seconds
#
#==============================================================================

use constant ENDCHAR        => "\r";
use constant READ_TIMEOUT   =>    2;     

#==============================================================================
# public methods:
#==============================================================================

sub new {

    # public method to construct a serial object
    #
    # parameters: $class   (input) - class
    #             $options (input) - anonymous hash; options
    #
    # The following bare argument is recognized
    #
    #   $port           - the serial port the UPS resides
    #
    # The following option keys are recognized:
    #
    #   SerialPort  ($) - the serial port the UPS resides; 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 $optionRefType;      # the reference type of the option input
    my $port;               # the serial port
    my $logger;             # the logger object
    my $option;             # an option

    # blessing serial connection object
    bless $self, $class;

    # checking options
    $optionRefType = ref($options);

    if (!$optionRefType) {

        # just the serial port has been specified
        $port   = $options;

        # we have no logger, so we have to create one with output on STDERR
        $logger = Hardware::UPS::Perl::Logging->new()
            or return;

    }
    elsif ($optionRefType eq 'HASH') {

        # the logger; if we don't have one, we have to create our own with
        # output on STDERR
        $logger = delete $options->{Logger};

        if (!defined $logger) {
            $logger = Hardware::UPS::Perl::Logging->new()
                or return;
        }

        # the serial port
        $port = delete $options->{SerialPort};

        # checking for misspelled options
        foreach $option (keys %{$options}) {
            error("option unknown -- $option");
        }

    }
    else {
        error("not a hash reference -- <$optionRefType>");
    }

    # initializing
    #
    # the error message
    $self->{errorMessage} = q{};

    # the logger
    $self->setLogger($logger);

    # the debug level 
    $self->setDebugLevel(0);

    # opening connection to serial port, if a port was specified
    if (defined $port) {
        $self->connect($port)
           or   do {
                    $UPSERROR = $self->getErrorMessage();
                    return;
                };
    }

    # returning blessed serial object
    return $self;

} # end of public method "new"

sub DESTROY {

    # the destructor will disconnect from the serial port if connected
    #
    # parameters: $self (input) - referent to a serial object

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

    # disconnect from serial port
    $self->disconnect();

} # end of the destructor

sub setPort {

    # public method to set the serial port to connect to
    #
    # parameters: $self (input) - referent to a serial object
    #             $port (input) - the serial port

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

    # checking for port
    @_ == 1 or error("usage: setPort(PORT)");
    my $port = shift;

    # getting old port
    my $oldPort = $self->getPort();

    # setting port
    $self->{port} = $port;

    # returning old port
    return $oldPort;

} # end of public method "setPort"

sub getPort {

    # public method to get the serial port connected to
    #
    # parameters: $self (input) - referent to a serial object

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

    # getting port
    if (exists $self->{port}) {
        return $self->{port};
    }
    else {
        return;
    }

} # end of public method "getPort"

sub setDebugLevel {

    # public method to set the debug level, the higher, the better
    #
    # parameters: $self       (input) - referent to a serial object
    #             $debugLevel (input) - the debug level

    # input as hidden local variables
    my $self       = shift;

    @_ == 1 or error("usage: setDebugLevel(debugLevel)");
    my $debugLevel = shift;

    # getting old debug level
    my $oldDebugLevel = $self->getDebugLevel();

    # setting debug level
    $self->{debugLevel} = $debugLevel;

    # returning old debug level
    return $oldDebugLevel;

} # end of public method "setDebugLevel"

sub getDebugLevel {

    # public method to get the current debug level
    #
    # parameters: $self (input) - referent to a serial object

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

    # getting debug level
    if (exists $self->{debugLevel}) {
        return $self->{debugLevel};
    }
    else {
        return;
    }

} # end of public method "getDebugLevel"

sub setLogger {

    # public method to set the logger
    #
    # parameters: $self   (input) - referent to a serial 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 logger
    $self->{logger} = $logger;

    # returning old logger
    return $oldLogger;

} # end of public method "setLogger"

sub getLogger {

    # public method to get the logger
    #
    # parameters: $self (input) - referent to a serial 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 getErrorMessage {

    # public method to get the current error message
    #
    # parameters: $self (input) - referent to a serial connection object

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

    # getting error message
    if (exists $self->{errorMessage} ) {
        return $self->{errorMessage};
    }
    else {
        return;
    }

} # end of public method "getErrorMessage"

sub connect {

    # public method to connect to a serial port
    #
    # parameters: $self (input) - referent to a serial object
    #             $port (input) - the serial port (optional)

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

    # hidden local variables
    my $port;               # the actual serial port
    my $oldPort;            # the previous serial port

    # checking for port
    @_ >= 0 and @_ <= 1 or error("usage: connect [PORT]");

    if ( @_ ) {

        $port = shift;
        $port = UPSPORT unless (defined $port);

        # already connected ?
        if ($self->connected()) {

            $oldPort = $self->getPort();

            if ( $oldPort ne $port ) {
                # different port
                $self->setPort($port);
                $self->disconnect();
            }
            else {
                $self->{errorMessage} = "serial port already connected";
                return 0;
            }

        }
        else {
            $self->setPort($port);
        }

    }
    else {

        if (defined $self->getPort()) {
            # already connected ?
            if ($self->connected()) {
                $self->{errorMessage} = "serial port already connected";
                return 0;
            }
            $port = $self->getPort();
        }
        else {
            $port = UPSPORT;
            $self->setPort($port);
        }
    }

    # opening file handle for serial port and locking it
    my $com_fh = new FileHandle $port, O_RDWR | O_NOCTTY | O_EXCL | O_NONBLOCK;

    unless (defined $com_fh) {
        $self->{errorMessage} = "cannot open serial port $port -- $!";
        return 0;
    }

    # locking serial port
    if (!flock($com_fh, LOCK_EX | LOCK_NB)) {
        $self->{errorMessage} = "serial port $port already in use -- $!";
        return 0;
    }

    $com_fh->autoflush();

    # setting properties of the serial port
    $self->{_oldSettings} = IO::Stty::stty(\*$com_fh, '-g');
    IO::Stty::stty(\*$com_fh, qw(2400 ixon -echo));

    $self->{_connection}  = $com_fh;

    return 1;

} # end of public method "connect"

sub connected {

    # public method to test the connection status
    #
    # parameters: $self (input) - referent to a serial object

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

    # checking for connection
    if (exists $self->{_connection}) {
        return $self->{_connection}->opened();
    }
    else {
        return 0;
    }

} # end of public method "connected"

sub disconnect {

    # public method to disconnect from the serial port
    #
    # parameters: $self (input) - referent to a serial object

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

    # deleting connection if connected
    if ($self->connected()) {

        # deleting connection
        my $com_fh = delete $self->{_connection};

        # unlocking
        flock($com_fh, LOCK_UN);

        # restoring properties of the serial port
        IO::Stty::stty(\*$com_fh, $self->{_oldSettings});

        # closing file handle
        undef $com_fh;

        return 1;

    }
    else {

        # error: no connection to serial port
        $self->{errorMessage} = "not connected to serial port";

        return 0;
    }

} # end of public method "disconnect"

sub sendCommand {

    # public method to send a command to the serial port and getting its
    # response
    #
    # parameters: $self         (input) - referent to a serial object
    #             $command      (input) - command sent to the serial port
    #             $response     (input) - response from the serial port
    #                                     (anonymous reference)
    #             $responseSize (input) - size of response from serial port
    #                                     (anonymous reference)

    # input as hidden local variable
    my $self         = shift;
    my $command      = shift;
    my $response     = shift;
    my $responseSize = shift;

    # hidden local variables
    my $com_fh;                         # the file handle of the connection
    my $selectObject;                   # the select object associated with the connection
    my $reader;                         # the reader
    my $answer;                         # the answer
    my $received = q{};                 # the total message received
    my $receivedSize = 0;               # the size of the total message
    my $logger = $self->getLogger();    # the logger

    # getting filehandle
    if (!$self->connected()) {
        $self->{errorMessage} = "not connected to serial port";
        return 0;
    }
    $com_fh = $self->{_connection};

    # send message to UPS
    $com_fh->syswrite($command.ENDCHAR);

    # reading response from the UPS
    $selectObject = IO::Select->new($com_fh);

    SELECT:
    while ($selectObject) {
        $! = 0;

        $reader = IO::Select->select($selectObject, undef, undef, READ_TIMEOUT)
            or  do {
                    if ($!) {
                        if (EINTR != $!) {
                            $self->{errorMessage} = "select failed -- $!";
                            return 0;
                        }
                    }
                    else {
                        last SELECT;
                    }
                };

        if ($reader) {

            my $nfound = $com_fh->sysread($answer, $responseSize);
            if (!defined $nfound) {
                $self->{errorMessage} = "sysread failed -- $!";
                return 0;
            }

            PROCESS_ANSWER:
            while ($answer =~ /(\n|\r)$/ ) {
                chop($answer);
                $nfound -= 1;
            }

            $received     .= substr($answer, 0, $nfound);
            $receivedSize += $nfound;

            if (defined $logger and (3 < $self->getDebugLevel()) ) {
                $logger->debug(
                    "sysread: size = <$receivedSize>, received = <$received>"
                );
            }
            $selectObject = undef if (!$nfound);
        }
    }

    # was the response complete ?
    if ($receivedSize != $responseSize) {
        $self->{errorMessage}
            = "response incomplete -- "
            . "received <$receivedSize> <=> expected <$responseSize>";
        return 0;
    }

    # setting response
    $$response = $received;

    # sending result to log file
    if (defined $logger and (2 < $self->getDebugLevel())) {
        $logger->debug("command <$command> => received <$received>");
    }

    return 1;

} # end of public method "sendCommand"

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

__END__

#==============================================================================
# embedded pod documentation:
#==============================================================================