tools/page-loader/graph.pl@97036ab72558 (annotated)
tools/page-loader/graph.pl
Tue, 06 Jan 2015 21:39:09 +0100
- author
- Michael Schloh von Bennewitz <michael@schloh.com>
- date
- Tue, 06 Jan 2015 21:39:09 +0100
- branch
- TOR_BUG_9701
- changeset 8
- 97036ab72558
- permissions
- -rwxr-xr-x
Conditionally force memory storage according to privacy.thirdparty.isolate;
This solves Tor bug #9701, complying with disk avoidance documented in
https://www.torproject.org/projects/torbrowser/design/#disk-avoidance.
| michael@0 | 1 | #!/usr/bin/perl |
| michael@0 | 2 | # |
| michael@0 | 3 | # This Source Code Form is subject to the terms of the Mozilla Public |
| michael@0 | 4 | # License, v. 2.0. If a copy of the MPL was not distributed with this |
| michael@0 | 5 | # file, You can obtain one at http://mozilla.org/MPL/2.0/. |
| michael@0 | 6 | use CGI::Carp qw(fatalsToBrowser); |
| michael@0 | 7 | use CGI::Request; |
| michael@0 | 8 | use URLTimingDataSet; |
| michael@0 | 9 | use URLTimingGraph; |
| michael@0 | 10 | |
| michael@0 | 11 | my $request = new CGI::Request; |
| michael@0 | 12 | |
| michael@0 | 13 | my $id = $request->param('id'); #XXX need to check for valid parameter id |
| michael@0 | 14 | my $id2 = $request->param('id2') || undef; # possible comparison test |
| michael@0 | 15 | |
| michael@0 | 16 | # set up the data for the first graph |
| michael@0 | 17 | my $rs = URLTimingDataSet->new($id); |
| michael@0 | 18 | my @data = (); |
| michael@0 | 19 | push @data, [ map($_->[1], @{$rs->{sorted}}) ]; # URL |
| michael@0 | 20 | push @data, [ map($_->[4], @{$rs->{sorted}}) ]; # median |
| michael@0 | 21 | # '7' is the first slot for individual test run data |
| michael@0 | 22 | for (my $idx = 7; $idx < (7+$rs->{count}); $idx++) { |
| michael@0 | 23 | push @data, [ map($_->[$idx], @{$rs->{sorted}}) ]; |
| michael@0 | 24 | } |
| michael@0 | 25 | |
| michael@0 | 26 | |
| michael@0 | 27 | # set up the data for the second graph, if requested a second id |
| michael@0 | 28 | # need to sort according to the first chart's ordering |
| michael@0 | 29 | my $rs2; |
| michael@0 | 30 | if ($id2) { |
| michael@0 | 31 | $rs2 = URLTimingDataSet->new($id2); |
| michael@0 | 32 | my @order = map($_->[0], @{$rs->{sorted}}); # get the first chart's order |
| michael@0 | 33 | my @resort = (); |
| michael@0 | 34 | for my $i (@order) { |
| michael@0 | 35 | for (@{$rs2->{sorted}}) { |
| michael@0 | 36 | if ($i == $_->[0]) { |
| michael@0 | 37 | push @resort, $_; |
| michael@0 | 38 | last; |
| michael@0 | 39 | } |
| michael@0 | 40 | } |
| michael@0 | 41 | } |
| michael@0 | 42 | push @data, [ map($_->[4], @resort) ]; # median |
| michael@0 | 43 | for (my $idx = 7; $idx < (7+$rs2->{count}); $idx++) { |
| michael@0 | 44 | push @data, [ map($_->[$idx], @resort) ]; |
| michael@0 | 45 | } |
| michael@0 | 46 | } |
| michael@0 | 47 | |
| michael@0 | 48 | # and now convert 'NaN' to undef, if they exist in the data. |
| michael@0 | 49 | for (@data) { for (@$_) { $_ = undef if $_ eq "NaN"; } } |
| michael@0 | 50 | |
| michael@0 | 51 | # set up the chart parameters |
| michael@0 | 52 | my $args = {}; |
| michael@0 | 53 | $args->{cgimode} = 1; |
| michael@0 | 54 | $args->{title} = "id=$id"; |
| michael@0 | 55 | |
| michael@0 | 56 | # need to draw first visit as dotted with points |
| michael@0 | 57 | my $types = ['lines','lines']; for (1..$rs->{count}-1) { push @$types, undef; } |
| michael@0 | 58 | my $dclrs = []; for (0..$rs->{count}) { push @$dclrs, 'lred'; } |
| michael@0 | 59 | my $legend = [$id]; for (1..$rs->{count}) { push @$legend, undef; } |
| michael@0 | 60 | if ($id2) { |
| michael@0 | 61 | push @$types, 'lines'; for (1..$rs2->{count}) { push @$types, undef; } |
| michael@0 | 62 | for (0..$rs2->{count}) { push @$dclrs, 'lblue'; } |
| michael@0 | 63 | push @$legend, $id2; for (1..$rs2->{count}) { push @$legend, undef; } |
| michael@0 | 64 | } |
| michael@0 | 65 | $args->{types} = $types; |
| michael@0 | 66 | $args->{dclrs} = $dclrs; |
| michael@0 | 67 | $args->{legend} = $legend; |
| michael@0 | 68 | |
| michael@0 | 69 | #XXX set min to zero, and round max to 1000 |
| michael@0 | 70 | $args->{y_max_value} = maxDataOrCap(); |
| michael@0 | 71 | ## nope $args->{y_min_value} = 1000; |
| michael@0 | 72 | $args->{width} = 800; |
| michael@0 | 73 | $args->{height} = 720; |
| michael@0 | 74 | |
| michael@0 | 75 | my $g = URLTimingGraph->new(\@data, $args); |
| michael@0 | 76 | $g->plot(); |
| michael@0 | 77 | |
| michael@0 | 78 | exit; |
| michael@0 | 79 | |
| michael@0 | 80 | |
| michael@0 | 81 | sub maxDataOrCap { |
| michael@0 | 82 | my $max; |
| michael@0 | 83 | warn $rs->{maximum}; |
| michael@0 | 84 | if ($rs2 && ($rs->{maximum} < $rs2->{maximum})) { |
| michael@0 | 85 | $max = $rs2->{maximum}; |
| michael@0 | 86 | } else { |
| michael@0 | 87 | $max = $rs->{maximum}; |
| michael@0 | 88 | } |
| michael@0 | 89 | warn $max; |
| michael@0 | 90 | #return $max > 10000 ? 10000 : 1000*int($max/1000)+1000; |
| michael@0 | 91 | # just return whatever, rounded to 1000 |
| michael@0 | 92 | return 1000*int($max/1000)+1000; |
| michael@0 | 93 | } |
