tools/page-loader/URLTimingDataSet.pm

   1 #
   2 # ***** BEGIN LICENSE BLOCK *****
   3 # Version: MPL 1.1/GPL 2.0/LGPL 2.1
   4 #
   5 # The contents of this file are subject to the Mozilla Public License Version
   6 # 1.1 (the "License"); you may not use this file except in compliance with
   7 # the License. You may obtain a copy of the License at
   8 # http://www.mozilla.org/MPL/
   9 #
  10 # Software distributed under the License is distributed on an "AS IS" basis,
  11 # WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
  12 # for the specific language governing rights and limitations under the
  13 # License.
  14 #
  15 # The Original Code is Mozilla page-loader test, released Aug 5, 2001.
  16 #
  17 # The Initial Developer of the Original Code is
  18 # Netscape Communications Corporation.
  19 # Portions created by the Initial Developer are Copyright (C) 2001
  20 # the Initial Developer. All Rights Reserved.
  21 #
  22 # Contributor(s):
  23 #   John Morrison <jrgm@netscape.com>, original author
  24 #
  25 # Alternatively, the contents of this file may be used under the terms of
  26 # either the GNU General Public License Version 2 or later (the "GPL"), or
  27 # the GNU Lesser General Public License Version 2.1 or later (the "LGPL"),
  28 # in which case the provisions of the GPL or the LGPL are applicable instead
  29 # of those above. If you wish to allow use of your version of this file only
  30 # under the terms of either the GPL or the LGPL, and not to allow others to
  31 # use your version of this file under the terms of the MPL, indicate your
  32 # decision by deleting the provisions above and replace them with the notice
  33 # and other provisions required by the GPL or the LGPL. If you do not delete
  34 # the provisions above, a recipient may use your version of this file under
  35 # the terms of any one of the MPL, the GPL or the LGPL.
  36 #
  37 # ***** END LICENSE BLOCK *****
  38 package URLTimingDataSet;
  39 use DBI;
  40 use PageData;       # list of test pages, etc.
  41 use strict;
  42
  43 sub new {
  44     my $proto = shift;
  45     my $class = ref($proto) || $proto;
  46     my $self  = {
  47         dataset   => [],
  48         results   => [],
  49         sorted    => [],
  50         average   => undef,
  51         avgmedian => undef,    # note: average of individual medians
  52         maximum   => undef,
  53         minimum   => undef,
  54     };
  55     $self->{id}    = shift || die "No id supplied";
  56     $self->{table} = shift || "t" . $self->{id};
  57     $self->{pages} = PageData->new;
  58     bless ($self, $class);
  59     $self->_grok();
  60     return $self;
  61 }
  62
  63
  64 sub _grok {
  65     my $self = shift;
  66     my ($res);
  67
  68     # select the dataset from the db
  69     $self->_select();
  70
  71     for (my $i=0; $i < $self->{pages}->length; $i++) {
  72         my $name = $self->{pages}->name($i);
  73         my $count = 0;
  74         my @times = ();
  75         my $nan = 0;
  76         foreach my $ref (@{$self->{dataset}}) {
  77             next if ($name ne $ref->{content});
  78             $count++;
  79             if ($ref->{c_part} eq "NaN") {
  80                 # we bailed out of this page load
  81                 $res = "NaN";
  82                 $nan = 1;
  83             }
  84             else {
  85                 my $s_intvl = $ref->{s_intvl};
  86                 my $c_intvl = $ref->{c_intvl};
  87                 my $errval = abs($s_intvl-$c_intvl)/(($s_intvl+$c_intvl)/2);
  88                 if ($errval > 0.08) {       # one of them went wrong and stalled out (see [1] below)
  89                     $res = ($s_intvl <= $c_intvl) ? $s_intvl : $c_intvl;
  90                 } else {
  91                     $res = int(($s_intvl + $c_intvl)/2);
  92                 }
  93             }
  94             push @times, $res;
  95         }
  96
  97         my $avg = int(_avg(@times));
  98         my $med = _med(@times);
  99         my $max = $nan ? "NaN" : _max(@times);
 100         my $min = _min(@times);
 101         push @{$self->{results}}, [ $i, $name, $count, $avg, $med, $max, $min, @times ];
 102     }
 103
 104     $self->_get_summary();
 105     $self->_sort_result_set();
 106
 107 }
 108
 109 sub _select {
 110     my $self = shift;
 111
 112     my $dbh = DBI->connect("DBI:CSV:f_dir=./db", {RaiseError => 1, AutoCommit => 1})
 113          or die "Cannot connect: " . $DBI::errstr;
 114
 115     my $sql = qq{
 116         SELECT INDEX, S_INTVL, C_INTVL, C_PART, CONTENT, ID
 117              FROM $self->{table}
 118                   WHERE ID = '$self->{id}'
 119                 };
 120
 121     my $sth = $dbh->prepare($sql);
 122     $sth->execute();
 123
 124     while (my @data = $sth->fetchrow_array()) {
 125         push @{$self->{dataset}},
 126         {index   => $data[0],
 127          s_intvl => $data[1],
 128          c_intvl => $data[2],
 129          c_part  => $data[3],
 130          content => $data[4],
 131          id      => $data[5]
 132           };
 133     }
 134     $sth->finish();
 135     $dbh->disconnect();
 136 }
 137
 138 sub _get_summary {
 139     my $self = shift;
 140     my (@avg, @med, @max, @min);
 141
 142     # how many pages were loaded in total ('sampled')
 143     $self->{samples} = scalar(@{$self->{dataset}});
 144
 145     # how many cycles (should I get this from test parameters instead?)
 146     $self->{count} = int(_avg( map($_->[2],  @{$self->{results}}) ));
 147     #warn $self->{count};
 148
 149     # calculate overall average, average median, maximum, minimum, (RMS Error?)
 150     for (@{$self->{results}}) {
 151         push @avg, $_->[3];
 152         push @med, $_->[4];
 153         push @max, $_->[5];
 154         push @min, $_->[6];
 155     }
 156     $self->{average}   = int(_avg(@avg));
 157     $self->{avgmedian} = int(_avg(@med));     # note: averaging individual medians
 158     $self->{maximum}   = _max(@max);
 159     $self->{minimum}   = _min(@min);
 160 }
 161
 162 sub _sort_result_set {
 163     my $self = shift;
 164     # sort by median load time
 165     # @{$self->{sorted}} = sort {$a->[4] <=> $b->[4]} @{$self->{results}};
 166     # might be "NaN", but this is lame of me to be carrying around a string instead of undef
 167     @{$self->{sorted}} =
 168          sort {
 169              if ($a->[4] eq "NaN" || $b->[4] eq "NaN") {
 170                  return $a->[4] cmp $b->[4];
 171              } else {
 172                  return $a->[4] <=> $b->[4];
 173              }
 174          } @{$self->{results}};
 175 }
 176
 177 sub as_string {
 178     my $self = shift;
 179     return $self->_as_string();
 180 }
 181
 182 sub as_string_sorted {
 183     my $self = shift;
 184     return $self->_as_string(@{$self->{sorted}});
 185 }
 186
 187
 188 sub _as_string {
 189     my $self = shift;
 190     my @ary = @_ ? @_ : @{$self->{results}};
 191     my $str;
 192     for (@ary) {
 193         my ($index, $path, $count, $avg, $med, $max, $min, @times) = @$_;
 194         $str .= sprintf "%3s %-26s\t", $index, $path;
 195         if ($count > 0) {
 196             $str .= sprintf "%6s %6s %6s %6s ", $avg, $med, $max, $min;
 197             foreach my $time (@times) {
 198                 $str .= sprintf "%6s ", $time;
 199             }
 200         }
 201         $str .= "\n";
 202     }
 203     return $str;
 204 }
 205
 206 #
 207 # package internal helper functions
 208 #
 209 sub _num {
 210     my @array = ();
 211     for (@_) { push @array, $_ if /^[+-]?\d+\.?\d*$/o; }
 212     return @array;
 213 }
 214
 215 sub _avg {
 216     my @array = _num(@_);
 217     return "NaN" unless scalar(@array);
 218     my $sum = 0;
 219     for (@array) { $sum += $_; }
 220     return $sum/scalar(@array);
 221 }
 222
 223 sub _max {
 224     my @array = _num(@_);
 225     return "NaN" unless scalar(@array);
 226     my $max = $array[0];
 227     for (@array) { $max = ($max > $_) ? $max : $_; }
 228     return $max;
 229 }
 230
 231 sub _min {
 232     my @array = _num(@_);
 233     return "NaN" unless scalar(@array);
 234     my $min = $array[0];
 235     for (@array) { $min = ($min < $_) ? $min : $_; }
 236     return $min;
 237 }
 238
 239 # returns the floor(N/2) element of a sorted ascending array
 240 sub _med {
 241     my @array = _num(@_);
 242     return "NaN" unless scalar(@array);
 243     my $index = int((scalar(@array)-1)/2);
 244     @array = sort {$a <=> $b} @array;
 245     return $array[$index];
 246 }
 247
 248 1; # return true
 249
 250 ################################################################################
 251 #
 252 # [1] in looking at the test results, in almost all cases, the
 253 # round-trip time measured by the server logic and the client logic
 254 # would be almost the same value (which is what one would
 255 # expect). However, on occasion, one of the them would be "out of
 256 # whack", and inconsistent with the additional "layout" measure by the
 257 # client.
 258 #
 259 #    i.e., a set of numbers like these:
 260 #      c_part     c_intvl      s_intvl
 261 #      800      1003        997
 262 #      804      1007        1005
 263 #      801      1001        1325             <--
 264 #      803      1318        998              <--
 265 #      799      1002        1007
 266 #      ...
 267 #
 268 # which looks like the server side would stall in doing the accept or
 269 # in running the mod-perl handler (possibly a GC?). (The following
 270 # c_intvl would then be out of whack by a matching amount on the next
 271 # cycle).
 272 #
 273 # At any rate, since it was clear from comparing with the 'c_part'
 274 # measure, which of the times was bogus, I just use an arbitrary error
 275 # measure to determine when to toss out the "bad" value.
 276 #