[Bio] / FigKernelPackages / Stats.pm Repository:
ViewVC logotype

View of /FigKernelPackages/Stats.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.2 - (download) (as text) (annotate)
Tue Feb 6 16:25:18 2007 UTC (13 years, 3 months ago) by parrello
Branch: MAIN
Changes since 1.1: +27 -1 lines
Added a one-line display method.

package Stats;

    use strict;
    use Carp;
    use Tracer;

=head1 Statistical Reporting Object

=head2 Introduction

This package defines an object that can be used to track one or more totals and a list of
messages. The object is intially created in a blank state. Use the L</Add> method to add a
value to one of the totals. Use the L</AddMessage> method to add a message. The messages
will be returned as one long string with new-lines separating the individual messages. To
retrieve a counter value, use its name as a hash key. Thus, C<< $stats->{rows} >> would be
the value of the C<rows> counter. The messages are stored under the key C<Messages>.

=cut

#: Constructor Stats->new();

=head2 Public Methods

=head3 new

C<< my $stats = Stats->new($name1, $name2, ... $nameN); >>

This is the constructor for the statistical reporting object. It returns an object
with no messages and zero or more counters, all set to 0. Note that there is no
need to prime the counters in this constructor, so

C<< my $stats = Stats->new(); >>

is perfectly legal. In that case, the counters are created as they are needed. The advantage
to specifying names in the constructor is that they will appear on the output as having a
zero value when the statistics object is printed or dumped.

=over 4

=item name1, name2, ... nameN

Names of the counters to pre-create.

=back

=cut

sub new {
    # Get the parameters.
    my ($class, @names) = @_;
    # Create the new statistics object.
    my $self = { Messages => "" };
    # Put the specified counters into it.
    for my $name (@names) {
        $self->{$name} = 0;
    }
    # Bless and return it.
    bless $self;
    return $self;
}

=head3 Add

C<< my $newValue = $stats->Add($name, $value); >>

Add the specified value to the counter with the specified name. If the counter does not
exist, it will be created with a value of 0.

=over 4

=item name

Name of the counter to be created or updated.

=item value

Value to add to the counter. If omitted, a value of C<1> will be assumed.

=item RETURN

Returns the new value of the counter.

=back

=cut
#: Return Type $;
sub Add {
    # Get the parameters.
    my ($self, $name,$value) = @_;
    # Note that we can't use a simple "!$value", because then 0 would
    # be translated to 1.
    if (!defined $value) {
        $value = 1;
    }
    # Get the counter's current value. If it doesn't exist, use 0.
    my $current = $self->{$name};
    if (!$current) {
        $current = 0;
    }
    # Update the counter by adding the value.
    my $retVal = $current + $value;
    $self->{$name} = $retVal;
    # Return the new value.
    return $retVal;
}

=head3 Accumulate

C<< $stats->Accumulate($other); >>

Roll another statistics object's values into this object. The messages will be added to our message
list, and the values of the counters will be added together. If a counter exists only in this object,
it will not be affected. If a counter exists only in the other object, it will be copied into this
one.

=over 4

=item other

Other statistical object whose values are to be merged into this object.

=back

=cut

sub Accumulate {
    # Get the parameters.
    my ($self, $other) = @_;
    # Loop through the other object's values, merging them in.
    while (my ($name,$value) = each %{$other}) {
        if ($name eq "Messages") {
            $self->AddMessage($value);
        } else {
            $self->Add($name, $value);
        }
    }
}

=head3 Ask

C<< my $counter = $stats->Ask($name); >>

Return the value of the named counter.

=over 4

=item name

Name of the counter whose value is desired.

=item RETURN

Returns the value of the named counter, or C<0> if the counter does not
exist.

=back

=cut

sub Ask {
    # Get the parameters.
    my ($self, $name) = @_;
    # Clear the return value.
    my $retVal = 0;
    # If the counter exists, save its value.
    if (exists $self->{$name}) {
        $retVal = $self->{$name};
    }
    # Return the result.
    return $retVal;
}

=head3 AddMessage

C<< $stats->AddMessage($text); >>

Add a message to the statistical object's message queue.

=over 4

=item text

The text of the message to add.

=back

=cut

sub AddMessage {
    # Get the parameters.
    my ($self, $text) = @_;
    # Perform an intelligent joining.
    my $current = $self->{Messages};
    # Only proceed if there's text being added. An empty message can be ignored.
    if ($text) {
        Trace("AddMessage: $text") if T(2);
        if (!$current) {
            # The first message is added unvarnished.
            $self->{Messages} = $text;
        } else {
            # Here we have a message to append to existing text.
            $self->{Messages} = "$current\n$text";
        }
    }
}

=head3 Show

C<< my $dataList = $stats->Show(); >>

Display the statistics and messages in this object as a series of lines of text.

=cut
#: Return Type $;
sub Show {
    # Get the parameters.
    my ($self) = @_;
    # Create the return variable.
    my $retVal = "";
    # Loop through the statistics.
    for my $statKey (sort keys %{$self}) {
        # Only proceed if this is not the message queue.
        if ($statKey ne "Messages") {
            # Add the statistic and its value.
            my $statValue = $self->{$statKey};
            $retVal .= "$statKey\t$statValue\n";
        }
    }
    # Display the messages.
    $retVal .= "\n" . $self->{Messages} . "\n";
    # Return the result.
    return $retVal;
}

=head3 Display

C<< my $dataList = $stats->Display(); >>

Display the statistics in this object as a single line of text.

=cut
#: Return Type $;
sub Display {
    # Get the parameters.
    my ($self) = @_;
    # Create the return variable.
    my $retVal = "";
    # Loop through the statistics.
    for my $statKey (sort keys %{$self}) {
        # Only proceed if this is not the message queue.
        if ($statKey ne "Messages") {
            # Add the statistic and its value.
            my $statValue = $self->{$statKey};
            $retVal .= " $statKey = $statValue;";
        }
    }
    # Return the result.
    return $retVal;
}

1;

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3