#!/usr/local/bin/perl
#/PROF : ([^(]+)\(#(\d+)[^)]*\).* ticks (\d+) .*: (.*)/
#
# $Id: mushprofile,v 1.2 1998/05/16 02:38:17 joi Exp $
# $Log: mushprofile,v $
# Revision 1.2  1998/05/16 02:38:17  joi
# Fixed keylen bug.
#
# Revision 1.1  1998/04/02 01:40:39  joi
# Initial revision
#
#
# This script reads SPROF-patched Tinymush server logs and produces profiler-type
# outpout on the objects flagged for profiling.
#
# "@admin log_options=timestamp" must be enabled.
#
require "getopt.pl";
sub usage {
  print <<EOF;
Mush Profiler $version
Usage: mushprofile <logfile
Optional switches:
  -h, --help	This file
  -r rcfile	Location of rc file. defaults to .mushprofilerc in the
  		current directory, then in the home directory.
  -o outputfile File that will receive the profile report.
  		Defaults to stdout.
  -v 		Chatter to stdout while working, before the report
  		is written.
  -m minlevel	Exclude level.  A percentage used to trim uncommon
                objects and uncommon commands from the Profile
		section.  Defaults to 0.05.
  -l length	Length of command to use for key.  40 is the default.
                The longer the key, the more memory this report requires.
		The report prints the first 90 characters of the command.

These switches may be provided in the resource file, where they will
overrided by the command line!

EOF
}
##cut here##########################################
# #Sample .mushprofilerc file
# #
# # replace the numbers below with the dbrefs of objects in your logs
# # that you don't wish to profile.  I wanted to just exclude all
# # players, so I named it that.  Logically it could be called
# # "@excludes", too.
# #
# # To use this rc file, cut between the lines and remove the
# # first two characters of each line.
# # This is a perl include file, so the contents must be legal
# # perl, and it must end with the 1; on the last line, as shown.
# #
# 
# (NOTE: This doesn't really apply to SPROF so this needs to be changed.)
#
# @players = 
#  ( 1, 5, 20, 21, 74, 124, 125, 126, 127, 129, 130, 139, 140, 142,
#  143, 144, 160, 218, 271, 284, 295, 320, 340, 345, 355, 360, 420,
#    421);
# 1;
###cut here#########################################
#
# default values for variables, may be overridden by rcfile, then command line.
#
if (-r ".mushprofilerc") {
  $rcfile = ".mushprofilerc";
} elsif (-r "$ENV{HOME}/.mushprofilerc") {
  $rcfile = "$ENV{HOME}/.mushprofilerc";
}

$minlevel = 0.05;	# minimum percentage to be reported

&Getopt("orml");

if (("@ARGV" =~ /--help/i) || $opt_h) {
  &usage;
  exit;
}
if ($opt_r && -r $opt_r) {
  $rcfile = $opt_r;
} elsif ($opt_r) {
  die "Unable to read $opt_r!\n";
}

if ($opt_m) {
  $minlevel = $opt_m;
}

if ($opt_l) {
  if ($opt_l > 9) {
    $keylen = $opt_l;
  } else {
    die "Key -l must be at least 10 characters.\n";
  }
}
$keylen = 40 unless $keylen;

print "Using RCfile $rcfile.\n" if $opt_v;
if (-r $rcfile) {
  require $rcfile;
}

