← Index
NYTProf Performance Profile   « line view »
For /usr/local/bin/sa-learn
  Run on Tue Nov 7 05:38:10 2017
Reported on Tue Nov 7 06:16:03 2017

Filename/usr/local/lib/perl5/site_perl/mach/5.24/Razor2/Signature/Ephemeral.pm
StatementsExecuted 7 statements in 2.08ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
11140µs47µsRazor2::Signature::Ephemeral::::BEGIN@4Razor2::Signature::Ephemeral::BEGIN@4
11120µs74µsRazor2::Signature::Ephemeral::::BEGIN@5Razor2::Signature::Ephemeral::BEGIN@5
11119µs94µsRazor2::Signature::Ephemeral::::BEGIN@6Razor2::Signature::Ephemeral::BEGIN@6
0000s0sRazor2::Signature::Ephemeral::::debugRazor2::Signature::Ephemeral::debug
0000s0sRazor2::Signature::Ephemeral::::encode_separatorRazor2::Signature::Ephemeral::encode_separator
0000s0sRazor2::Signature::Ephemeral::::hexdigestRazor2::Signature::Ephemeral::hexdigest
0000s0sRazor2::Signature::Ephemeral::::newRazor2::Signature::Ephemeral::new
0000s0sRazor2::Signature::Ephemeral::::picksectionRazor2::Signature::Ephemeral::picksection
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments		 Time
on line		 Calls Time
in subs		 Code
1#!/usr/local/bin/perl
2
3package Razor2::Signature::Ephemeral;
4254µs254µs
# spent 47µs (40+7) within Razor2::Signature::Ephemeral::BEGIN@4 which was called: # once (40µs+7µs) by Razor2::Client::Engine::BEGIN@6 at line 4
use strict;
# spent 47µs making 1 call to Razor2::Signature::Ephemeral::BEGIN@4 # spent 7µs making 1 call to strict::import
5251µs2128µs
# spent 74µs (20+54) within Razor2::Signature::Ephemeral::BEGIN@5 which was called: # once (20µs+54µs) by Razor2::Client::Engine::BEGIN@6 at line 5
use Digest::SHA1;
# spent 74µs making 1 call to Razor2::Signature::Ephemeral::BEGIN@5 # spent 54µs making 1 call to Exporter::import
621.96ms2169µs
# spent 94µs (19+75) within Razor2::Signature::Ephemeral::BEGIN@6 which was called: # once (19µs+75µs) by Razor2::Client::Engine::BEGIN@6 at line 6
use Data::Dumper;
# spent 94µs making 1 call to Razor2::Signature::Ephemeral::BEGIN@6 # spent 75µs making 1 call to Exporter::import
7
8sub new {
9
10 my ($class, %args) = @_;
11
12 my $self = bless {
13 seed => $args{seed} || 42,
14 separator => encode_separator($args{separator}) || encode_separator("10"),
15 }, $class;
16 $self;
17
18}
19
20
21sub hexdigest {
22
23 my ($self, $content) = @_;
24
25 # Initialize PRNG with $seed
26 srand($$self{seed});
27
28 my @content = split /$$self{separator}/, $content;
29 # $content =~ s/$$self{separator}//g; -- We don't do this anyore
30
31 # my $size = length($content);
32 my $lines = scalar @content;
33
34 debug("\nNumber of lines: $lines");
35
36 # Randomly choose relative locations and section sizes (in percent)
37 my $sections = 6;
38 my $ssize = 100/$sections;
39 my @rel_lineno = map { rand($ssize) + ($_*$ssize) } 0 .. ($sections-1);
40 my @lineno = map { int(($_ * $lines)/100) } @rel_lineno;
41
42 debug("Relative Line Numbers (in percent): @rel_lineno");
43 debug("Absolute Line Numbers: @lineno");
44
45 my @rel_offset1 = map { rand(50) + ($_*50) } qw(0 1);
46 my @rel_offset2 = map { rand(50) + ($_*50) } qw(0 1);
47
48 debug("Relative Offsets for section 1: @rel_offset1");
49 debug("Relative Offsets for section 2: @rel_offset2");
50
51 my ($l1, $l2) = (0, 0);
52 for ($lineno[1] .. $lineno[2]) { $l1 += length($content[$_]) if $content[$_]}
53 for ($lineno[3] .. $lineno[4]) { $l2 += length($content[$_]) if $content[$_] }
54
55 debug("Length of the first section: $l1 bytes");
56 debug("Length of the second section: $l2 bytes");
57
58 my @offset1 = map { int(($_ * $l1)/100) } @rel_offset1;
59 my @offset2 = map { int(($_ * $l2)/100) } @rel_offset2;
60
61 debug("Chunk start/end positions in Section 1: @offset1 (length: " . ($offset1[1] - $offset1[0]) .") ");
62 debug("Chunk start/end positions in Section 2: @offset2 (length: " . ($offset2[1] - $offset2[0]) .") ");
63
64 my $x = 0;
65 my ($sc, $sl, $ec, $el) = (0,0,0,0);
66 my $section1 = picksection( \@content,
67 $lineno[1], $lineno[2],
68 $offset1[0], $offset1[1]
69 );
70 my $section2 = picksection( \@content,
71 $lineno[3], $lineno[4],
72 $offset2[0], $offset2[1]
73 );
74
75 debug("Section 1: $section1");
76 debug("Section 2: $section2");
77
78 my $seclength = length($section1.$section2);
79
80 debug("Total length of stuff that will be hashed: $seclength");
81
82 if ($section1 =~ /^\s+$/ && $section2 =~ /^\s+$/) {
83 debug("Both sections were whitespace only!");
84 $section1 = "";
85 $section2 = "";
86 }
87
88 my $digest;
89 my $ctx = Digest::SHA1->new;
90
91 if ($seclength > 128) {
92 $ctx->add($section1);
93 $ctx->add($section2);
94 $digest = $ctx->hexdigest;
95 } else {
96 debug("Sections too small... reverting back to orginal content.");
97 $ctx->add($content);
98 $digest = $ctx->hexdigest;
99 }
100
101 debug("Computed e-hash is $digest");
102
103 return $digest;
104
105
106}
107
108
109sub picksection {
110
111 my ($content, $sline, $eline, $soffset, $eoffset) = @_;
112 my $x = 0;
113 my ($sc, $sl, $ec, $el) = (0,0,0,0);
114
115 for ($sline .. $eline) {
116 next unless $content->[$_];
117 $x = $x + length($content->[$_]);
118 if (($x > $soffset) && ($sc == 0)) { # we come here first time
119 $sc = length($content->[$_]) - ($x - $soffset); # $x is greater than start
120 $sl = $_; # offset
121 }
122 if ($x > $eoffset) {
123 $ec = length($content->[$_]) - ($x - $eoffset);
124 $el = $_;
125 }
126 last if $ec;
127 }
128
129 $sc = 0 if $sc < 0;
130 $ec = 0 if $ec < 0; # FIX! not verified to work correctly.
131
132 debug("Absolute chunk offsets: Line $sl charachter $sc to line $el character $ec");
133
134 my $section = "";
135
136 if ($sl == $el) {
137 if ($content->[$sl]) {
138 $section = substr ($content->[$sl], $sc, $ec - $sc + 1);
139 } else {
140 $section = "";
141 }
142 } else {
143 $section .= substr($content->[$sl], $sc);
144 for ($sl+1 .. $el-1) {
145 $section .= $content->[$_];
146 }
147 $section .= substr($content->[$el], 0, $ec);
148 }
149 return $section;
150}
151
152
153sub encode_separator {
154
155 my ($self, $separator) = @_;
156 my $rv;
157
158 unless (ref $self) { $separator = $self }
159 my @chars = split/-/, $separator;
160 push @chars, $separator unless scalar @chars;
161 for (@chars) { $rv .= chr($_) }
162 return $rv;
163
164}
165
166
167sub debug {
168 my $message = shift;
169 # print "debug: $message\n";
170 #open TMP, ">>/tmp/ehash";
171 #print TMP "$message\n";
172 #close TMP;
173}
174
175
17616µs1;
177
Report produced by the NYTProf 6.04 Perl profiler, developed by Tim Bunce based on work by Adam Kaplan and Salvador Fandiño García.