#
# Copyright 1998 VMware, Inc.  All rights reserved. -- VMware Confidential
# $Id$

#
# Profiler::Callback: Private Helper Package
#
package VMware::Control::Profiler::Callback;

# args: self, profiler_ref
sub new {
    my ($self, $p) = @_;
    my $type = ref($self) || $self;
    return bless { p => $p }, $type;
}

DESTROY {
    my $self = shift;
    $self->{p}->end();
}

# 
# Profiler implements some simple profiling mechanisms.
#


package VMware::Control::Profiler;

use VMware::Control;
use strict;
use Carp;
use FileHandle;
use vars qw($VERSION @ISA @EXPORT_OK);

require Exporter;
require DynaLoader;
require AutoLoader;


BEGIN{
    $VERSION = '1.01';
    # This envionment variable turns on/off the profiler mechanism.
    # It is set in the setup script of MUI and VMServerd:
    # MUI: init.pl (windows)
    # 
    # $ENV{vmware_PROFILE} = 1; # 1 = on; 0 = off
    if($^O eq "MSWin32") {
        $ENV{vmware_PROFILE_ROOT} = 'C:/';
    } else {
        $ENV{vmware_PROFILE_ROOT} = "/tmp/"; # XXX: temporary solution
    }
};

@ISA = qw(Exporter DynaLoader);
@EXPORT_OK = ('$START_TAG',         # These are the tags that get prepended
	      '$END_TAG',           # to entries.  They are exported mainly
	      '$TAG_TAG',           # so that users call raw() can use them.
	      '$REMOTE_START_TAG',
	      '$REMOTE_END_TAG',

	      "start",              # start 
	      "end",                # end
	      "tag",        	    # simple timestamp
	      "raw",        	    # add raw tag (no prefix added by Profiler)
	                    	    # use with caution!!!
	      "flush",      	    # flush      (flush entries to log file)
	      "profile",    	    # start + automatic end
	      "remote_start",       # indicate start of a remote call
	      "remote_end",         # indicate end of a remote call
	      );

use vars qw($START_TAG
	    $TAG_TAG
	    $END_TAG
	    $REMOTE_START_TAG
	    $REMOTE_END_TAG
	    );


#bootstrap VMware::Control::Profiler $VERSION;

#Preloaded methods go here.

my %_instances;
$START_TAG = "start ";
$TAG_TAG = "tag ";
$END_TAG = "end ";
$REMOTE_START_TAG = "remote start ";
$REMOTE_END_TAG = "remote end ";

# class Method
sub getInstance (;$$) {
    my ($key, $handle) = @_;
    $key ||= "default";
    $handle ||= "profile_$key.log";
    # only the first call to getInstance() on a particular instance
    # can set the handle
    my $instance = $_instances{$key} || new VMware::Control::Profiler($handle);
    return $_instances{$key} = $instance;
}

sub new (;$) {
    my $self = shift;
    my $type = ref($self) || $self;
    return bless { fn => shift, ts => [] , depth => 0 }, $type;
}

sub start(;$) {
    return unless $ENV{vmware_PROFILE};
    my $self = shift;
    my $tag = shift || (caller(1))[3] || (caller)[1];
    my $ts = _get_time();
    push @{$self->{ts}}, "$ts $START_TAG$tag"; # timestamp subroutine-name 
                                                # or filename if at top level
    $self->{depth}++;
}

sub profile() {
    return unless $ENV{vmware_PROFILE};

    # start() + return Callback instance
    # can't call start() since caller would not give the right info
    my $self = shift;
    my $tag = (caller(1))[3] || (caller)[1];
    my $ts = _get_time();
    push @{$self->{ts}}, "$ts $START_TAG$tag";
    $self->{depth}++;
    return new VMware::Control::Profiler::Callback($self);
}

sub end() {
    return unless $ENV{vmware_PROFILE};
    my $self = shift;
    my $ts = _get_time();
    push @{$self->{ts}}, "$ts $END_TAG"; # tag needed to differentiate it from tag()
    if(--$self->{depth} == 0) {
	$self->flush();
    }
}

sub tag($) {
    return unless $ENV{vmware_PROFILE};
    my ($self, $tag) = @_;
    my $ts = _get_time();
    push @{$self->{ts}}, "$ts $TAG_TAG$tag";
}

# use with caution!
sub raw($) {
    return unless $ENV{vmware_PROFILE};
    my ($self, $tag) = @_;
    my $ts = _get_time();
    push @{$self->{ts}}, "$ts $tag";

    if($tag =~ /^$START_TAG/) {
	$self->{depth}++;
    } elsif($tag =~ /^$END_TAG/) {
	if(--$self->{depth} == 0) {
	    $self->flush();
	}
    }
}

sub flush(;$) {
    return unless $ENV{vmware_PROFILE};
    my ($self, $handle) = @_;
    return unless @{$self->{ts}};
    $handle = $handle ? _handle($handle) : _handle($self->{fn});
    if(!$handle) { # shouldn't happen
	$handle = \*STDERR;
    }
    my $note = "# Flushed @ " . _get_day_time();
    print $handle join("\n", "", $note, @{$self->{ts}}, "");
    $self->{ts} = [];
    _close($handle);
}

sub remote_start (;$) {
    my $self = shift;
    $self->tag($REMOTE_START_TAG . shift);
}

sub remote_end () {
    my $self = shift;
    $self->tag($REMOTE_END_TAG);
}    

sub _handle($) {
    return unless $ENV{vmware_PROFILE};
    my $handle = shift || \*STDERR;
    if($handle && !ref($handle)) { # assume it is a filename
	$handle = new FileHandle(">>$ENV{vmware_PROFILE_ROOT}$handle");
    } # else, we assume it's a (F|f)ilehandle reference
    return $handle;
}

sub _close($) {
    return unless $ENV{vmware_PROFILE};
    my $handle = shift;
    if(ref($handle) eq 'FileHandle') {
	$handle->close();
    } else {
	close($handle);
    }
}

sub _get_time() {
    return GetTime(); # from VMware::Control
#    return VMware::Control::GetTime();
}

# if need state info of $self, it will need to be declared as a method
sub _get_day_time () {
    my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) =
	localtime;
    return sprintf("%02d:%02d:%02d-%02d/%02d/%04d", 
		   $hour, $min, $sec, $mon + 1, $mday, $year + 1900);
}
    
    

1;

__END__

=head1 NAME

VMware::Control::Profiler - A perl module for profiling.

=head1 SYNOPSIS

    use VMware::Control::Profiler;
    my $p = VMware::Control::Profiler::getInstance($name, $handle);
    my $p = new VMware::Control::Profiler($handle);

   sub some_sub {
     $p->start(); # record timestamp and subroutine name
     bluh bluh bluh # do your work here
     $p->tag($tag);  # optionally record timestamp with some tag
     $p->end(); # record timestamp and signal end of subroutine
   }
   
   or use profile() (which is the preferred way of using this module)
   
   sub some_other_sub {
     my $stub = $p->profile();
     blah blah blah # do you work here
   }

=head1 DESCRIPTION

Among the two constructors, the first form allows multiple modules sharing 
one instance of Profiler. The second form creates stand-alone Profilers.
In the first form, if $handle is not specified, the default log file
is "profile_$name.log".  All log files are placed in /tmp/ by default.

Notice that the assignment of the return value of $p->profile() to some 
'my' variable is REQUIRED.

=head1 AUTHORS

Ming Gu

=head1 COPYRIGHT

    (c) 2000-2001 VMware Incorporated.  All rights reserved.

=head1 VERSION

=head1 SEE ALSO

perl(1).

=cut
