The Tor Browser: tools/page-loader/URLTimingDataSet.pm@6474c204b198 (annotated)

tools/page-loader/URLTimingDataSet.pm@6474c204b198 (annotated)

tools/page-loader/URLTimingDataSet.pm

Wed, 31 Dec 2014 06:09:35 +0100

author: Michael Schloh von Bennewitz <michael@schloh.com>
date: Wed, 31 Dec 2014 06:09:35 +0100
changeset 0: 6474c204b198
permissions: -rw-r--r--

Cloned upstream origin tor-browser at tor-browser-31.3.0esr-4.5-1-build1
revision ID fc1c9ff7c1b2defdbc039f12214767608f46423f for hacking purpose.

 #
 # This Source Code Form is subject to the terms of the Mozilla Public
 # License, v. 2.0. If a copy of the MPL was not distributed with this
 # file, You can obtain one at http://mozilla.org/MPL/2.0/.
 package URLTimingDataSet;
 use DBI;
 use PageData;       # list of test pages, etc.
 use strict;
 sub new {
     my $proto = shift;
     my $class = ref($proto) || $proto;
     my $self  = {
         dataset   => [],
         results   => [],
         sorted    => [],
         average   => undef,
         avgmedian => undef,    # note: average of individual medians
         maximum   => undef,
         minimum   => undef,
     };
     $self->{id}    = shift || die "No id supplied";
     $self->{table} = shift || "t" . $self->{id};
     $self->{pages} = PageData->new;
     bless ($self, $class);
     $self->_grok();
     return $self;
 }
 sub _grok {
     my $self = shift;
     my ($res);
     # select the dataset from the db
     $self->_select();
     for (my $i=0; $i < $self->{pages}->length; $i++) {
         my $name = $self->{pages}->name($i);
         my $count = 0;
         my @times = ();
         my $nan = 0;
         foreach my $ref (@{$self->{dataset}}) {
             next if ($name ne $ref->{content});
             $count++;
             if ($ref->{c_part} eq "NaN") {
                 # we bailed out of this page load
                 $res = "NaN";
                 $nan = 1;
             }
             else {
                 my $s_intvl = $ref->{s_intvl};
                 my $c_intvl = $ref->{c_intvl};
                 my $errval = abs($s_intvl-$c_intvl)/(($s_intvl+$c_intvl)/2);
                 if ($errval > 0.08) {       # one of them went wrong and stalled out (see [1] below)
                     $res = ($s_intvl <= $c_intvl) ? $s_intvl : $c_intvl;
                 } else {
                     $res = int(($s_intvl + $c_intvl)/2);
                 }
             }
             push @times, $res;
         }
         my $avg = int(_avg(@times));
         my $med = _med(@times);
         my $max = $nan ? "NaN" : _max(@times);
         my $min = _min(@times);
         push @{$self->{results}}, [ $i, $name, $count, $avg, $med, $max, $min, @times ];
     }
     $self->_get_summary();
     $self->_sort_result_set();
 }
 sub _select {
     my $self = shift;
     my $dbh = DBI->connect("DBI:CSV:f_dir=./db", {RaiseError => 1, AutoCommit => 1})
          or die "Cannot connect: " . $DBI::errstr;
     my $sql = qq{
         SELECT INDEX, S_INTVL, C_INTVL, C_PART, CONTENT, ID
              FROM $self->{table}
                   WHERE ID = '$self->{id}'
                 };
     my $sth = $dbh->prepare($sql);
     $sth->execute();
     while (my @data = $sth->fetchrow_array()) {
         push @{$self->{dataset}},
         {index   => $data[0],
          s_intvl => $data[1],
          c_intvl => $data[2],
          c_part  => $data[3],
          content => $data[4],
          id      => $data[5]
           };
     }
     $sth->finish();
     $dbh->disconnect();
 }
 sub _get_summary {
     my $self = shift;
     my (@avg, @med, @max, @min);
     # how many pages were loaded in total ('sampled')
     $self->{samples} = scalar(@{$self->{dataset}});
     # how many cycles (should I get this from test parameters instead?)
     $self->{count} = int(_avg( map($_->[2],  @{$self->{results}}) ));
     #warn $self->{count};
     # calculate overall average, average median, maximum, minimum, (RMS Error?)
     for (@{$self->{results}}) {
         push @avg, $_->[3];
         push @med, $_->[4];
         push @max, $_->[5];
         push @min, $_->[6];
     }
     $self->{average}   = int(_avg(@avg));
     $self->{avgmedian} = int(_avg(@med));     # note: averaging individual medians
     $self->{maximum}   = _max(@max);
     $self->{minimum}   = _min(@min);
 }
 sub _sort_result_set {
     my $self = shift;
     # sort by median load time
     # @{$self->{sorted}} = sort {$a->[4] <=> $b->[4]} @{$self->{results}};
     # might be "NaN", but this is lame of me to be carrying around a string instead of undef
     @{$self->{sorted}} =
          sort {
              if ($a->[4] eq "NaN" || $b->[4] eq "NaN") {
                  return $a->[4] cmp $b->[4];
              } else {
                  return $a->[4] <=> $b->[4];
              }
          } @{$self->{results}};
 }
 sub as_string {
     my $self = shift;
     return $self->_as_string();
 }
 sub as_string_sorted {
     my $self = shift;
     return $self->_as_string(@{$self->{sorted}});
 }
 sub _as_string {
     my $self = shift;
     my @ary = @_ ? @_ : @{$self->{results}};
     my $str;
     for (@ary) {
         my ($index, $path, $count, $avg, $med, $max, $min, @times) = @$_;
         $str .= sprintf "%3s %-26s\t", $index, $path;
         if ($count > 0) {
             $str .= sprintf "%6s %6s %6s %6s ", $avg, $med, $max, $min;
             foreach my $time (@times) {
                 $str .= sprintf "%6s ", $time;
             }
         }
         $str .= "\n";
     }
     return $str;
 }
 #
 # package internal helper functions
 #
 sub _num {
     my @array = ();
     for (@_) { push @array, $_ if /^[+-]?\d+\.?\d*$/o; }
     return @array;
 }
 sub _avg {
     my @array = _num(@_);
     return "NaN" unless scalar(@array);
     my $sum = 0;
     for (@array) { $sum += $_; }
     return $sum/scalar(@array);
 }
 sub _max {
     my @array = _num(@_);
     return "NaN" unless scalar(@array);
     my $max = $array[0];
     for (@array) { $max = ($max > $_) ? $max : $_; }
     return $max;
 }
 sub _min {
     my @array = _num(@_);
     return "NaN" unless scalar(@array);
     my $min = $array[0];
     for (@array) { $min = ($min < $_) ? $min : $_; }
     return $min;
 }
 # returns the floor(N/2) element of a sorted ascending array
 sub _med {
     my @array = _num(@_);
     return "NaN" unless scalar(@array);
     my $index = int((scalar(@array)-1)/2);
     @array = sort {$a <=> $b} @array;
     return $array[$index];
 }
 ; # return true
 ################################################################################
 #
 # [1] in looking at the test results, in almost all cases, the
 # round-trip time measured by the server logic and the client logic
 # would be almost the same value (which is what one would
 # expect). However, on occasion, one of the them would be "out of
 # whack", and inconsistent with the additional "layout" measure by the
 # client.
 #
 #    i.e., a set of numbers like these:
 #      c_part     c_intvl      s_intvl
 #      800      1003        997
 #      804      1007        1005
 #      801      1001        1325             <--
 #      803      1318        998              <--
 #      799      1002        1007
 #      ...
 #
 # which looks like the server side would stall in doing the accept or
 # in running the mod-perl handler (possibly a GC?). (The following
 # c_intvl would then be out of whack by a matching amount on the next
 # cycle).
 #
 # At any rate, since it was clear from comparing with the 'c_part'
 # measure, which of the times was bogus, I just use an arbitrary error
 # measure to determine when to toss out the "bad" value.
 #

The Tor Browser / annotate

tools/page-loader/URLTimingDataSet.pm@6474c204b198 (annotated)

tools/page-loader/URLTimingDataSet.pm