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

Annotation of /FigKernelPackages/Stats.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.3 - (view) (download) (as text)

1 : parrello 1.1 package Stats;
2 :    
3 :     use strict;
4 :     use Carp;
5 :     use Tracer;
6 :    
7 :     =head1 Statistical Reporting Object
8 :    
9 :     =head2 Introduction
10 :    
11 :     This package defines an object that can be used to track one or more totals and a list of
12 :     messages. The object is intially created in a blank state. Use the L</Add> method to add a
13 :     value to one of the totals. Use the L</AddMessage> method to add a message. The messages
14 :     will be returned as one long string with new-lines separating the individual messages. To
15 :     retrieve a counter value, use its name as a hash key. Thus, C<< $stats->{rows} >> would be
16 :     the value of the C<rows> counter. The messages are stored under the key C<Messages>.
17 :    
18 :     =cut
19 :    
20 :     #: Constructor Stats->new();
21 :    
22 :     =head2 Public Methods
23 :    
24 :     =head3 new
25 :    
26 : parrello 1.3 my $stats = Stats->new($name1, $name2, ... $nameN);
27 : parrello 1.1
28 :     This is the constructor for the statistical reporting object. It returns an object
29 :     with no messages and zero or more counters, all set to 0. Note that there is no
30 :     need to prime the counters in this constructor, so
31 :    
32 : parrello 1.3 my $stats = Stats->new();
33 : parrello 1.1
34 :     is perfectly legal. In that case, the counters are created as they are needed. The advantage
35 :     to specifying names in the constructor is that they will appear on the output as having a
36 :     zero value when the statistics object is printed or dumped.
37 :    
38 :     =over 4
39 :    
40 :     =item name1, name2, ... nameN
41 :    
42 :     Names of the counters to pre-create.
43 :    
44 :     =back
45 :    
46 :     =cut
47 :    
48 :     sub new {
49 :     # Get the parameters.
50 :     my ($class, @names) = @_;
51 :     # Create the new statistics object.
52 :     my $self = { Messages => "" };
53 :     # Put the specified counters into it.
54 :     for my $name (@names) {
55 :     $self->{$name} = 0;
56 :     }
57 :     # Bless and return it.
58 :     bless $self;
59 :     return $self;
60 :     }
61 :    
62 :     =head3 Add
63 :    
64 : parrello 1.3 my $newValue = $stats->Add($name, $value);
65 : parrello 1.1
66 :     Add the specified value to the counter with the specified name. If the counter does not
67 :     exist, it will be created with a value of 0.
68 :    
69 :     =over 4
70 :    
71 :     =item name
72 :    
73 :     Name of the counter to be created or updated.
74 :    
75 :     =item value
76 :    
77 :     Value to add to the counter. If omitted, a value of C<1> will be assumed.
78 :    
79 :     =item RETURN
80 :    
81 :     Returns the new value of the counter.
82 :    
83 :     =back
84 :    
85 :     =cut
86 :     #: Return Type $;
87 :     sub Add {
88 :     # Get the parameters.
89 :     my ($self, $name,$value) = @_;
90 :     # Note that we can't use a simple "!$value", because then 0 would
91 :     # be translated to 1.
92 :     if (!defined $value) {
93 :     $value = 1;
94 :     }
95 :     # Get the counter's current value. If it doesn't exist, use 0.
96 :     my $current = $self->{$name};
97 :     if (!$current) {
98 :     $current = 0;
99 :     }
100 :     # Update the counter by adding the value.
101 :     my $retVal = $current + $value;
102 :     $self->{$name} = $retVal;
103 :     # Return the new value.
104 :     return $retVal;
105 :     }
106 :    
107 :     =head3 Accumulate
108 :    
109 : parrello 1.3 $stats->Accumulate($other);
110 : parrello 1.1
111 :     Roll another statistics object's values into this object. The messages will be added to our message
112 :     list, and the values of the counters will be added together. If a counter exists only in this object,
113 :     it will not be affected. If a counter exists only in the other object, it will be copied into this
114 :     one.
115 :    
116 :     =over 4
117 :    
118 :     =item other
119 :    
120 :     Other statistical object whose values are to be merged into this object.
121 :    
122 :     =back
123 :    
124 :     =cut
125 :    
126 :     sub Accumulate {
127 :     # Get the parameters.
128 :     my ($self, $other) = @_;
129 :     # Loop through the other object's values, merging them in.
130 :     while (my ($name,$value) = each %{$other}) {
131 :     if ($name eq "Messages") {
132 :     $self->AddMessage($value);
133 :     } else {
134 :     $self->Add($name, $value);
135 :     }
136 :     }
137 :     }
138 :    
139 :     =head3 Ask
140 :    
141 : parrello 1.3 my $counter = $stats->Ask($name);
142 : parrello 1.1
143 :     Return the value of the named counter.
144 :    
145 :     =over 4
146 :    
147 :     =item name
148 :    
149 :     Name of the counter whose value is desired.
150 :    
151 :     =item RETURN
152 :    
153 :     Returns the value of the named counter, or C<0> if the counter does not
154 :     exist.
155 :    
156 :     =back
157 :    
158 :     =cut
159 :    
160 :     sub Ask {
161 :     # Get the parameters.
162 :     my ($self, $name) = @_;
163 :     # Clear the return value.
164 :     my $retVal = 0;
165 :     # If the counter exists, save its value.
166 :     if (exists $self->{$name}) {
167 :     $retVal = $self->{$name};
168 :     }
169 :     # Return the result.
170 :     return $retVal;
171 :     }
172 :    
173 :     =head3 AddMessage
174 :    
175 : parrello 1.3 $stats->AddMessage($text);
176 : parrello 1.1
177 :     Add a message to the statistical object's message queue.
178 :    
179 :     =over 4
180 :    
181 :     =item text
182 :    
183 :     The text of the message to add.
184 :    
185 :     =back
186 :    
187 :     =cut
188 :    
189 :     sub AddMessage {
190 :     # Get the parameters.
191 :     my ($self, $text) = @_;
192 :     # Perform an intelligent joining.
193 :     my $current = $self->{Messages};
194 :     # Only proceed if there's text being added. An empty message can be ignored.
195 :     if ($text) {
196 :     Trace("AddMessage: $text") if T(2);
197 :     if (!$current) {
198 :     # The first message is added unvarnished.
199 :     $self->{Messages} = $text;
200 :     } else {
201 :     # Here we have a message to append to existing text.
202 :     $self->{Messages} = "$current\n$text";
203 :     }
204 :     }
205 :     }
206 :    
207 :     =head3 Show
208 :    
209 : parrello 1.3 my $dataList = $stats->Show();
210 : parrello 1.1
211 : parrello 1.2 Display the statistics and messages in this object as a series of lines of text.
212 : parrello 1.1
213 :     =cut
214 :     #: Return Type $;
215 :     sub Show {
216 :     # Get the parameters.
217 :     my ($self) = @_;
218 :     # Create the return variable.
219 :     my $retVal = "";
220 :     # Loop through the statistics.
221 :     for my $statKey (sort keys %{$self}) {
222 :     # Only proceed if this is not the message queue.
223 :     if ($statKey ne "Messages") {
224 :     # Add the statistic and its value.
225 :     my $statValue = $self->{$statKey};
226 :     $retVal .= "$statKey\t$statValue\n";
227 :     }
228 :     }
229 :     # Display the messages.
230 :     $retVal .= "\n" . $self->{Messages} . "\n";
231 :     # Return the result.
232 :     return $retVal;
233 :     }
234 :    
235 : parrello 1.2 =head3 Display
236 :    
237 : parrello 1.3 my $dataList = $stats->Display();
238 : parrello 1.2
239 :     Display the statistics in this object as a single line of text.
240 :    
241 :     =cut
242 :     #: Return Type $;
243 :     sub Display {
244 :     # Get the parameters.
245 :     my ($self) = @_;
246 :     # Create the return variable.
247 :     my $retVal = "";
248 :     # Loop through the statistics.
249 :     for my $statKey (sort keys %{$self}) {
250 :     # Only proceed if this is not the message queue.
251 :     if ($statKey ne "Messages") {
252 :     # Add the statistic and its value.
253 :     my $statValue = $self->{$statKey};
254 :     $retVal .= " $statKey = $statValue;";
255 :     }
256 :     }
257 :     # Return the result.
258 :     return $retVal;
259 :     }
260 :    
261 : parrello 1.3 1;

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3