Term-Sample
view release on metacpan or search on metacpan
my $self = shift if(substr($_[0],0,6) eq 'Term::');
my %args = @_;
my $echo = $args{echo} || 0;
$echo=0 if($echo eq 'key');
my $print_flag = ($echo eq 'none')?0:1;
my $newline = $args{newline} || 1;
my ($flag,$state,$key,$delay,$sample,$ms1,$s1,$ms2,$s2,$counter)=
(0,0,0,0,[],0,0,0,0);
while(!$flag) {
my @ci = getch();
my $c=$ci[0];
my $s=$ci[1];
my $ok=(ascii($c)!=13 && ascii($c)!=8 && ascii($c)!=0)?1:0;
# Handle key down
if(($c && $s && $ok)
|| ($^O ne "MSWin32" && $c && $ok)) {
($s1,$ms1) = gettimeofday;
if(!$key) {
$sample->[$key] = { key => $c, delay => 0, inter => 0 };
} else {
$sample->[$key] = { key => $c, delay => plus($ms1-$ms2), inter => 0 };
}
$counter = 0;
}
# Handle key up
elsif(($c && !$s && $ok)
|| ($^O ne "MSWin32" && $c && $ok)) {
($s2,$ms2) = gettimeofday;
$sample->[$key]->{inter} = plus($ms2-$ms1);
$counter = 0;
$key++;
}
# Handle backspace display and data removal
if($c && !$s && ascii($c)==8) {
print "$c $c" if($key>0);
$key-- if($key>0);
$sample->[$key] = { key => '', $delay => 0, inter => 0 };
# Print out all correct echoes
} else {
print $echo if($c && !$s && $echo && $print_flag && ascii($c)!=0);
print $c if($c && !$s && !$echo && $print_flag && ascii($c)!=13 && ascii($c)!=0);
}
# Exit loop if enter pressed
$flag = 1 if(ascii($c) == 13 && $key);
}
print "\n" if($newline);
return $sample;
}
sub print_data {
my $self = shift if(substr($_[0],0,6) eq 'Term::');
my $sample = shift; # || $_;
my %args = @_;
my $type = $args{type};
if(ref($sample) ne "ARRAY" && ($type eq "basic" || $type eq "avg" || $type eq "average")) {
print "Error: Invalid sample data type at @{[(caller)[1]]} line @{[(caller)[2]]}\n";
return undef;
}
elsif(ref($sample) ne "HASH" && ($type eq "analysis" || $type eq "overview" || $type eq "details")) {
print "Error: Invalid analysis data type at @{[(caller)[1]]} line @{[(caller)[2]]}\n";
return undef;
}
if(ref($sample) eq "ARRAY") {
if(!$type || $type eq 'basic') {
for my $key (0..$#{$sample}) {
print "idx: $key ",(($key<10)?' ':' '),"[ key => $sample->[$key]->{key}, delay => $sample->[$key]->{delay}, inter => $sample->[$key]->{inter} ]\n";
}
}
elsif($type eq 'average' || $type eq 'avg') {
my $delay = 0;
my $inter = 0;
my $codes = 0;
for my $key (0..$#{$sample}) {
$codes+=ascii($sample->[$key]->{key});
$delay+=$sample->[$key]->{delay};
$inter+=$sample->[$key]->{inter};
}
print "Total Key Presses : $#{$sample}\n";
print "Average Key Codes : ",plus(round($codes/$#{$sample},2)),"\n";
print "Average Key Hold Time : ",plus(round($inter/$#{$sample},2)),"\n";
print "Average Inter-Key Time : ",plus(round($delay/$#{$sample},2)),"\n";
}
} elsif(ref($sample) eq "HASH") {
if($type eq "overview" || !$type) {
print "\nAnalysis Overview\n";
print "\nTotal Key Presses : $sample->{size}\n";
print "Average Key Codes : ",round($sample->{avg_codes},2),"\n";
print "Average Key Hold Time : ",round($sample->{avg_delay},2),"\n";
print "Average Inter-Key Time : ",round($sample->{avg_inter},2),"\n";
my $x=0;
print "\nTop Inter-Key Speeds: \n";
print "\tKeys : $sample->{sorted_delay}->[0]->{codes}->[0]->{char}, $sample->{sorted_delay}->[0]->{codes}->[1]->{char}, $sample->{sorted_delay}->[0]->{codes}->[2]->{char} \n";
print "\tCodes : $sample->{sorted_delay}->[0]->{codes}->[0]->{key}, $sample->{sorted_delay}->[0]->{codes}->[1]->{key}, $sample->{sorted_delay}->[0]->{codes}->[2]->{key} \n";
print "\tSum Delay: $sample->{sorted_delay}->[0]->{delay} Sum Inter: $sample->{sorted_delay}->[0]->{inter}\n";
print "\n";
print "\tKeys : $sample->{sorted_delay}->[1]->{codes}->[0]->{char}, $sample->{sorted_delay}->[1]->{codes}->[1]->{char}, $sample->{sorted_delay}->[1]->{codes}->[2]->{char} \n";
print "\tCodes : $sample->{sorted_delay}->[1]->{codes}->[0]->{key}, $sample->{sorted_delay}->[1]->{codes}->[1]->{key}, $sample->{sorted_delay}->[1]->{codes}->[2]->{key} \n";
print "\tSum Delay: $sample->{sorted_delay}->[1]->{delay} Sum Inter: $sample->{sorted_delay}->[1]->{inter}\n";
my $x=0;
print "\nLowest Press Times: \n";
print "\tKeys : $sample->{sorted_inter}->[0]->{codes}->[0]->{char}, $sample->{sorted_inter}->[0]->{codes}->[1]->{char}, $sample->{sorted_inter}->[0]->{codes}->[2]->{char} \n";
print "\tCodes : $sample->{sorted_inter}->[0]->{codes}->[0]->{key}, $sample->{sorted_inter}->[0]->{codes}->[1]->{key}, $sample->{sorted_inter}->[0]->{codes}->[2]->{key} \n";
print "\tSum Delay: $sample->{sorted_inter}->[0]->{delay} Sum Inter: $sample->{sorted_inter}->[0]->{inter}\n";
print "\n";
print "\tKeys : $sample->{sorted_inter}->[1]->{codes}->[0]->{char}, $sample->{sorted_inter}->[1]->{codes}->[1]->{char}, $sample->{sorted_inter}->[1]->{codes}->[2]->{char} \n";
print "\tCodes : $sample->{sorted_inter}->[1]->{codes}->[0]->{key}, $sample->{sorted_inter}->[1]->{codes}->[1]->{key}, $sample->{sorted_inter}->[1]->{codes}->[2]->{key} \n";
print "\tSum Delay: $sample->{sorted_inter}->[1]->{delay} Sum Inter: $sample->{sorted_inter}->[1]->{inter}\n";
}
elsif($type eq "analysis" || $type eq "details") {
print "\nAnalysis Details\n";
print "\nTotal Key Presses : $sample->{size}\n";
print "Average Key Codes : ",round($sample->{avg_codes},2),"\n";
print "Average Key Hold Time : ",round($sample->{avg_delay},2),"\n";
print "Average Inter-Key Time : ",round($sample->{avg_inter},2),"\n";
print "\nInter-Key Speeds: \n";
for my $x (0..$#{$sample->{sorted_delay}}) {
print "\tKeys : $sample->{sorted_delay}->[$x]->{codes}->[0]->{char}, $sample->{sorted_delay}->[$x]->{codes}->[1]->{char}, $sample->{sorted_delay}->[$x]->{codes}->[2]->{char} \n";
print "\tCodes : $sample->{sorted_delay}->[$x]->{codes}->[0]->{key}, $sample->{sorted_delay}->[$x]->{codes}->[1]->{key}, $sample->{sorted_delay}->[$x]->{codes}->[2]->{key} \n";
print "\tSum Delay: $sample->{sorted_delay}->[$x]->{delay} Sum Inter: $sample->{sorted_delay}->[$x]->{inter}\n";
print "\n";
}
print "\nKey Hold Times: \n";
for my $x (0..$#{$sample->{sorted_delay}}) {
print "\tKeys : $sample->{sorted_inter}->[$x]->{codes}->[0]->{char}, $sample->{sorted_inter}->[$x]->{codes}->[1]->{char}, $sample->{sorted_inter}->[$x]->{codes}->[2]->{char} \n";
print "\tCodes : $sample->{sorted_inter}->[$x]->{codes}->[0]->{key}, $sample->{sorted_inter}->[$x]->{codes}->[1]->{key}, $sample->{sorted_inter}->[$x]->{codes}->[2]->{key} \n";
print "\tSum Delay: $sample->{sorted_inter}->[$x]->{delay} Sum Inter: $sample->{sorted_inter}->[$x]->{inter}\n";
print "\n";
}
}
} else {
print "Error: Invalid data type at @{[(caller)[1]]} line @{[(caller)[2]]}\n";
return undef;
}
}
sub to_string {
my $self = shift if(substr($_[0],0,6) eq 'Term::');
my $sample = shift;
if(ref($sample) ne "ARRAY") {
print "Error: Invalid data type at @{[(caller)[1]]} line @{[(caller)[2]]}\n";
return undef;
}
my $str;
$str.=$sample->[$_]->{key} for (0..$#{$sample});
return $str;
}
sub diff {
my $self = shift if(substr($_[0],0,6) eq 'Term::');
my $sample1 = shift;
my $sample2 = shift;
my %args = @_;
my $v = $args{verbose} || 0;
if(ref($sample1) ne "HASH" || ref($sample2) ne "HASH") {
print "Error: Invalid data type at @{[(caller)[1]]} line @{[(caller)[2]]}: Both arguments must be HASH refrences from analyze().\n";
return undef;
}
my $diff = 0;
my $count = 0;
my $sample;
if($v) {
print "\nAnalysis Diff\n";
print "\nTotal Key Presses : ",round(p($sample1->{size},$sample2->{size}),2),"%\n";
print "Average Key Codes Diff : ",round(p($sample1->{avg_codes},$sample2->{avg_codes}),2),"%\n";
print "Average Key Hold Time Diff : ",round(p($sample1->{avg_inter},$sample2->{avg_inter}),2),"%\n";
print "Average Inter-Key Time Diff : ",round(p($sample1->{avg_delay},$sample2->{avg_delay}),2),"%\n";
}
$diff+=p($sample1->{size}*2000,$sample2->{size}*2000);
$diff+=p($sample1->{avg_codes}*1050,$sample2->{avg_codes}*1050);
$diff+=p($sample1->{avg_inter},$sample2->{avg_inter});
$diff+=p($sample1->{avg_delay},$sample2->{avg_delay});
$count+=4;
print "\nInter-Key Speeds Diff: \n" if($v);
for my $x (0..$#{$sample1->{sorted_delay}}) {
my $a = p(ascii($sample1->{sorted_delay}->[$x]->{codes}->[0]->{char}),ascii($sample2->{sorted_delay}->[$x]->{codes}->[0]->{char})) +
p(ascii($sample1->{sorted_delay}->[$x]->{codes}->[1]->{char}),ascii($sample2->{sorted_delay}->[$x]->{codes}->[1]->{char})) +
p(ascii($sample1->{sorted_delay}->[$x]->{codes}->[2]->{char}),ascii($sample2->{sorted_delay}->[$x]->{codes}->[2]->{char}));
my $b = p(ascii($sample1->{sorted_delay}->[$x]->{codes}->[0]->{key}),ascii($sample2->{sorted_delay}->[$x]->{codes}->[0]->{key})) +
p(ascii($sample1->{sorted_delay}->[$x]->{codes}->[1]->{key}),ascii($sample2->{sorted_delay}->[$x]->{codes}->[1]->{key})) +
p(ascii($sample1->{sorted_delay}->[$x]->{codes}->[2]->{key}),ascii($sample2->{sorted_delay}->[$x]->{codes}->[2]->{key}));
my $c = p($sample1->{sorted_delay}->[$x]->{delay}, $sample2->{sorted_delay}->[$x]->{delay});
my $d = p($sample1->{sorted_delay}->[$x]->{inter}, $sample2->{sorted_delay}->[$x]->{inter});
if(($x<3 && $v==1) || ($v==2)) {
print "\tKeys : $a\n";
print "\tCodes : $b\n";
print "\tSum Delay: $c Sum Inter: $d\n";
print "\n";
}
$diff += ($a+$b+$c+$d);
$count += 8;
}
print "\nKey Hold Times: \n" if($v);
for my $x (0..$#{$sample1->{sorted_delay}}) {
my $a = p(ascii($sample1->{sorted_inter}->[$x]->{codes}->[0]->{char}),ascii($sample2->{sorted_inter}->[$x]->{codes}->[0]->{char})) +
p(ascii($sample1->{sorted_inter}->[$x]->{codes}->[1]->{char}),ascii($sample2->{sorted_inter}->[$x]->{codes}->[1]->{char})) +
p(ascii($sample1->{sorted_inter}->[$x]->{codes}->[2]->{char}),ascii($sample2->{sorted_inter}->[$x]->{codes}->[2]->{char}));
my $b = p(ascii($sample1->{sorted_inter}->[$x]->{codes}->[0]->{key}),ascii($sample2->{sorted_inter}->[$x]->{codes}->[0]->{key})) +
p(ascii($sample1->{sorted_inter}->[$x]->{codes}->[1]->{key}),ascii($sample2->{sorted_inter}->[$x]->{codes}->[1]->{key})) +
p(ascii($sample1->{sorted_inter}->[$x]->{codes}->[2]->{key}),ascii($sample2->{sorted_inter}->[$x]->{codes}->[2]->{key}));
my $c = p($sample1->{sorted_inter}->[$x]->{delay}, $sample2->{sorted_inter}->[$x]->{delay});
my $d = p($sample1->{sorted_inter}->[$x]->{inter}, $sample2->{sorted_inter}->[$x]->{inter});
if(($x<3 && $v==1) || ($v==2)) {
print "\tSum Delay: $c Sum Inter: $d\n";
print "\n";
}
$diff += ($a+$b+$c+$d);
$count += 8;
}
return intr(($diff/$count)%100);
}
sub average {
my $self = shift if(substr($_[0],0,6) eq 'Term::');
my @vectors = @_;
my $out;
if(ref($vectors[0]) eq "HASH") {
$out = {};
my $x = $#vectors+1;
for my $sample (@vectors) {
$out->{size} += $sample->{size};
$out->{avg_codes} += ($sample->{avg_codes}/$x);
$out->{avg_delay} += ($sample->{avg_delay}/$x);
$out->{avg_inter} += ($sample->{avg_inter}/$x);
for my $x (0..$#{$sample->{sorted_delay}}) {
$out->{sorted_delay}->[$x]->{codes}->[0]->{char} = $vectors[0]->{sorted_delay}->[$x]->{codes}->[0]->{char};
$out->{sorted_delay}->[$x]->{codes}->[1]->{char} = $vectors[0]->{sorted_delay}->[$x]->{codes}->[0]->{char};
$out->{sorted_delay}->[$x]->{codes}->[2]->{char} = $vectors[0]->{sorted_delau}->[$x]->{codes}->[0]->{char};
$out->{sorted_delay}->[$x]->{codes}->[0]->{key}+=($sample->{sorted_delay}->[$x]->{codes}->[0]->{key}/$x);
$out->{sorted_delay}->[$x]->{codes}->[1]->{key}+=($sample->{sorted_delay}->[$x]->{codes}->[1]->{key}/$x);
$out->{sorted_delay}->[$x]->{codes}->[2]->{key}+=($sample->{sorted_delay}->[$x]->{codes}->[2]->{key}/$x);
$out->{sorted_delay}->[$x]->{delay}+=($sample->{sorted_delay}->[$x]->{delay}/$x);
$out->{sorted_delay}->[$x]->{inter}+=($sample->{sorted_delay}->[$x]->{inter}/$x);
}
for my $x (0..$#{$sample->{sorted_delay}}) {
$out->{sorted_inter}->[$x]->{codes}->[0]->{char} = $vectors[0]->{sorted_inter}->[$x]->{codes}->[0]->{char};
$out->{sorted_inter}->[$x]->{codes}->[1]->{char} = $vectors[0]->{sorted_inter}->[$x]->{codes}->[1]->{char};
$out->{sorted_inter}->[$x]->{codes}->[2]->{char} = $vectors[0]->{sorted_inter}->[$x]->{codes}->[2]->{char};
$out->{sorted_inter}->[$x]->{codes}->[0]->{key}+=($sample->{sorted_inter}->[$x]->{codes}->[0]->{key}/$x);
$out->{sorted_inter}->[$x]->{codes}->[1]->{key}+=($sample->{sorted_inter}->[$x]->{codes}->[1]->{key}/$x);
$out->{sorted_inter}->[$x]->{codes}->[2]->{key}+=($sample->{sorted_inter}->[$x]->{codes}->[2]->{key}/$x);
$out->{sorted_inter}->[$x]->{delay}+=($sample->{sorted_inter}->[$x]->{delay}/$x);
$out->{sorted_inter}->[$x]->{inter}+=($sample->{sorted_inter}->[$x]->{inter}/$x);
}
}
} elsif(ref($vectors[0]) eq "ARRAY") {
$out = [];
my $x = $#vectors+1;
for my $sample (@vectors) {
for my $key (0..$#{$sample}) {
$out->[$key]->{key} = $vectors[0]->[$key]->{key};
$out->[$key]->{delay} += ($sample->[$key]->{delay}/$x);
$out->[$key]->{inter} += ($sample->[$key]->{inter}/$x);
}
}
} else {
print "Error: Invalid data type at @{[(caller)[1]]} line @{[(caller)[2]]}\n";
return undef;
}
return $out;
}
sub save {
my $self = shift if(substr($_[0],0,6) eq 'Term::');
my $sample = shift;
my $file = shift;
if(ref($sample) ne "ARRAY" && ref($sample) ne "HASH") {
print "Error: Invalid save data type at @{[(caller)[1]]} line @{[(caller)[2]]}\n";
return undef;
}
open(F, ">$file");
if(ref($sample) eq "HASH") {
print F "type=hash\n";
print F "size=$sample->{size}\n";
print F "avg_codes=$sample->{avg_codes}\n";
print F "avg_delay=$sample->{avg_delay}\n";
print F "avg_inter=$sample->{avg_inter}\n";
print F "sorted_delay_size=$#{$sample->{sorted_delay}}\n";
for my $x (0..$#{$sample->{sorted_delay}}) {
print F "sorted_delay:$x:keys=$sample->{sorted_delay}->[$x]->{codes}->[0]->{char}::$sample->{sorted_delay}->[$x]->{codes}->[1]->{char}::$sample->{sorted_delay}->[$x]->{codes}->[2]->{char}\n";
print F "sorted_delay:$x:codes=$sample->{sorted_delay}->[$x]->{codes}->[0]->{key},$sample->{sorted_delay}->[$x]->{codes}->[1]->{key},$sample->{sorted_delay}->[$x]->{codes}->[2]->{key}\n";
print F "sorted_delay:$x:delay=$sample->{sorted_delay}->[$x]->{delay}\n";
print F "sorted_delay:$x:inter=$sample->{sorted_delay}->[$x]->{inter}\n";
}
print F "sorted_inter_size=$#{$sample->{sorted_inter}}\n";
for my $x (0..$#{$sample->{sorted_inter}}) {
print F "sorted_inter:$x:keys=$sample->{sorted_inter}->[$x]->{codes}->[0]->{char}::$sample->{sorted_inter}->[$x]->{codes}->[1]->{char}::$sample->{sorted_inter}->[$x]->{codes}->[2]->{char}\n";
print F "sorted_inter:$x:codes=$sample->{sorted_inter}->[$x]->{codes}->[0]->{key},$sample->{sorted_inter}->[$x]->{codes}->[1]->{key},$sample->{sorted_inter}->[$x]->{codes}->[2]->{key}\n";
print F "sorted_inter:$x:delay=$sample->{sorted_inter}->[$x]->{delay}\n";
print F "sorted_inter:$x:inter=$sample->{sorted_inter}->[$x]->{inter}\n";
}
} else {
print F "type=array\n";
print F "index_size=$#{$sample}\n";
for my $key (0..$#{$sample}) {
print F "index$key=$sample->[$key]->{key}::$sample->[$key]->{delay}::$sample->[$key]->{inter}\n";
}
}
close(F);
return $sample;
}
sub load {
my $self = shift if(substr($_[0],0,6) eq 'Term::');
my $file = shift;
if(!(-f $file)) {
print "Error: File $file doesn't exist at @{[(caller)[1]]} line @{[(caller)[2]]}\n";
return undef;
}
open(F, $file);
my @lines = <F>;
close(F);
my %db;
for my $line (@lines) {
chomp($line);
my ($a,$b) = split /=/, $line;
$db{$a}=$b;
}
my $sample;
if($db{type} eq "hash") {
$sample = {};
$sample->{size}=$db{size};
$sample->{avg_codes}=$db{avg_codex};
$sample->{avg_delay}=$db{avg_delay};
$sample->{avg_inter}=$db{avg_inter};
for my $x (0..$db{sorted_delay_size}) {
($sample->{sorted_delay}->[$x]->{codes}->[0]->{char},$sample->{sorted_delay}->[$x]->{codes}->[1]->{char},$sample->{sorted_delay}->[$x]->{codes}->[2]->{char}) =
split /\:\:/, $db{"sorted_delay:$x:keys"};
($sample->{sorted_delay}->[$x]->{codes}->[0]->{key},$sample->{sorted_delay}->[$x]->{codes}->[1]->{key},$sample->{sorted_delay}->[$x]->{codes}->[2]->{key}) =
split /,/, $db{"sorted_delay:$x:codes"};
$sample->{sorted_delay}->[$x]->{delay}=$db{"sorted_delay:$x:delay"};
$sample->{sorted_delay}->[$x]->{inter}=$db{"sorted_delay:$x:inter"};
}
for my $x (0..$db{sorted_inter_size}) {
($sample->{sorted_inter}->[$x]->{codes}->[0]->{char},$sample->{sorted_inter}->[$x]->{codes}->[1]->{char},$sample->{sorted_inter}->[$x]->{codes}->[2]->{char}) =
split /\:\:/, $db{"sorted_inter:$x:keys"};
($sample->{sorted_inter}->[$x]->{codes}->[0]->{key},$sample->{sorted_inter}->[$x]->{codes}->[1]->{key},$sample->{sorted_inter}->[$x]->{codes}->[2]->{key}) =
split /,/, $db{"sorted_inter:$x:codes"};
$sample->{sorted_inter}->[$x]->{delay}=$db{"sorted_inter:$x:delay"};
$sample->{sorted_inter}->[$x]->{inter}=$db{"sorted_inter:$x:inter"};
}
}
elsif($db{type} eq "array") {
$sample = [];
for my $key (0..$db{index_size}) {
($sample->[$key]->{key},$sample->[$key]->{delay},$sample->[$key]->{inter}) =
split /\:\:/, $db{"index$key"};
}
} else {
print "Error: Invalid file type in file $file at @{[(caller)[1]]} line @{[(caller)[2]]}\n";
return undef;
}
return $sample;
}
sub analyze {
my $self = shift if(substr($_[0],0,6) eq 'Term::');
my $sample = shift;
if(ref($sample) ne "ARRAY") {
print "Error: Invalid sample data type at @{[(caller)[1]]} line @{[(caller)[2]]}\n";
return undef;
}
my $delay = 0;
my $inter = 0;
my $codes = 0;
my $size = $#{$sample};
for my $key (0..$size-1) {
$codes+=ascii($sample->[$key]->{key});
$delay+=$sample->[$key]->{delay};
$inter+=$sample->[$key]->{inter};
}
$size = 1 if(!$size || $size == -1);
my $analysis = {
avg_codes => plus($codes/$size),
avg_delay => plus($inter/$size),
avg_inter => plus($delay/$size),
size => $size,
};
my @samples;
for my $key (0..$size-1) {
my $delay = 0;
my $inter = 0;
my $codes = [];
my $keys = [];
$codes->[++$#{$codes}]={ char => $sample->[$key-1]->{key}, key => $key-1 } if($key>0);
$codes->[++$#{$codes}]={ char => $sample->[$key-0]->{key}, key => $key-0 };
$codes->[++$#{$codes}]={ char => $sample->[$key+1]->{key}, key => $key+1 } if($key<$size);
$delay+=$sample->[$key-1]->{delay} if($key>0);
$delay+=$sample->[$key-0]->{delay};
$delay+=$sample->[$key+1]->{delay} if($key<$size);
$inter+=$sample->[$key-1]->{inter} if($key>0);
$inter+=$sample->[$key-0]->{inter};
$inter+=$sample->[$key+1]->{inter} if($key<$size);
$samples[++$#samples] = {
codes => $codes,
delay => $delay,
inter => $inter,
};
}
$analysis->{sorted_delay} = [sort by_delay @samples];
$analysis->{sorted_inter} = [sort by_inter @samples];
return $analysis;
}
sub by_inter($$){$_[1]->{inter} <=> $_[0]->{inter}}
sub by_delay($$){$_[1]->{delay} <=> $_[0]->{delay}}
# Returns the difference between $fa and $fb as fraction of $fa
sub p {
shift if(substr($_[0],0,6) eq 'Term::');
my ($fa,$fb)=(shift,shift);
sprintf("%.3f",$fa/($fb+1)*100); #((($fb-$fa)*((($fb-$fa)<0)?-1:1))/$fa)*100;
}
my %__ascii__lookup__table;
for my $code (0..255){$__ascii__lookup__table{chr($code)}=$code}
}
return undef;
} else {
return (ReadKey(),1);
}
}
# Rounds a floating-point to an integer with int() and sprintf()
sub intr {
shift if(substr($_[0],0,6) eq 'Term::');
try { return int(sprintf("%.0f",shift)) }
catch { return 0 }
}
# Round $num to $size places after decimal
sub round {
my $self = shift if(substr($_[0],0,6) eq 'Term::');
my $num = shift;
my $size = shift;
sprintf("%.$size".'f',$num);
}
# Make a negative number postive. No effect on positive numbers.
sub plus {
my $self = shift if(substr($_[0],0,6) eq 'Term::');
my $num = shift;
return ($num*=-1) if($num<0);
$num;
}
# For the lazy among us :-)
sub new_Set {
my $self = shift if(substr($_[0],0,6) eq 'Term::');
Term::Sample::Set->new(@_);
}
# Alias for above
sub new_set { new_Set(@_) }
1;
package Term::Sample::Set;
use Term::Sample;
use strict;
sub new {
my $type = shift;
my %args = @_;
my $self = { term => Term::Sample->new(),
type => $args{type} || 'sample',
silent => $args{silent} || 0 };
bless $self, $type;
}
sub store {
my $self = shift;
my %args = @_;
my ($key,$sample);
while(($key,$sample) = each %args) {
if(ref($sample) ne (($self->{type} eq 'sample')?"ARRAY":"HASH") && !$self->{silent}) {
print "Error: Invalid sample data type for key `$key' at @{[(caller)[1]]} line @{[(caller)[2]]}\n";
return undef;
}
if(!exists $self->{samples}->{$key}) {
$self->{samples}->{$key} = $sample;
} else {
$self->{samples}->{$key} = $self->{term}->average($self->{samples}->{$key},$sample);
}
}
return $self;
}
sub remove {
my $self = shift;
my $key = shift;
if(!exists $self->{samples}->{$key} && !$self->{silent}) {
print "Error: Key `$key' does not exist in set at @{[(caller)[1]]} line @{[(caller)[2]]}\n";
return undef;
}
delete $self->{samples}->{$key};
return $self;
}
sub get {
my $self = shift;
my $key = shift;
if(!exists $self->{samples}->{$key} && !$self->{silent}) {
print "Error: Key `$key' does not exist in set at @{[(caller)[1]]} line @{[(caller)[2]]}\n";
return undef;
}
return $self->{samples}->{$key};
}
sub match {
my $self = shift;
my $match = shift;
my $term = $self->{term};
my $v = shift || 0;
if(ref($match) ne (($self->{type} eq 'sample')?"ARRAY":"HASH") && !$self->{silent}) {
print "Error: Invalid sample data type at @{[(caller)[1]]} line @{[(caller)[2]]}\n";
return undef;
}
my $test = ($self->{type} eq 'sample')?$term->analyze($match):$match;
my @diffs = ();
my ($key,$sample);
while(($key,$sample) = each %{$self->{samples}}) {
if(ref($sample) ne (($self->{type} eq 'sample')?"ARRAY":"HASH") && !$self->{silent}) {
print "Error: Corrupted sample data type for key `$key' at @{[(caller)[1]]} line @{[(caller)[2]]}\n";
return undef;
}
my $analysis = ($self->{type} eq 'sample')?$term->analyze($sample):$sample;
my $i=++$#diffs;
$diffs[$i] = { diff => $term->diff($analysis, $test), key => $key };
print "match(): $diffs[$i]->{diff} => $diffs[$i]->{key} \n" if($v);
}
my $top = 0;
for(0..$#diffs) {
$top = $_ if($diffs[$_]->{diff} < $diffs[$top]->{diff});
}
return ($diffs[$top]->{key}, $diffs[$_]->{diff});
}
sub save {
my $self = shift;
my $file = shift;
open(F, ">$file");
my ($key,$sample);
while(($key,$sample) = each %{$self->{samples}}) {
print F "_____KEY_____=$key\n";
if(ref($sample) ne "ARRAY" && ref($sample) ne "HASH" && !$self->{silent}) {
print "Error: Corrupted data type key `$key' at @{[(caller)[1]]} line @{[(caller)[2]]}\n";
return undef;
}
if(ref($sample) eq "HASH") {
print F "type=hash\n";
print F "size=$sample->{size}\n";
print F "avg_codes=$sample->{avg_codes}\n";
print F "avg_delay=$sample->{avg_delay}\n";
print F "avg_inter=$sample->{avg_inter}\n";
print F "sorted_delay_size=$#{$sample->{sorted_delay}}\n";
for my $x (0..$#{$sample->{sorted_delay}}) {
print F "sorted_delay:$x:keys=$sample->{sorted_delay}->[$x]->{codes}->[0]->{char}::$sample->{sorted_delay}->[$x]->{codes}->[1]->{char}::$sample->{sorted_delay}->[$x]->{codes}->[2]->{char}\n";
print F "sorted_delay:$x:codes=$sample->{sorted_delay}->[$x]->{codes}->[0]->{key},$sample->{sorted_delay}->[$x]->{codes}->[1]->{key},$sample->{sorted_delay}->[$x]->{codes}->[2]->{key}\n";
print F "sorted_delay:$x:delay=$sample->{sorted_delay}->[$x]->{delay}\n";
print F "sorted_delay:$x:inter=$sample->{sorted_delay}->[$x]->{inter}\n";
}
print F "sorted_inter_size=$#{$sample->{sorted_inter}}\n";
for my $x (0..$#{$sample->{sorted_inter}}) {
print F "sorted_inter:$x:keys=$sample->{sorted_inter}->[$x]->{codes}->[0]->{char}::$sample->{sorted_inter}->[$x]->{codes}->[1]->{char}::$sample->{sorted_inter}->[$x]->{codes}->[2]->{char}\n";
print F "sorted_inter:$x:codes=$sample->{sorted_inter}->[$x]->{codes}->[0]->{key},$sample->{sorted_inter}->[$x]->{codes}->[1]->{key},$sample->{sorted_inter}->[$x]->{codes}->[2]->{key}\n";
print F "sorted_inter:$x:delay=$sample->{sorted_inter}->[$x]->{delay}\n";
print F "sorted_inter:$x:inter=$sample->{sorted_inter}->[$x]->{inter}\n";
}
} else {
print F "type=array\n";
print F "index_size=$#{$sample}\n";
for my $key (0..$#{$sample}) {
print F "index$key=$sample->[$key]->{key}::$sample->[$key]->{delay}::$sample->[$key]->{inter}\n";
}
}
}
close(F);
return $self;
}
sub load {
my $self = shift;
my $file = shift;
if(!(-f $file) && !$self->{silent}) {
print "Error: File $file doesn't exist at @{[(caller)[1]]} line @{[(caller)[2]]}\n";
return undef;
}
return $self if(!(-f $file) && $self->{silent});
open(F, $file);
my @lines = <F>;
close(F);
my $data = {};
my $key;
for my $line (@lines) {
chomp($line);
my ($a,$b) = split /=/, $line;
$key = $b if($a eq "_____KEY_____");
$data->{$key}->{$a}=$b;
}
my ($tmp,%db);
while(($key,$tmp) = each %{$data}) {
%db = %{$tmp};
if($db{type} eq "hash") {
$self->{samples}->{$key} = {};
$self->{samples}->{$key}->{size}=$db{size};
$self->{samples}->{$key}->{avg_codes}=$db{avg_codex};
$self->{samples}->{$key}->{avg_delay}=$db{avg_delay};
$self->{samples}->{$key}->{avg_inter}=$db{avg_inter};
for my $x (0..$db{sorted_delay_size}) {
($self->{samples}->{$key}->{sorted_delay}->[$x]->{codes}->[0]->{char},$self->{samples}->{$key}->{sorted_delay}->[$x]->{codes}->[1]->{char},$self->{samples}->{$key}->{sorted_delay}->[$x]->{codes}->[2]->{char}) =
split /\:\:/, $db{"sorted_delay:$x:keys"};
($self->{samples}->{$key}->{sorted_delay}->[$x]->{codes}->[0]->{key},$self->{samples}->{$key}->{sorted_delay}->[$x]->{codes}->[1]->{key},$self->{samples}->{$key}->{sorted_delay}->[$x]->{codes}->[2]->{key}) =
split /,/, $db{"sorted_delay:$x:codes"};
$self->{samples}->{$key}->{sorted_delay}->[$x]->{delay}=$db{"sorted_delay:$x:delay"};
$self->{samples}->{$key}->{sorted_delay}->[$x]->{inter}=$db{"sorted_delay:$x:inter"};
}
for my $x (0..$db{sorted_inter_size}) {
($self->{samples}->{$key}->{sorted_inter}->[$x]->{codes}->[0]->{char},$self->{samples}->{$key}->{sorted_inter}->[$x]->{codes}->[1]->{char},$self->{samples}->{$key}->{sorted_inter}->[$x]->{codes}->[2]->{char}) =
split /\:\:/, $db{"sorted_inter:$x:keys"};
($self->{samples}->{$key}->{sorted_inter}->[$x]->{codes}->[0]->{key},$self->{samples}->{$key}->{sorted_inter}->[$x]->{codes}->[1]->{key},$self->{samples}->{$key}->{sorted_inter}->[$x]->{codes}->[2]->{key}) =
split /,/, $db{"sorted_inter:$x:codes"};
$self->{samples}->{$key}->{sorted_inter}->[$x]->{delay}=$db{"sorted_inter:$x:delay"};
$self->{samples}->{$key}->{sorted_inter}->[$x]->{inter}=$db{"sorted_inter:$x:inter"};
}
}
elsif($db{type} eq "array") {
$self->{samples}->{$key} = [];
for my $x (0..$db{index_size}) {
($self->{samples}->{$key}->[$x]->{key},$self->{samples}->{$key}->[$x]->{delay},$self->{samples}->{$key}->[$x]->{inter}) =
split /\:\:/, $db{"index$x"};
}
} else {
print "Error: Invalid file type in file $file at @{[(caller)[1]]} line @{[(caller)[2]]}\n";
return undef;
}
}
return $self;
}
1;
__END__
=head1 NAME
Term::Sample - Finger printing of your keyboard typing
=head1 SYNOPSIS
use Term::Sample qw(sample average analyze intr);
use strict;
my $set = Term::Sample::Set->new();
my $sample_string = 'green eggs and ham';
if(!$set->load("test3.set")) {
my @samples;
print "Person: Person #1\n";
my $top = 3;
for (0..$top) {
print "[ Sample $_ of $top ] Please type \"$sample_string\": ";
$samples[$_] = sample();
}
$set->store( 'Person #1' => average(@samples) );
print "Person: Person #2\n";
my $top = 3;
for (0..$top) {
print "[ Sample $_ of $top ] Please type \"$sample_string\": ";
# This has the same effect as saving all the samples in an array
# then calling store on the average() output, as shown above.
$set->store( 'Person #2' => sample() );
}
$set->save("test3.set");
}
print "Now to test it out...\n";
print "[ Anybody ] Please type \"$sample_string\": ";
my $sample = sample();
my ($key, $diff) = $set->match($sample);
print "I am sure (about ",
intr(100-$diff),
( run in 0.957 second using v1.01-cache-2.11-cpan-cdf2f3d4e48 )