r6057 - in /branches/upstream/libsys-utmp-perl: ./ current/ current/examples/ current/lib/ current/lib/Sys/ current/lib/Sys/Utmp/ current/t/
joeyh at users.alioth.debian.org
joeyh at users.alioth.debian.org
Mon Jul 30 05:13:22 UTC 2007
Author: joeyh
Date: Mon Jul 30 05:13:21 2007
New Revision: 6057
URL: http://svn.debian.org/wsvn/?sc=1&rev=6057
Log:
[svn-inject] Installing original source of libsys-utmp-perl
Added:
branches/upstream/libsys-utmp-perl/
branches/upstream/libsys-utmp-perl/current/
branches/upstream/libsys-utmp-perl/current/Changes
branches/upstream/libsys-utmp-perl/current/MANIFEST
branches/upstream/libsys-utmp-perl/current/MANIFEST.SKIP
branches/upstream/libsys-utmp-perl/current/META.yml
branches/upstream/libsys-utmp-perl/current/Makefile.PL (with props)
branches/upstream/libsys-utmp-perl/current/README
branches/upstream/libsys-utmp-perl/current/Utmp.xs
branches/upstream/libsys-utmp-perl/current/examples/
branches/upstream/libsys-utmp-perl/current/examples/pwho (with props)
branches/upstream/libsys-utmp-perl/current/lib/
branches/upstream/libsys-utmp-perl/current/lib/Sys/
branches/upstream/libsys-utmp-perl/current/lib/Sys/Utmp/
branches/upstream/libsys-utmp-perl/current/lib/Sys/Utmp.pm
branches/upstream/libsys-utmp-perl/current/lib/Sys/Utmp/Utent.pm
branches/upstream/libsys-utmp-perl/current/t/
branches/upstream/libsys-utmp-perl/current/t/01pod.t (with props)
branches/upstream/libsys-utmp-perl/current/t/02podcoverage.t (with props)
branches/upstream/libsys-utmp-perl/current/t/03utmp.t (with props)
branches/upstream/libsys-utmp-perl/current/t/04constants.t (with props)
branches/upstream/libsys-utmp-perl/current/t/05fields.t (with props)
branches/upstream/libsys-utmp-perl/current/t/06taint.t (with props)
branches/upstream/libsys-utmp-perl/current/t/07utent_methods.t (with props)
branches/upstream/libsys-utmp-perl/current/t/08utent_types.t (with props)
Added: branches/upstream/libsys-utmp-perl/current/Changes
URL: http://svn.debian.org/wsvn/branches/upstream/libsys-utmp-perl/current/Changes?rev=6057&op=file
==============================================================================
--- branches/upstream/libsys-utmp-perl/current/Changes (added)
+++ branches/upstream/libsys-utmp-perl/current/Changes Mon Jul 30 05:13:21 2007
@@ -1,0 +1,27 @@
+Revision history for Perl extension Sys::Utmp.
+
+1.1 Fri Feb 9 07:27:18 2001
+ - original version JNS
+
+1.3 Tue Mar 27 07:59:56 BST 2001
+ - Added utmpname() at the request of someone whose e-mail
+ I have subsequently lost.
+
+1.4 Mon Sep 10 08:12:37 BST 2001
+ - Fixed atrocious memory leak as reported by
+ Stuart Sharpe <stu at drazi.demon.co.uk>
+
+1.5 Fri Sep 14 08:21:38 BST 2001
+ - Having fixed the memory leak had introduced a coredump in
+ PL_sv_free :(
+ - Tainted ut_host as DNS might not be in our control.
+ - utmpname() was not backward compatible to 5.005
+ - added eg/pwho
+
+1.6 Fri Oct 13 16:00:24 BST 2006
+ - Changed layout of source code
+ - Fixed warnings with new gcc/perl
+ - UT_* constants weren't actually working
+ - Tainting wasn't working
+ - Improved test coverage
+ - Removed useless const code in .xs
Added: branches/upstream/libsys-utmp-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/branches/upstream/libsys-utmp-perl/current/MANIFEST?rev=6057&op=file
==============================================================================
--- branches/upstream/libsys-utmp-perl/current/MANIFEST (added)
+++ branches/upstream/libsys-utmp-perl/current/MANIFEST Mon Jul 30 05:13:21 2007
@@ -1,0 +1,18 @@
+Changes
+MANIFEST
+MANIFEST.SKIP
+Makefile.PL
+README
+lib/Sys/Utmp.pm
+lib/Sys/Utmp/Utent.pm
+Utmp.xs
+examples/pwho
+META.yml Module meta-data (added by MakeMaker)
+t/01pod.t
+t/02podcoverage.t
+t/03utmp.t
+t/04constants.t
+t/05fields.t
+t/06taint.t
+t/07utent_methods.t
+t/08utent_types.t
Added: branches/upstream/libsys-utmp-perl/current/MANIFEST.SKIP
URL: http://svn.debian.org/wsvn/branches/upstream/libsys-utmp-perl/current/MANIFEST.SKIP?rev=6057&op=file
==============================================================================
--- branches/upstream/libsys-utmp-perl/current/MANIFEST.SKIP (added)
+++ branches/upstream/libsys-utmp-perl/current/MANIFEST.SKIP Mon Jul 30 05:13:21 2007
@@ -1,0 +1,1 @@
+\.svn
Added: branches/upstream/libsys-utmp-perl/current/META.yml
URL: http://svn.debian.org/wsvn/branches/upstream/libsys-utmp-perl/current/META.yml?rev=6057&op=file
==============================================================================
--- branches/upstream/libsys-utmp-perl/current/META.yml (added)
+++ branches/upstream/libsys-utmp-perl/current/META.yml Mon Jul 30 05:13:21 2007
@@ -1,0 +1,11 @@
+# http://module-build.sourceforge.net/META-spec.html
+#XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX#
+name: Sys-Utmp
+version: 1.6
+version_from: lib/Sys/Utmp.pm
+installdirs: site
+requires:
+ Test::More: 0
+
+distribution_type: module
+generated_by: ExtUtils::MakeMaker version 6.17
Added: branches/upstream/libsys-utmp-perl/current/Makefile.PL
URL: http://svn.debian.org/wsvn/branches/upstream/libsys-utmp-perl/current/Makefile.PL?rev=6057&op=file
==============================================================================
--- branches/upstream/libsys-utmp-perl/current/Makefile.PL (added)
+++ branches/upstream/libsys-utmp-perl/current/Makefile.PL Mon Jul 30 05:13:21 2007
@@ -1,0 +1,36 @@
+use ExtUtils::MakeMaker;
+
+my (
+ $define,
+ $libs
+ );
+
+if ( $^O =~ /bsd/i )
+{
+ $define = '-DNOUTFUNCS';
+}
+else
+{
+ $define = '';
+}
+
+if ( $^O eq 'sco' )
+{
+ $libs = ['-lc'];
+}
+else
+{
+ $libs = [''];
+}
+
+WriteMakefile(
+ 'NAME' => 'Sys::Utmp',
+ 'VERSION_FROM' => 'lib/Sys/Utmp.pm',
+ 'PREREQ_PM' => {Test::More => 0 },
+ ($] >= 5.005 ?
+ (ABSTRACT_FROM => 'lib/Sys/Utmp.pm',
+ AUTHOR => 'Jonathan Stowe <jns at gellyfish>') : ()),
+ 'LIBS' => ['-lc'],
+ 'DEFINE' => $define,
+ 'INC' => ''
+);
Propchange: branches/upstream/libsys-utmp-perl/current/Makefile.PL
------------------------------------------------------------------------------
svn:executable =
Added: branches/upstream/libsys-utmp-perl/current/README
URL: http://svn.debian.org/wsvn/branches/upstream/libsys-utmp-perl/current/README?rev=6057&op=file
==============================================================================
--- branches/upstream/libsys-utmp-perl/current/README (added)
+++ branches/upstream/libsys-utmp-perl/current/README Mon Jul 30 05:13:21 2007
@@ -1,0 +1,40 @@
+README FOR Sys::Utmp
+
+INSTALLATION
+
+To install this module type the following:
+
+ perl Makefile.PL
+ make
+ make test
+ make install
+
+DEPENDENCIES
+
+The module requires that your system's C libraries export the functions
+getutent(), setutent() and endutent() - if make complains that it can't find
+these functions and you know that they exist then you may have to supply the
+LIBS directive to Makefile.PL to include the appropriate library:
+
+ perl Makefile.PL LIBS='-lc'
+
+for example.
+
+If your system doesnt have these functions and Makefile.PL doesnt detect
+that it should try to supply them itself then you might try :
+
+ perl Makefile.PL DEFINE='-DNOUTFUNCS'
+
+which will force the module to use its built in versions of the functions.
+
+At version 1.6 Test::More is also required for the tests.
+
+COPYRIGHT AND LICENCE
+
+Copyright Netscalibur UK 2001.
+Copyright Jonathan Stowe 2001 - 2006
+
+This software carries no warranty either express or implied.
+
+This is free software it can be copied and/or modified under the same terms
+as perl itself.
Added: branches/upstream/libsys-utmp-perl/current/Utmp.xs
URL: http://svn.debian.org/wsvn/branches/upstream/libsys-utmp-perl/current/Utmp.xs?rev=6057&op=file
==============================================================================
--- branches/upstream/libsys-utmp-perl/current/Utmp.xs (added)
+++ branches/upstream/libsys-utmp-perl/current/Utmp.xs Mon Jul 30 05:13:21 2007
@@ -1,0 +1,365 @@
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+
+#include <utmp.h>
+
+#ifdef NOUTFUNCS
+
+#include <stdlib.h>
+#include <unistd.h>
+#include <time.h>
+#include <string.h>
+#include <stdio.h>
+#include <sys/types.h>
+#include <sys/stat.h>
+#include <fcntl.h>
+
+#ifdef BSD
+#define _NO_UT_ID
+#define _NO_UT_TYPE
+#define _NO_UT_PID
+#define ut_user ut_name
+#endif
+
+/*
+ define these so it still works as documented :)
+*/
+
+#ifndef USER_PROCESS
+#define EMPTY 0 /* No valid user accounting information. */
+
+#define RUN_LVL 1 /* The system's runlevel. */
+#define BOOT_TIME 2 /* Time of system boot. */
+#define NEW_TIME 3 /* Time after system clock changed. */
+#define OLD_TIME 4 /* Time when system clock changed. */
+
+#define INIT_PROCESS 5 /* Process spawned by the init process. */
+#define LOGIN_PROCESS 6 /* Session leader of a logged in user. */
+#define USER_PROCESS 7 /* Normal process. */
+#define DEAD_PROCESS 8 /* Terminated process. */
+
+#define ACCOUNTING 9
+#endif
+
+
+/*
+ It is almost certain that if these are not defined the fields they are
+ for are not present or this is BSD :)
+*/
+
+
+#ifndef UT_LINESIZE
+# define UT_LINESIZE 32
+#endif
+#ifndef UT_NAMESIZE
+# define UT_NAMESIZE 32
+#endif
+#ifndef UT_HOSTSIZE
+# define UT_HOSTSIZE
+#endif
+
+static int ut_fd = -1;
+
+static char _ut_name[] = _PATH_UTMP;
+
+void utmpname(char *filename)
+{
+ strcpy(_ut_name, filename);
+}
+
+void setutent(void)
+{
+ if (ut_fd < 0)
+ {
+ if ((ut_fd = open(_ut_name, O_RDONLY)) < 0)
+ {
+ croak("Can't open %s",_ut_name);
+ }
+ }
+
+ lseek(ut_fd, (off_t) 0, SEEK_SET);
+}
+
+void endutent(void)
+{
+ if (ut_fd > 0)
+ {
+ close(ut_fd);
+ }
+
+ ut_fd = -1;
+}
+
+struct utmp *getutent(void)
+{
+ static struct utmp s_utmp;
+ int readval;
+
+ if (ut_fd < 0)
+ {
+ setutent();
+ }
+
+ if ((readval = read(ut_fd, &s_utmp, sizeof(s_utmp))) < sizeof(s_utmp))
+ {
+ if (readval == 0)
+ {
+ return NULL;
+ }
+ else if (readval < 0)
+ {
+ croak("Error reading %s", _ut_name);
+ }
+ else
+ {
+ croak("Partial record in %s [%d bytes]", _ut_name, readval );
+ }
+ }
+ return &s_utmp;
+}
+
+#endif
+
+
+static double
+constant(char *name, int len, int arg)
+{
+ errno = 0;
+ if (strEQ(name, "ACCOUNTING"))
+ {
+ return ACCOUNTING;
+ }
+ else if (strEQ(name, "BOOT_TIME"))
+ {
+ return BOOT_TIME;
+ }
+ else if (strEQ(name, "DEAD_PROCESS"))
+ {
+ return DEAD_PROCESS;
+ }
+ else if (strEQ(name, "EMPTY"))
+ {
+ return EMPTY;
+ }
+ else if (strEQ(name, "INIT_PROCESS"))
+ {
+ return INIT_PROCESS;
+ }
+ else if (strEQ(name, "LOGIN_PROCESS"))
+ {
+ return LOGIN_PROCESS;
+ }
+ else if (strEQ(name, "NEW_TIME"))
+ {
+ return NEW_TIME;
+ }
+ else if (strEQ(name, "OLD_TIME"))
+ {
+ return OLD_TIME;
+ }
+ else if (strEQ(name, "RUN_LVL"))
+ {
+ return RUN_LVL;
+ }
+ if (strEQ(name, "USER_PROCESS"))
+ {
+ return USER_PROCESS;
+ }
+ else
+ {
+ errno = EINVAL;
+ return 0;
+ }
+
+}
+
+
+MODULE = Sys::Utmp PACKAGE = Sys::Utmp
+
+PROTOTYPES: DISABLE
+
+
+double
+constant(sv,arg)
+ PREINIT:
+ STRLEN len;
+ INPUT:
+ SV * sv
+ char * s = SvPV(sv, len);
+ int arg
+ CODE:
+ RETVAL = constant(s,len,arg);
+ OUTPUT:
+ RETVAL
+
+
+
+void
+getutent(self)
+SV *self
+ PPCODE:
+ static AV *ut;
+ static HV *meth_stash;
+ static IV ut_tv;
+ static IV _ut_pid;
+ static IV _ut_type;
+ static SV *ut_ref;
+ static char *_ut_id;
+ static struct utmp *utent;
+ static char ut_host[UT_HOSTSIZE];
+
+ HV *self_hash;
+
+ SV *sv_ut_user;
+ SV *sv_ut_id;
+ SV *sv_ut_line;
+ SV *sv_ut_pid;
+ SV *sv_ut_type;
+ SV *sv_ut_host;
+ SV *sv_ut_tv;
+
+ if(!SvROK(self))
+ croak("Must be called as an object method");
+
+ self_hash = (HV *)SvRV(self);
+
+ utent = getutent();
+
+ if ( utent )
+ {
+#ifdef _NO_UT_ID
+ _ut_id = "";
+#else
+ _ut_id = utent->ut_id;
+#endif
+#ifdef _NO_UT_TYPE
+ _ut_type = 7;
+#else
+ _ut_type = utent->ut_type;
+#endif
+#ifdef _NO_UT_PID
+ _ut_pid = -1;
+#else
+ _ut_pid = utent->ut_pid;
+#endif
+#ifdef _HAVE_UT_TV
+ ut_tv = (IV)utent->ut_tv.tv_sec;
+#else
+ ut_tv = (IV)utent->ut_time;
+#endif
+#ifdef _HAVE_UT_HOST
+ strncpy(ut_host, utent->ut_host,UT_HOSTSIZE);
+#else
+ strcpy(ut_host, "",1);
+#endif
+
+
+ sv_ut_user = newSVpv(utent->ut_user,0);
+ sv_ut_id = newSVpv(_ut_id,0);
+ sv_ut_line = newSVpv(utent->ut_line,0);
+ sv_ut_pid = newSViv(_ut_pid);
+ sv_ut_type = newSViv(_ut_type);
+ sv_ut_host = newSVpv(ut_host,0);
+ sv_ut_tv = newSViv(ut_tv);
+
+
+ SvTAINTED_on(sv_ut_user);
+ SvTAINTED_on(sv_ut_host);
+
+ if ( GIMME_V == G_ARRAY )
+ {
+ sv_ut_user = sv_2mortal(sv_ut_user);
+ sv_ut_id = sv_2mortal(sv_ut_id);
+ sv_ut_line = sv_2mortal(sv_ut_line);
+ sv_ut_pid = sv_2mortal(sv_ut_pid);
+ sv_ut_type = sv_2mortal(sv_ut_type);
+ sv_ut_host = sv_2mortal(sv_ut_host);
+ sv_ut_tv = sv_2mortal(sv_ut_tv);
+
+ XPUSHs(sv_ut_user);
+ XPUSHs(sv_ut_id);
+ XPUSHs(sv_ut_line);
+ XPUSHs(sv_ut_pid);
+ XPUSHs(sv_ut_type);
+ XPUSHs(sv_ut_host);
+ XPUSHs(sv_ut_tv);
+
+ }
+ else if ( GIMME_V == G_SCALAR )
+ {
+ ut = newAV();
+ av_push(ut,sv_ut_user);
+ av_push(ut,sv_ut_id);
+ av_push(ut,sv_ut_line);
+ av_push(ut,sv_ut_pid);
+ av_push(ut,sv_ut_type);
+ av_push(ut,sv_ut_host);
+ av_push(ut,sv_ut_tv);
+
+ meth_stash = gv_stashpv("Sys::Utmp::Utent",1);
+ ut_ref = newRV_noinc((SV *)ut);
+ sv_bless(ut_ref, meth_stash);
+ XPUSHs(sv_2mortal(ut_ref));
+ }
+ else
+ {
+ XSRETURN_EMPTY;
+ }
+ }
+ else
+ {
+ XSRETURN_EMPTY;
+ }
+
+
+
+void
+setutent(self)
+SV *self
+ PPCODE:
+ HV *self_hash;
+
+ if(!SvROK(self))
+ croak("Must be called as an object method");
+
+ self_hash = (HV *)SvRV(self);
+ setutent();
+
+void
+endutent(self)
+SV *self
+ PPCODE:
+ HV *self_hash;
+
+ if(!SvROK(self))
+ croak("Must be called as an object method");
+ self_hash = (HV *)SvRV(self);
+ endutent();
+
+void
+utmpname(self, filename)
+SV *self
+SV *filename
+ PPCODE:
+ char *ff;
+ HV *self_hash;
+
+ if(!SvROK(self))
+ croak("Must be called as an object method");
+ self_hash = (HV *)SvRV(self);
+
+ ff = SvPV(filename,PL_na);
+ utmpname(ff);
+
+void
+DESTROY(self)
+SV *self
+ PPCODE:
+ HV *self_hash;
+
+ if(!SvROK(self))
+ croak("Must be called as an object method");
+
+ self_hash = (HV *)SvRV(self);
+ endutent();
Added: branches/upstream/libsys-utmp-perl/current/examples/pwho
URL: http://svn.debian.org/wsvn/branches/upstream/libsys-utmp-perl/current/examples/pwho?rev=6057&op=file
==============================================================================
--- branches/upstream/libsys-utmp-perl/current/examples/pwho (added)
+++ branches/upstream/libsys-utmp-perl/current/examples/pwho Mon Jul 30 05:13:21 2007
@@ -1,0 +1,19 @@
+#!/usr/bin/perl -w
+
+use Sys::Utmp ;
+use POSIX qw(strftime);
+use strict;
+
+my $utmp = Sys::Utmp->new();
+
+
+while (my $utent = $utmp->getutent())
+{
+
+ if ( $utent->user_process() )
+ {
+ print $utent->ut_user(),"\t",
+ $utent->ut_line(),"\t",
+ strftime("%b %d %I:%M",localtime($utent->ut_time())),"\n";
+ }
+}
Propchange: branches/upstream/libsys-utmp-perl/current/examples/pwho
------------------------------------------------------------------------------
svn:executable =
Added: branches/upstream/libsys-utmp-perl/current/lib/Sys/Utmp.pm
URL: http://svn.debian.org/wsvn/branches/upstream/libsys-utmp-perl/current/lib/Sys/Utmp.pm?rev=6057&op=file
==============================================================================
--- branches/upstream/libsys-utmp-perl/current/lib/Sys/Utmp.pm (added)
+++ branches/upstream/libsys-utmp-perl/current/lib/Sys/Utmp.pm Mon Jul 30 05:13:21 2007
@@ -1,0 +1,270 @@
+#*****************************************************************************
+#* *
+#* Gellyfish Software *
+#* *
+#* *
+#*****************************************************************************
+#* *
+#* MODULE : Sys::Utmp *
+#* *
+#* AUTHOR : JNS *
+#* *
+#* DESCRIPTION : Object(ish) interface to utmp information *
+#* *
+#* *
+#*****************************************************************************
+#* *
+#* $Log: Utmp.pm,v $
+#* Revision 1.5 2004/03/02 20:28:08 jonathan
+#* Put back in CVS
+#*
+#* Revision 1.5 2001/09/14 07:28:51 gellyfish
+#* * Fixed coredump in PL_sv_free
+#* * Tainted ut_host
+#* * fixed backward compatibillity problem
+#*
+#* Revision 1.4 2001/09/10 07:16:10 gellyfish
+#* Fixed memory leakage in getutent()
+#*
+#* Revision 1.3 2001/03/27 06:55:36 gellyfish
+#* Added utmpname()
+#*
+#* Revision 1.2 2001/02/12 15:05:31 gellyfish
+#* Added BSD support
+#*
+#* Revision 1.1 2001/02/09 22:27:30 gellyfish
+#* Initial revision
+#*
+#* *
+#* *
+#*****************************************************************************
+
+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<Sys::Utmp::Utent> 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<Sys::Utmp::Utent>.
+
+=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 Carp;
+
+require Exporter;
+require DynaLoader;
+
+use vars qw(
+ @ISA
+ %EXPORT_TAGS
+ @EXPORT_OK
+ @EXPORT
+ $VERSION
+ $AUTOLOAD
+ @constants
+ );
+
+ at ISA = qw(Exporter DynaLoader);
+
+BEGIN
+{
+ @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
+{
+ %EXPORT_TAGS = (
+ 'constants' => [ @constants ],
+ 'fields' => [ @Sys::Utmp::Utent::EXPORT]
+ );
+
+ @EXPORT_OK = ( @{ $EXPORT_TAGS{'constants'} }, @{ $EXPORT_TAGS{'fields'}} );
+}
+
+$VERSION = '1.6';
+
+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;
+}
+
+
+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__
+
+=head2 EXPORT
+
+No methods or constants are exported by default.
+
+=head2 Exportable constants
+
+These constants are exportable under the tag ':constants':
+
+ ACCOUNTING
+ BOOT_TIME
+ DEAD_PROCESS
+ EMPTY
+ INIT_PROCESS
+ LOGIN_PROCESS
+ NEW_TIME
+ OLD_TIME
+ RUN_LVL
+ USER_PROCESS
+
+These are the values that will be found in the ut_type field of the
+L<Sys::Utmp::Utent> object.
+
+These constants are exported under the tag ':fields' :
+
+ UT_USER
+ UT_ID
+ UT_LINE
+ UT_PID
+ UT_TYPE
+ UT_HOST
+ UT_TIME
+
+These provide the indexes into the list returned when C<getutent> is called
+in list context.
+
+=head1 BUGS
+
+Probably. This module has been tested on Linux, Solaris, FreeBSD ,SCO
+Openserver and SCO UnixWare and found to work on those platforms.
+If you have difficulty building the module or it doesnt behave as expected
+then please contact the author including if appropriate your /usr/include/utmp.h
+
+=head1 AUTHOR
+
+Jonathan Stowe, E<lt>jns at gellyfish.comE<gt>
+
+=head1 LICENCE
+
+This Software is Copyright Netscalibur UK 2001,
+ Jonathan Stowe 2001-2006
+
+This Software is published as-is with no warranty express or implied.
+
+This is free software and can be distributed under the same terms as
+Perl itself.
+
+=head1 SEE ALSO
+
+L<perl>. L<Sys::Utmp::Utent>
+
+=cut
Added: branches/upstream/libsys-utmp-perl/current/lib/Sys/Utmp/Utent.pm
URL: http://svn.debian.org/wsvn/branches/upstream/libsys-utmp-perl/current/lib/Sys/Utmp/Utent.pm?rev=6057&op=file
==============================================================================
--- branches/upstream/libsys-utmp-perl/current/lib/Sys/Utmp/Utent.pm (added)
+++ branches/upstream/libsys-utmp-perl/current/lib/Sys/Utmp/Utent.pm Mon Jul 30 05:13:21 2007
@@ -1,0 +1,224 @@
+package Sys::Utmp::Utent;
+
+=head1 NAME
+
+Sys::Utmp::Utent - represent a single utmp entry
+
+=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;
+
+=head1 DESCRIPTION
+
+As described in the L<Sys::Utmp> documentation the getutent method
+returns an object of the type Sys::Utmp::Utent which provides methods
+for accessing the fields in the utmp record. There are also methods
+for determining the type of the record.
+
+The access methods relate to the common names for the members of the C
+struct utent - those provided are the superset from the Gnu implementation
+and may not be available on all systems: where they are not they will
+return the empty string.
+
+=over 4
+
+=item ut_user
+
+Returns the use this record was created for if this is a record for a user
+process. Some systems may return other information depending on the record
+type. If no user was set this will be the empty string. If tainting is
+switched on with the '-T' switch to perl then this will be 'tainted' as it
+is possible that the user name came from an untrusted source.
+
+=item ut_id
+
+The identifier for this record - it might be the inittab tag or some other
+system dependent value.
+
+=item ut_line
+
+For user process records this will be the name of the terminalor line that the
+user is connected on.
+
+=item ut_pid
+
+The process ID of the process that created this record.
+
+=item ut_type
+
+The type of the record this will have a value corresponding to one of the
+constants (not all of these may be available on all systems and there may
+well be others which should be described in the getutent manpage or in
+/usr/include/utmp.h ) :
+
+=over 2
+
+=item ACCOUNTING - record was created for system accounting purposes.
+
+=item BOOT_TIME - the record was created at boot time.
+
+=item DEAD_PROCESS - The process that created this record has terminated.
+
+=item EMPTY - record probably contains no other useful information.
+
+=item INIT_PROCESS - this is a record for process created by init.
+
+=item LOGIN_PROCESS - this record was created for a login process (e.g. getty).
+
+=item NEW_TIME - record created when the system time has been set.
+
+=item OLD_TIME - record recording the old tme when the system time has been set.
+
+=item RUN_LVL - records the time at which the current run level was started.
+
+=item USER_PROCESS - record created for a user process (e.g. a login )
+
+=back
+
+for convenience Sys::Utmp::Utent provides methods which are lower case
+versions of the constant names which return true if the record is of that
+type.
+
+=item ut_host
+
+On systems which support this the method will return the hostname of the
+host for which the process that created the record was started - for example
+for a telnet login. If taint checking has been turned on (with the -T
+switch to perl ) then this value will be tainted as it is possible that
+a remote user will be in control of the DNS for the machine they have
+logged in from. ( see L<perlsec> for more on tainting )
+
+=item ut_time
+
+The time in epoch seconds wt which the record was created.
+
+=back
+
+=cut
+
+use strict;
+use warnings;
+
+use Carp;
+require Exporter;
+
+
+use vars qw(
+ @methods
+ %meth2index
+ %const2meth
+ $AUTOLOAD
+ @ISA
+ @EXPORT
+ );
+
+ at ISA = qw(Exporter);
+
+BEGIN
+{
+ @methods = qw(
+ ut_user
+ ut_id
+ ut_line
+ ut_pid
+ ut_type
+ ut_host
+ ut_time
+ );
+
+
+ @meth2index{@methods} = ( 0 .. $#methods );
+
+
+ no strict 'refs';
+ foreach my $sub ( @methods )
+ {
+ my $usub = uc $sub;
+
+ *{$usub} = sub { return $meth2index{$sub} };
+ push @EXPORT, $usub;
+
+ }
+ use strict 'refs';
+
+ $const2meth{lc $_ } = $_ foreach @Sys::Utmp::constants;
+
+}
+
+sub AUTOLOAD
+{
+ my ( $self ) = @_;
+
+ return if ( $AUTOLOAD =~ /DESTROY/ );
+
+ (my $methname = $AUTOLOAD) =~ s/.*:://;
+
+
+ {
+ no strict 'refs';
+
+ if ( exists $meth2index{$methname} )
+ {
+ *{$AUTOLOAD} = sub {
+ my ($self) = @_;
+ return $self->[$meth2index{$methname}];
+ };
+ }
+ elsif ( exists $const2meth{$methname})
+ {
+ *{$AUTOLOAD} = sub {
+ my ( $self ) = @_;
+ return $self->ut_type == &{"Sys::Utmp::$const2meth{$methname}"};
+ };
+ }
+ else
+ {
+ croak "$methname not defined" unless exists $meth2index{$methname};
+ }
+
+ goto &{$AUTOLOAD};
+ }
+}
+
+1;
+
+__END__
+
+=head1 BUGS
+
+Probably. This module has been tested on Linux, Solaris, FreeBSD ,SCO
+Openserver and SCO UnixWare and found to work on those platforms.
+If you have difficulty building the module or it doesnt behave as expected
+then please contact the author including if appropriate your /usr/include/utmp.h
+
+=head1 AUTHOR
+
+Jonathan Stowe, E<lt>jns at gellyfish.comE<gt>
+
+=head1 LICENCE
+
+This Software is Copyright Jonathan Stowe 2001-2006
+
+This Software is published as-is with no warranty express or implied.
+
+This is free software and can be distributed under the same terms as
+Perl itself.
+
+=head1 SEE ALSO
+
+L<perl>. L<Sys::Utmp::Utent>
+
+=cut
Added: branches/upstream/libsys-utmp-perl/current/t/01pod.t
URL: http://svn.debian.org/wsvn/branches/upstream/libsys-utmp-perl/current/t/01pod.t?rev=6057&op=file
==============================================================================
--- branches/upstream/libsys-utmp-perl/current/t/01pod.t (added)
+++ branches/upstream/libsys-utmp-perl/current/t/01pod.t Mon Jul 30 05:13:21 2007
@@ -1,0 +1,7 @@
+#!/usr/bin/perl
+
+use Test::More;
+eval "use Test::Pod 1.00";
+plan skip_all => "Test::Pod 1.00 required for testing POD" if $@;
+all_pod_files_ok();
+
Propchange: branches/upstream/libsys-utmp-perl/current/t/01pod.t
------------------------------------------------------------------------------
svn:executable =
Added: branches/upstream/libsys-utmp-perl/current/t/02podcoverage.t
URL: http://svn.debian.org/wsvn/branches/upstream/libsys-utmp-perl/current/t/02podcoverage.t?rev=6057&op=file
==============================================================================
--- branches/upstream/libsys-utmp-perl/current/t/02podcoverage.t (added)
+++ branches/upstream/libsys-utmp-perl/current/t/02podcoverage.t Mon Jul 30 05:13:21 2007
@@ -1,0 +1,11 @@
+#!/usr/bin/perl
+
+use Test::More;
+eval "use Test::Pod::Coverage tests => 2";
+plan skip_all => "Test::Pod::Coverage required for testing POD Coverage" if $@;
+pod_coverage_ok( "Sys::Utmp", {also_private => [ qr/constant/]},
+ "Sys::Utmp is covered" );
+pod_coverage_ok( "Sys::Utmp::Utent", {also_private => [ qr/^UT_/]},
+ "Sys::Utmp::Utent is covered (ignoring field constants)" );
+
+
Propchange: branches/upstream/libsys-utmp-perl/current/t/02podcoverage.t
------------------------------------------------------------------------------
svn:executable =
Added: branches/upstream/libsys-utmp-perl/current/t/03utmp.t
URL: http://svn.debian.org/wsvn/branches/upstream/libsys-utmp-perl/current/t/03utmp.t?rev=6057&op=file
==============================================================================
--- branches/upstream/libsys-utmp-perl/current/t/03utmp.t (added)
+++ branches/upstream/libsys-utmp-perl/current/t/03utmp.t Mon Jul 30 05:13:21 2007
@@ -1,0 +1,72 @@
+use Test;
+use strict;
+BEGIN { plan tests => 7 };
+use Sys::Utmp qw(:fields);
+ok(1);
+
+# test
+
+{
+ my $utmp = Sys::Utmp->new(Filename => '/var/run/utmp');
+
+ ok(2);
+
+ eval
+ {
+ while( my $utent = $utmp->getutent() )
+ {
+ my $t = $utent->ut_line();
+ $t = $utent->user_process();
+ }
+ ok(3);
+ };
+ if ( $@ )
+ {
+ print $@;
+ ok(0);
+ }
+
+ eval
+ {
+ $utmp->setutent();
+ ok(4);
+ };
+ if ($@)
+ {
+ ok(0);
+ }
+
+}
+
+
+{
+ my $utmp = Sys::Utmp->new(Filename => '/var/run/utmp');
+
+ ok(5);
+
+ eval
+ {
+ while( my @utent = $utmp->getutent() )
+ {
+ my $t = $utent[UT_USER];
+ $t = $utent[UT_ID];
+ }
+ ok(6);
+ };
+ if ( $@ )
+ {
+ print $@;
+ ok(0);
+ }
+
+ eval
+ {
+ $utmp->setutent();
+ ok(7);
+ };
+ if ($@)
+ {
+ ok(0);
+ }
+
+}
Propchange: branches/upstream/libsys-utmp-perl/current/t/03utmp.t
------------------------------------------------------------------------------
svn:executable =
Added: branches/upstream/libsys-utmp-perl/current/t/04constants.t
URL: http://svn.debian.org/wsvn/branches/upstream/libsys-utmp-perl/current/t/04constants.t?rev=6057&op=file
==============================================================================
--- branches/upstream/libsys-utmp-perl/current/t/04constants.t (added)
+++ branches/upstream/libsys-utmp-perl/current/t/04constants.t Mon Jul 30 05:13:21 2007
@@ -1,0 +1,18 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+use Test::More tests => 10;
+
+use Sys::Utmp qw(:constants);
+
+ok(defined ACCOUNTING,'ACCOUNTING Constant');
+ok(defined BOOT_TIME, 'BOOT_TIME Constant');
+ok(defined DEAD_PROCESS, 'DEAD_PROCESS Constant');
+ok(defined EMPTY, 'EMPTY Constant');
+ok(defined INIT_PROCESS, 'INIT_PROCESS Constant');
+ok(defined LOGIN_PROCESS, 'LOGIN_PROCESS Constant');
+ok(defined NEW_TIME, 'NEW_TIME Constant');
+ok(defined OLD_TIME, 'OLD_TIME Constant');
+ok(defined RUN_LVL, 'RUN_LVL Constant');
+ok(defined USER_PROCESS, 'USER_PROCESS Constant');
Propchange: branches/upstream/libsys-utmp-perl/current/t/04constants.t
------------------------------------------------------------------------------
svn:executable =
Added: branches/upstream/libsys-utmp-perl/current/t/05fields.t
URL: http://svn.debian.org/wsvn/branches/upstream/libsys-utmp-perl/current/t/05fields.t?rev=6057&op=file
==============================================================================
--- branches/upstream/libsys-utmp-perl/current/t/05fields.t (added)
+++ branches/upstream/libsys-utmp-perl/current/t/05fields.t Mon Jul 30 05:13:21 2007
@@ -1,0 +1,15 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Sys::Utmp qw(:fields);
+use Test::More tests => 7;
+
+ok(defined UT_USER, 'UT_USER field');
+ok(defined UT_ID, 'UT_ID field');
+ok(defined UT_LINE, 'UT_LINE field');
+ok(defined UT_PID, 'UT_PID field');
+ok(defined UT_TYPE, 'UT_TYPE field');
+ok(defined UT_HOST, 'UT_HOST field');
+ok(defined UT_TIME, 'UT_TIME field');
Propchange: branches/upstream/libsys-utmp-perl/current/t/05fields.t
------------------------------------------------------------------------------
svn:executable =
Added: branches/upstream/libsys-utmp-perl/current/t/06taint.t
URL: http://svn.debian.org/wsvn/branches/upstream/libsys-utmp-perl/current/t/06taint.t?rev=6057&op=file
==============================================================================
--- branches/upstream/libsys-utmp-perl/current/t/06taint.t (added)
+++ branches/upstream/libsys-utmp-perl/current/t/06taint.t Mon Jul 30 05:13:21 2007
@@ -1,0 +1,27 @@
+#!/usr/bin/perl -T
+
+use strict;
+use warnings;
+
+use Sys::Utmp;
+use Test::More;
+
+eval "use Scalar::Util qw(tainted)";
+
+#plan skip_all => "Tainting check skipped";
+
+if ( $@ )
+{
+ plan skip_all => "Need Scalar::Util to test tainting";
+}
+else
+{
+ plan tests => 2;
+}
+
+my $utmp = Sys::Utmp->new();
+
+my $utent = $utmp->getutent();
+
+ok(tainted($utent->ut_user()),"ut_user is tainted");
+ok(tainted($utent->ut_host()),"ut_host is tainted");
Propchange: branches/upstream/libsys-utmp-perl/current/t/06taint.t
------------------------------------------------------------------------------
svn:executable =
Added: branches/upstream/libsys-utmp-perl/current/t/07utent_methods.t
URL: http://svn.debian.org/wsvn/branches/upstream/libsys-utmp-perl/current/t/07utent_methods.t?rev=6057&op=file
==============================================================================
--- branches/upstream/libsys-utmp-perl/current/t/07utent_methods.t (added)
+++ branches/upstream/libsys-utmp-perl/current/t/07utent_methods.t Mon Jul 30 05:13:21 2007
@@ -1,0 +1,16 @@
+#!/usr/bin/perl
+
+use Test::More tests => 7;
+use Sys::Utmp;
+
+my $utmp = Sys::Utmp->new();
+
+my $utent = $utmp->getutent();
+
+ok(defined $utent->ut_user(),"ut_user");
+ok(defined $utent->ut_id(),"ut_id");
+ok(defined $utent->ut_line(),"ut_line");
+ok(defined $utent->ut_pid(),"ut_pid");
+ok(defined $utent->ut_type(),"ut_type");
+ok(defined $utent->ut_host(),"ut_host");
+ok(defined $utent->ut_time(),"ut_time");
Propchange: branches/upstream/libsys-utmp-perl/current/t/07utent_methods.t
------------------------------------------------------------------------------
svn:executable =
Added: branches/upstream/libsys-utmp-perl/current/t/08utent_types.t
URL: http://svn.debian.org/wsvn/branches/upstream/libsys-utmp-perl/current/t/08utent_types.t?rev=6057&op=file
==============================================================================
--- branches/upstream/libsys-utmp-perl/current/t/08utent_types.t (added)
+++ branches/upstream/libsys-utmp-perl/current/t/08utent_types.t Mon Jul 30 05:13:21 2007
@@ -1,0 +1,18 @@
+#!/usr/bin/perl
+
+use Sys::Utmp;
+use Test::More tests => 10;
+
+my $utmp = Sys::Utmp->new();
+my $utent = $utmp->getutent();
+
+ok(defined $utent->accounting(),"accounting");
+ok(defined $utent->boot_time(),"boot_time");
+ok(defined $utent->dead_process(),"dead_process");
+ok(defined $utent->empty(),"empty");
+ok(defined $utent->init_process(),"init_process");
+ok(defined $utent->login_process(),"login_process");
+ok(defined $utent->new_time(),"new_time");
+ok(defined $utent->old_time(),"old_time");
+ok(defined $utent->run_lvl(),"run_lvl");
+ok(defined $utent->user_process(),"user_process");
Propchange: branches/upstream/libsys-utmp-perl/current/t/08utent_types.t
------------------------------------------------------------------------------
svn:executable =
More information about the Pkg-perl-cvs-commits
mailing list