#!/usr/local/bin/perl
#
# who.pl
#  This program demonstrates the use of the fix.pl library.
#  It also uses Tom Christiansen's  exception handling standard
#  using the try / handle style, rather than catch / throw.
#
#   It's  a re-implemntation of who/w with a little bit of 
#   gnu finger thrown in for good measure.
#   Each user is only shown once - the MRU tty.
#   usage:
#     who.pl [-a] [-l min]
#     if the -a flag is used, then only ttys active within the last
#     'min' minutes are shown. The default is one hour.
#

require 'ctime.pl';
require 'fix.pl';
require 'stat.pl';
require 'getopts.pl';
#
# define the output formats
#

format top = 
Name      TTY       From                Idle
. 

format STDOUT = 
@<<<<<<<< @<<<<<<<< @<<<<<<<<<<<<<<<<< @<<<<<<<<<<<<<<
$name     $tty      $host              $idle
. 

#
# parse the argument list using "getopts.pl"
#

&Getopts("al:");
$limit = $opt_l ? $opt_l * 60 : 3600;
$opt_a += $opt_l;
#
# run the main loop with an exception handler for 
# OPEN events.
#
$utmp = "/etc/utmp";

&try( '&main_loop', 
      'OPEN','&open_handler'
);

#
# the main program - all error are handled in the try statement above
#

sub main_loop {

  #  bind the utmp file and format to $z
  $z = &fixopen($utmp,'A8 A8 A16 I');

  #  find the highest numbered entry
  $end = &fixmax($z);		
  
  # and loop for each entry
  for (0..$end) {
      # read in a utmp record and unpack it automagically
      ($tty,$name,$host,$date) = &fixget($z,$_); 
      
     # check whether there's anybody logged in
     unless ($name eq '') {

          # if so, when was their tty last used?
	  $last_used = &idle($tty);

	  # check whether it's the MRU tty
	  if ($last_used> $seen{$name}) {
	      # store the index of this record
	      $who{$name} = $_;
	      $seen{$name} = $last_used;
	  }
      }
  }
  # now we've got all this info, let's output it

  for (sort keys %who) {

      # retrieve the record using the stored index
      ($tty,$name,$host,$date) = &fixget($z,$who{$_});

      #find out how long it's been idle. 
      $idle = ( time - $seen{$name}) ;
      
      # is it active enough?
      if ( !$opt_a || $idle < $limit) { 

	  # then format the time nicely and print it
	  $idle = &nice_time($idle);
	  write;
      }
  }
}

#
# open_handler: This routine handles errors opening the file.
# it prompts for another file, then restarts the main loop
#
sub open_handler {
       print "I can't open $utmp : what file should I use? ";
       $utmp = <stdin>;
       chop $utmp;
       1;
}

#
# idle returns the time when the tty was last used
#
sub idle {
    local($tty) = @_;
    &Stat("/dev/$tty");
    return $st_atime;
}
    
#
# nice_time takes a length of time and formats it nicely
# for a nice time call...
sub nice_time {
    local($period) = @_;

    if ($period < 60) {
	return &plural($period,"second");
    }

    $period /= 60;
    $period = int($period+0.5);

    if ($period < 60) {
	return &plural($period,"minute");
    }
    $period /= 60;
    $period = int($period+0.5);

    if ($period< 24) {
	return &plural($period,"hour");
    }
    $period /= 24;
    $period = int($period+0.5);

    return &plural($period,"day");
}

#
# Plural takes a count, a word, and an optional plural form
# and returns a possibly pluralised string. 
#

sub plural {
    ($count,$word,$plural) = @_;
    if( $count == 1) {
	return " $count $word";
    } else {
	if ($plural) {
	    $plural = "$count $plural";
	    } else {
		$plural = " $count $word" . "s";
	    }
	return $plural;
    }
}

#########################################################################
# Exception handler : You can throw this away and use Tom's exceptions.pl
# - this is just an experiment
#########################################################################

#
# try('body',[guard,action]*)
#    if an action returns 1, restart the body
#
sub try {
    local($body,@handlers) = @_;
    eval($body);
    $@ || return;
    for $i (0..$#handlers) {
	local($guard,$action);
	$guard=$handlers[$i++];
	$action=$handlers[$i++];
	$guard && $action ||
	    die "EXCEPTION: TRY,ARGUMENTS (bad exception handler for $@)\n";

	if($@ =~ /$guard/) {
	    local($old,$retry);
	    $old = $@;
	    $retry = eval "$action";
	    $@ &&
		die "EXCEPTION: TRY (error in handler: ($@),($old)";
	    if($retry == 1 ) {
		&try($body,@handlers);
	    }
	    return;
	}
	die $@;
    }
}


