Repost of uutraf.pl (Was: mailing perl scripts)

Johan Vromans jv at mh.nl
Thu Apr 18 20:20:14 AEST 1991


In article <1991Apr17.120911.23528 at ux1.cso.uiuc.edu> ejk at ux2.cso.uiuc.edu (Ed Kubaitis - CSO ) writes:

> The '.' terminating a Perl format, newer versions of shar that "optimize" 
> away "unnecessary" prefix characters, and something in ucbmail or SMTP
> conspire to truncate your mail.

Reposting time ...

---- Cut Here and feed the following to sh ----
#!/bin/sh
# This is a shell archive (produced by shar 3.49)
# To extract the files from this archive, save it to a file, remove
# everything above the "!/bin/sh" line above, and type "sh file_name".
#
# made 04/18/1991 10:18 UTC by jv at largo
# Source directory /u1/users/jv
#
# existing files will NOT be overwritten unless -c is specified
#
# This shar contains:
# length  mode       name
# ------ ---------- ------------------------------------------
#   5454 -r--r--r-- uutraf.pl
#
# ============= uutraf.pl ==============
if test -f 'uutraf.pl' -a X"$1" != X"-c"; then
	echo 'x - skipping uutraf.pl (File already exists)'
else
echo 'x - extracting uutraf.pl (Text)'
sed 's/^X//' << 'SHAR_EOF' > 'uutraf.pl' &&
X#!/usr/bin/perl
Xeval "exec /usr/bin/perl -S $0 $*"
X  if $running_under_some_shell;
Xdo verify_perl_version (3001);
X
X# @(#)@ uutraf	1.4 - uutraf.pl
X#
X# UUCP Traffic Analyzer
X#
X# Reads /usr/lib/uucp/.Admin/xferstats, and generates a report from it.
X# Also understands Ultrix SYSLOG format.
X#
X# Created by Johan Vromans <jv at mh.nl>
X# Loosely based on an idea by Greg Hackney (hack at texbell.swbt.com)
X
X# Usage: uutraf [xferstats]
X
X$type = "unknown";
X
Xif ( $#ARGV >= 0 ) {
X    open (STDIN, $ARGV[0]) || die "Cannot open $ARGV[0]";
X    open (IN, $ARGV[0]) || die "Cannot open $ARGV[0]";
X    $line = <IN>;
X    split (/ /, $line);
X    $type = ($_[0] =~ /!/) ? "HDB" : "U";
X}
Xelsif ( -r "/usr/spool/uucp/.Admin/xferstats" ) {
X    open (STDIN, "/usr/spool/uucp/.Admin/xferstats");
X    $type = "HDB";
X}
Xelsif ( -r "/usr/spool/uucp/SYSLOG" ) {
X    open (STDIN, "/usr/spool/uucp/SYSLOG");
X    $type = "U";
X}
Xelse { die "Sorry, don't know what"; }
X
Xif ( $type eq "HDB" ) {
X    $pat = "([^!]+)![^(]+\\(([-0-9:/]+)\\).+([<>])-? (\\d+) / (\\d+)\\.(\\d+) secs";
X    $recv = "<";
X}
Xelse {
X    $pat = "\\S+\\s+(\\S+)\\s+\\(([-0-9:/]+)\\)\\s+\\(\\d+\\)\\s+(\\w+) (\\d+) b (\\d+) secs";
X    $recv = "received";
X}
X
X%hosts = ();		# hosts seen
X%bytes_in = ();		# of bytes received from host
X%bytes_out = ();	# of bytes sent to host
X%secs_in = ();		# of seconds connect for recving
X%secs_out = ();		# of seconds connect for sending
X%files_in = ();		# of input requests
X%files_out = ();	# of output requests
X
X# read info, break the lines and tally
X
Xwhile ( <STDIN> ) {
X  if ( /^$pat/o ) {
X#   print "host $1, date $2, dir $3, bytes $4, secs $5.$6\n";
X    $6 = 0 if $type eq "U";
X    # gather timestamps
X    $last_date = $2;
X    $first_date = $last_date unless defined $first_date;
X
X    # initialize new hosts
X    unless ( defined $hosts{$1} ) {
X      $hosts{$1} = $files_in{$1} = $files_out{$1} = 
X	$bytes_in{$1} = $bytes_out{$1} =
X	  $secs_in{$1} = $secs_out{$1} = 0;
X    }
X
X    # tally
X    if ( $3 eq $recv ) {		# recv
X      $bytes_in{$1} += $4;
X      $files_in{$1}++;
X      $secs_in{$1} += $5 + $6/1000;
X    }
X    else {			# xmit
X      $bytes_out{$1} += $4;
X      $files_out{$1}++;
X      $secs_out{$1} += $5 + $6/1000;
X    }
X  }
X  else {
X    print STDERR "Possible garbage: $_";
X  }
X}
X
X at hosts = keys (%hosts);
Xdie "No info found, stopped" if $#hosts < 0;
X
X################ report section ################
X
X$thishost = do gethostname();
X$thishost = (defined $thishost) ? "on node $thishost" : "report";
X
Xformat std_head =
X@|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
X"UUCP traffic $thishost from $first_date to $last_date"
X
XRemote   -----------K-Bytes----------- ----Hours---- --Avg CPS-- --Files--
X Host         Recv      Sent     Total   Recv   Sent  Recv  Sent Recv Sent
X.
Xformat std_out =
X@<<<<<<< @>>>>>>>> @>>>>>>>> @>>>>>>>> @>>>>> @>>>>> @>>>> @>>>> @>>> @>>>
X$Zhost,   $Zi_bytes, $Zo_bytes, $Zt_bytes, $Zi_hrs, $Zo_hrs, $Zi_acps, $Zo_acps, $Zi_count, $Zo_count
X.
X
X$^ = "std_head";
X$~ = "std_out";
X
Xdo print_dashes ();
X
Xreset "T";	       # reset totals
X
Xforeach $host (@hosts) {
X  do print_line ($host, $bytes_in{$host}, $bytes_out{$host},
X		 $secs_in{$host},  $secs_out{$host},
X		 $files_in{$host}, $files_out{$host});
X
X}
X
Xdo print_dashes ();
Xdo print_line ("Total", $Ti_bytes, $To_bytes,
X	       $Ti_secs, $To_secs, $Ti_count, $To_count);
X
X################ that's it ################
X
Xsub print_line {
X  reset "Z";		# reset print fields
X  local ($Zhost, 
X	 $Zi_bytes, $Zo_bytes, 
X	 $Zi_secs, $Zo_secs, 
X	 $Zi_count, $Zo_count) = @_;
X  $Ti_bytes += $Zi_bytes;
X  $To_bytes += $Zo_bytes;
X  $Zt_bytes = $Zi_bytes + $Zo_bytes;
X  $Tt_bytes += $Zt_bytes;
X  $Zi_acps = ($Zi_secs > 0) ? sprintf ("%.0f", $Zi_bytes/$Zi_secs) : "0";
X  $Zo_acps = ($Zo_secs > 0) ? sprintf ("%.0f", $Zo_bytes/$Zo_secs) : "0";
X  $Zi_bytes = sprintf ("%.1f", $Zi_bytes/1000);
X  $Zo_bytes = sprintf ("%.1f", $Zo_bytes/1000);
X  $Zt_bytes = sprintf ("%.1f", $Zt_bytes/1000);
X  $Zi_hrs = sprintf ("%.1f", $Zi_secs/3600);
X  $Zo_hrs = sprintf ("%.1f", $Zo_secs/3600);
X  $Ti_secs += $Zi_secs;
X  $To_secs += $Zo_secs;
X  $Ti_count += $Zi_count;
X  $To_count += $Zo_count;
X  write;
X}
X
Xsub print_dashes {
X  $Zhost = $Zi_bytes = $Zo_bytes = $Zt_bytes =
X    $Zi_hrs = $Zo_hrs = $Zi_acps = $Zo_acps = $Zi_count = $Zo_count = 
X      "------------";
X  write;
X  # easy, isn't it?
X}
X
X################ missing ################
X
Xsub gethostname {
X  $ENV{"SHELL"} = "/bin/sh";
X  $try = `hostname 2>/dev/null`;
X  chop $try;
X  return $+ if $try =~ /^[-.\w]+$/;
X  $try = `uname -n 2>/dev/null`;
X  chop $try;
X  return $+ if $try =~ /^[-.\w]+$/;
X  $try = `uuname -l 2>/dev/null`;
X  chop $try;
X  return $+ if $try =~ /^[-.\w]+$/;
X  return undef;
X}
X
X################ verify perl version ################
X
X# do verify_perl_version ( [ required , [ message ] ] )
X
Xsub verify_perl_version {
X  local ($version,$patchlevel) = $] =~ /(\d+.\d+).*\nPatch level: (\d+)/;
X  $version = $version * 1000 + $patchlevel;
X
X  # did the caller pass a required version?
X  if ( $#_ >= 0 ) {
X    local ($req, $msg, @req);
X    @req = split (//, $req = shift);
X    # if the request is valid - check it
X    if ( $#req == 3 && $req > $version ) {
X      if ( $#_ >= 0 ) {	# user supplied message
X	$msg = shift;
X      }
X      else {
X        $msg = "Sorry, this program requires perl " . $req[0] . "." . $req[1] .
X	        " patch level " . $req % 100 ." or later.\nStopped";
X      }
X      die $msg;
X    }
X  }
X  return $version;
X}
SHAR_EOF
chmod 0444 uutraf.pl ||
echo 'restore of uutraf.pl failed'
Wc_c="`wc -c < 'uutraf.pl'`"
test 5454 -eq "$Wc_c" ||
	echo 'uutraf.pl: original size 5454, current size' "$Wc_c"
fi
exit 0
-- 
Johan Vromans				       jv at mh.nl via internet backbones
Multihouse Automatisering bv		       uucp: ..!{uunet,hp4nl}!mh.nl!jv
Doesburgweg 7, 2803 PL Gouda, The Netherlands  phone/fax: +31 1820 62911/62500
------------------------ "Arms are made for hugging" -------------------------



More information about the Alt.sources mailing list