#!/usr/local/bin/perl
#
# This script will hopefully develop into a reasonable mush profiler.
#
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.

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.
# #
# 
# @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("orm");

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;
}

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 ".";
  }
  ($time,$object,$dbref,$owner,$foo,$where,$code) = 
    (/(\d+\.\d+).* CMD\/ALL\s*:\s*([^(]+)\(#(\d+)\)(\[.*\])*( in (.*))* entered: '(.*)'/);  

  next unless $dbref;

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

  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}++;

  unless ($count{$key}) {
    $keycount++ ;
    print "New key $key, $keycount keys.\n" if $opt_v;
  }
  $count{$key}++;
  $memsize += length($key);
}
#########################################################################
#
#
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/ALL 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  Percent
  ----- --------------------------------- ---------  -------      
.

format OBJLIST =
@ @<<<< @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< @>>>>>>>>  @###.## @<
$ast, $dbref, $dbref{$dbref}, $dcount{$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   Command
Len    Count    Percent  Executed
-----  -------- -------  -------------------------------
.

format PROFILE_OBJ=

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

format PROFILE=
@>>>>  @>>>>>>> @###.##  @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
$len, $count{$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),%#'