File Coverage

blib/lib/Sys/Utmp.pm

Criterion	Covered	Total	%
statement	41	43	95.3
branch	5	10	50.0
condition	3	6	50.0
subroutine	11	11	100.0
pod	1	1	100.0
total	61	71	85.9

#*****************************************************************************
#*                                                                           *
#*                            Gellyfish Software                             *
#*                                                                           *
#*                                                                           *
#*****************************************************************************
#*                                                                           *
#*      MODULE      :  Sys::Utmp                                             *
#*                                                                           *
#*      AUTHOR      :  JNS                                                   *
#*                                                                           *
#*      DESCRIPTION :  Object(ish) interface to utmp information             *
#*                                                                           *
#*                                                                           *
#*****************************************************************************

package Sys::Utmp;

=head1 NAME

Sys::Utmp - Object(ish) Interface to UTMP files.

=head1 SYNOPSIS

  use Sys::Utmp;

  my $utmp = Sys::Utmp->new();

  while ( my $utent =  $utmp->getutent() )
  {
     if ( $utent->user_process )
     {
        print $utent->ut_user,"\n";
     }
   }

   $utmp->endutent;

See also examples/pwho in the distribution directory.

=head1 DESCRIPTION

Sys::Utmp provides a vaguely object oriented interface to the Unix user
accounting file ( sometimes /etc/utmp or /var/run/utmp).  Whilst it would
prefer to use the getutent() function from the systems C libraries it
will attempt to provide its own if they are missing.

This may not be the module that you are looking for - there is a User::Utmp
which provides a different procedural interface and may well be more complete
for your purposes.

=head2 METHODS

=over 4

=item new

The constructor of the class.  Arguments may be provided in Key => Value
pairs : it currently takes one argument 'Filename' which will set the file
which is to be used in place of that defined in _PATH_UTMP.

=item getutent

Iterates of the records in the utmp file returning a Sys::Utmp::Utent object
for each record in turn - the methods that are available on these objects
are descrived in the L documentation.  If called in a list
context it will return a list containing the elements of th Utent entry
rather than an object.  If the import flag ':fields' is used then constants
defining the indexes into this list will be defined, these are uppercase
versions of the methods described in L.

=item setutent

Rewinds the file pointer on the utmp filehandle so repeated searches can be
done.

=item endutent

Closes the file handle on the utmp file.

=item utmpname SCALAR filename

Sets the file that will be used in place of that defined in _PATH_UTMP.
It is not defined what will happen if this is done between two calls to
getutent() - it is recommended that endutent() is called first.

=back

=cut

use strict;
use warnings;
use Carp qw(croak);

require Exporter;
require DynaLoader;

use base qw(Exporter DynaLoader);

BEGIN
{
   our @constants = qw(
                   ACCOUNTING
                   BOOT_TIME
                   DEAD_PROCESS
                   EMPTY
                   INIT_PROCESS
                   LOGIN_PROCESS
                   NEW_TIME
                   OLD_TIME
                   RUN_LVL
                   USER_PROCESS
                  );
}

use Sys::Utmp::Utent;

BEGIN
{
   our %EXPORT_TAGS = (
                    'constants' => [ @Sys::Utmp::constants ],
                    'fields'    => [ @Sys::Utmp::Utent::EXPORT]
                  );

   our @EXPORT_OK = ( @{ $EXPORT_TAGS{'constants'} }, @{ $EXPORT_TAGS{'fields'}} );
}

our $VERSION = '1.8';

sub new {
    my ( $proto, %args ) = @_;

    my $self = {};
    my $class = ref($proto) || $proto;
    bless $self, $class;

    if ( exists $args{Filename} and -s $args{Filename} ) {
        $self->utmpname($args{Filename});
    }
    return $self;
}

our $AUTOLOAD;

sub AUTOLOAD {
    my ( $self ) = @_;

    my $constname;
    return if $AUTOLOAD =~ /DESTROY/;

    ($constname = $AUTOLOAD) =~ s/.*:://;
    croak "& not defined" if $constname eq 'constant';
    my $val = constant($constname, @_ ? $_[0] : 0);
    if ($! != 0) {
	    croak "Your vendor has not defined Sys::Utmp macro $constname";
    }
    {
	    no strict 'refs';
	    *{$AUTOLOAD} = sub { $val };
    }
    goto &$AUTOLOAD;
}


1;

bootstrap Sys::Utmp $VERSION;

__END__