view release on metacpan or  search on metacpan

test.pl  view on Meta::CPAN

# Before `make install' is performed this script should be runnable with
# `make test'. After `make install' it should work as `perl test.pl'

######################### We start with some black magic to print on failure.

# Change 1..1 below to 1..last_test_to_print .
# (It may become useful if the test is moved to ./t subdirectory.)

BEGIN { $| = 1; print "1..4\n"; }
END {print "not ok 1\n" unless $loaded;}
use User::Utmp qw(:constants);
use POSIX qw(ttyname);
$loaded = 1;
print "ok 1\n";

######################### End of black magic.

$user = getlogin || getpwuid($<) || $ENV{USER};
$term = ttyname(undef);
$term =~ s|^/dev/||;

###############################################################################

$test = 2;

unless (UTMP_FILE && -z UTMP_FILE)
{
   @utmp = User::Utmp::getut();

   $found = 0;

   foreach $entry (@utmp)
   {
      if ($entry->{ut_type} == USER_PROCESS)
      {
	 $found++ if $entry->{ut_user} eq $user;
	 $found++ if $entry->{ut_line} =~ $term;
      }
   }

   print $found ? "" : "not ", "ok 2 ";

   if (not $found)
   {
      print "(Could not find utmp entry for user $user and/or line $term)";
   }

   print "\n";
}
else
{
   print "skipped $test (empty utmp file)\n";
}

###############################################################################

$test++;

if (User::Utmp::HAS_UTMPX())
{
   $entry = User::Utmp::getutxline($term);

   $found = 0;

   if ($entry)
   {
      $found++ if $entry->{ut_user} eq $user;
      $found++ if $entry->{ut_line} =~ $term;
   }

   print $found ? "" : "not ", "ok $test ";

   if (not $found)
   {
      print "(Could not find utmpx entry for user $user and/or line $term)";
   }

   print "\n";