if ($#players) {
  $playerpattern = "(z" . join("z|z",@players) . "z)";
}
#
# main loop starts here
#
while (<>) {
  $inputcount++;
  if ($opt_v && $inputcount % 1000 == 0) {
    print ".";
  }
#
  ($object,$dbref,$ticks,$code) = (/CMD\/PROF : ([^(]+)\(#(\d+)[^)]*\).* ticks (\d+) [^:]*: (.*)/);
  next unless $dbref;

  $key = $dbref ."|".length($code)."|". substr($code,0,$keylen);

#  next if $code =~ /^p(a|ag|age)* /;
#  next if $code =~ /^(:|"|\+)/;

  unless ($dbref{$dbref}) {
    print "New object $object $dbref\n" if $opt_v;
    $dbref{$dbref}=$object;
  }
#  next if $playerpattern && "z${dbref}z" =~ /$playerpattern/o;
  $linecount++;			# lines profiled

  $dcount{$dbref}++;
  $objectticks{$dbref} += $ticks;

  unless ($count{$key}) {
    $keycount++ ;
    print "New key $key, $keycount keys.\n" if $opt_v;
    $memsize += length($key);
  }
  $count{$key}++;
  $keyticks{$key} += $ticks;
}
#########################################################################
#
#
if ($opt_o) {
  open(STDOUT,">$opt_o") || die "Unable to create $opt_o!\n";
}
#print "$inputcount lines of log examined.\n";
#print "$linecount lines of log profiled.\n\n";

format EXCLUDED =
.

$mincount = $linecount * $minlevel;
$linecount = 1 unless $linecount;
$topnum = sprintf("%5.2d",(1.0 - $minlevel) * 100);
$topnum = 100 * (1.0 - $minlevel);
$foo = join(", ",@players);

format OBJLIST_TOP=

  @|||||||||||||||||||||||||||||||||||||||||||||||||||||||||| 
  "CMD/PROF Profile Report"


  @|||||||||||||||||||||||||||| @|||||||||||||||||||||||||||| 
"$inputcount log lines read","$linecount lines profiled"
  @|||||||||||||||||||||||||||| @|||||||||||||||||||||||||||| 
  "*=excluded from profile","** = below -m minlevel"

  Excluded dbrefs: ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<~
$foo
  ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<~~ 
$foo


  Dbref           Name of Object          # of CMDS   Ticks    Percent
  ----- --------------------------------- --------- ---------- -------      
.

format OBJLIST =
@ @<<<< @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< @>>>>>>>> @>>>>>>>>>  @###.## @<
$ast, $dbref, $dbref{$dbref}, $dcount{$dbref}, $objectticks{$dbref}, 100*$dcount{$dbref}/$linecount,$ast2
.

$~ = OBJLIST_TOP;
write;


$~ = OBJLIST;
@sortedlist = sort bydcount keys %dbref;

foreach $dbref (@sortedlist) {
    if (grep(/^$dbref$/,@players)) {
      $ast ="*";
    } else {
      $ast = " ";
    }
    if ($dcount{$dbref}<$mincount) {
      $ast2 = "**";
    } else {
      $ast2 = "  ";
    }
  write;
}

sub bydcount {
  $dcount{$b} <=> $dcount{$a}
}
sub bycount {
  $count{$b} <=> $count{$a}
}
sub numerically {
  $a <=> $b
}
format PROFILE_TOP=

@<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
"Command Profile for top $topnum\% commands for the top $topnum\% objects"

Attr   Command  Object      Object   Command
Len    Count    Ticks       Percent  Executed
-----  -------- ----------- -------  -------------------------------
.

format PROFILE_OBJ=

Object @<<<<<< @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< ran @<<<<<< commands.
       $dbref, $dbref{$dbref},                     $dcount{$dbref}
.

format PROFILE=
@>>>>  @>>>>>>> @>>>>>>>>>> @###.##  @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
$len, $count{$key}, $keyticks{$key}, 100*$count{$key}/$linecount, $code
.

$~ = PROFILE_TOP;
write;

$~ = PROFILE;
$current_dbref = "";
foreach $dbref (@sortedlist) {
  foreach $key (sort bycount grep(/^$dbref\|/,keys %count)) {
    ($dbref1,$len, $code) = ($key =~ /(\d+)\|(\d+)\|(.*)/); 
    if (($dcount{$dbref1} > $mincount) && 
       ($count{$key} >= $dcount{$dbref1}*$minlevel)) {
       if ($dbref ne $current_dbref) {
         $~ = PROFILE_OBJ;
	 write;
	 $current_dbref=$dbref;
	 $~ = PROFILE;
       }
      write   ;
    }
  }
}

print "\n\nMemory required for keys (bytes): ",$memsize,"\n";

print "\nProcess Information:\n";
print `ps -pm $$`;
print "\n";

print `ps -u $$`;


#980109.211041 TestMush CMD/ALL  : The Force(#1) in Universe(#22) 
#  entered: '@@ 884401841'
#980109.211051 TestMush CMD/ALL  : The Force(#1) in Universe(#22) entered: '@@ 884401851'
#980109.211059 TestMush CMD/ALL  : Global Commands(#40) in Master_Room(#17) entered: '@pemit %#=u(#40/u_sheet,%#)'
#980109.211101 TestMush CMD/ALL  : The Force(#1) in Universe(#22) entered: '@@ 884401861'
#980109.211111 TestMush CMD/ALL  : The Force(#1) in Universe(#22) entered: '@@ 884401871'
#980109.211121 TestMush CMD/ALL  : The Force(#1) in Universe(#22) entered: '@@ 884401881'
#980109.211126 TestMush CMD/ALL  : Wizard_Object(#19) in Master_Room(#17) entered: '@switch/first default(%#/chargen,0)=Finished,{},{@fo %#=home;}'
#980109.211126 TestMush CMD/ALL  : GuestManager(#128) in Master_Room(#17) entered: '@switch member(v(guests),%#)=0,{@tr me/tr_monitord=u(u_monitors),%#;},{@wait me={@pemit/list u(u_wizards)=%N has disconnected from [get(%#/lastsite)];@switch/first isdbref(num(*Guest))=0,{@name %#=Guest;@notify me;},{@notify me;}}}'
#980109.211126 TestMush CMD/ALL  : Wizard_Object(#19) in Master_Room(#17) entered: '@fo %#=home'
#980109.211126 TestMush CMD/ALL  : GuestManager(#128) in Master_Room(#17) entered: '@tr me/tr_monitord=u(u_monitors),%#'