2015-05-23 15:24:49 +02:00
#!/usr/bin/env perl
use warnings ;
use strict ;
use Time::HiRes qw( gettimeofday ) ;
use Time::Duration qw( duration concise ) ;
use POSIX 'strftime' ;
use QStatskeeper ;
my $ command = shift @ ARGV ;
my $ opt = join ' ' , @ ARGV ;
$ command = '' if not defined $ command ;
$ opt = '' if not defined $ opt ;
2015-05-25 16:17:20 +02:00
my $ rank_direction = '+' ;
sub sort_correct {
if ( $ rank_direction eq '+' ) {
return $ b - > { correct } <=> $ a - > { correct } ;
} else {
return $ a - > { correct } <=> $ b - > { correct } ;
}
}
sub print_correct {
my $ qdata = shift @ _ ;
return undef if $ qdata - > { correct } == 0 ;
return "$qdata->{id} ($qdata->{correct})" ;
}
sub sort_wrong {
if ( $ rank_direction eq '+' ) {
return $ b - > { wrong } <=> $ a - > { wrong } ;
} else {
return $ a - > { wrong } <=> $ b - > { wrong } ;
}
}
sub print_wrong {
my $ qdata = shift @ _ ;
return undef if $ qdata - > { wrong } == 0 ;
return "$qdata->{id} ($qdata->{wrong})" ;
}
sub sort_wrongstreak {
if ( $ rank_direction eq '+' ) {
return $ b - > { highest_wrong_streak } <=> $ a - > { highest_wrong_streak } ;
} else {
return $ a - > { highest_wrong_streak } <=> $ b - > { highest_wrong_streak } ;
}
}
sub print_wrongstreak {
my $ qdata = shift @ _ ;
return undef if $ qdata - > { highest_wrong_streak } == 0 ;
return "$qdata->{id} ($qdata->{highest_wrong_streak})" ;
}
sub sort_hints {
if ( $ rank_direction eq '+' ) {
return $ b - > { hints } <=> $ a - > { hints } ;
} else {
return $ a - > { hints } <=> $ b - > { hints } ;
}
}
sub print_hints {
my $ qdata = shift @ _ ;
return undef if $ qdata - > { hints } == 0 ;
return "$qdata->{id} ($qdata->{hints})" ;
}
sub sort_quickest {
if ( $ rank_direction eq '+' ) {
return $ a - > { quickest_answer_time } <=> $ b - > { quickest_answer_time } ;
} else {
return $ b - > { quickest_answer_time } <=> $ a - > { quickest_answer_time } ;
}
}
sub print_quickest {
my $ qdata = shift @ _ ;
return undef if $ qdata - > { quickest_answer_time } == 0 ;
if ( $ qdata - > { quickest_answer_time } < 60 ) {
return "$qdata->{id} (" . sprintf ( "%.02fs" , $ qdata - > { quickest_answer_time } ) . ")" ;
} else {
return "$qdata->{id} (" . ( concise duration $ qdata - > { quickest_answer_time } ) . ")" ;
}
}
sub sort_longest {
if ( $ rank_direction eq '+' ) {
return $ b - > { longest_answer_time } <=> $ a - > { longest_answer_time } ;
} else {
return $ a - > { longest_answer_time } <=> $ b - > { longest_answer_time } ;
}
}
sub print_longest {
my $ qdata = shift @ _ ;
return undef if $ qdata - > { longest_answer_time } == 0 ;
if ( $ qdata - > { longest_answer_time } < 60 ) {
return "$qdata->{id} (" . sprintf ( "%.02fs" , $ qdata - > { longest_answer_time } ) . ")" ;
} else {
return "$qdata->{id} (" . ( concise duration $ qdata - > { longest_answer_time } ) . ")" ;
}
}
sub sort_average {
if ( $ rank_direction eq '+' ) {
return $ a - > { average_answer_time } <=> $ b - > { average_answer_time } ;
} else {
return $ b - > { average_answer_time } <=> $ a - > { average_answer_time } ;
}
}
sub print_average {
my $ qdata = shift @ _ ;
return undef if $ qdata - > { average_answer_time } == 0 ;
if ( $ qdata - > { average_answer_time } < 60 ) {
return "$qdata->{id} (" . sprintf ( "%.02fs" , $ qdata - > { average_answer_time } ) . ")" ;
} else {
return "$qdata->{id} (" . ( concise duration $ qdata - > { average_answer_time } ) . ")" ;
}
}
2015-05-23 15:24:49 +02:00
if ( lc $ command eq 'rank' ) {
2015-05-25 16:17:20 +02:00
my % ranks = (
correct = > { sort = > \ & sort_correct , print = > \ & print_correct , title = > 'correct answers' } ,
wrong = > { sort = > \ & sort_wrong , print = > \ & print_wrong , title = > 'wrong answers' } ,
wrongstreak = > { sort = > \ & sort_wrongstreak , print = > \ & print_wrongstreak , title = > 'wrong answer streak' } ,
hints = > { sort = > \ & sort_hints , print = > \ & print_hints , title = > 'hints used' } ,
quickest = > { sort = > \ & sort_quickest , print = > \ & print_quickest , title = > 'quickest answer time' } ,
longest = > { sort = > \ & sort_longest , print = > \ & print_longest , title = > 'longest answer time' } ,
average = > { sort = > \ & sort_average , print = > \ & print_average , title = > 'average answer time' } ,
) ;
if ( not $ opt ) {
print "Usage: rank [-]<keyword> [offset] or rank [-]<question id>; available keywords: " ;
print join ', ' , sort keys % ranks ;
print ".\n" ;
print "Prefixing the keyword or nick with a dash will invert the sort direction for each category. Specifying an offset will start ranking at that offset.\n" ;
exit ;
}
my $ qstats = QStatskeeper - > new ;
$ qstats - > begin ;
$ opt = lc $ opt ;
if ( $ opt =~ s/^([+-])// ) {
$ rank_direction = $ 1 ;
}
my $ offset = 1 ;
if ( $ opt =~ s/\s+(\d+)$// ) {
$ offset = $ 1 ;
}
if ( not exists $ ranks { $ opt } ) {
print "Ranking specific questions coming soon.\n" ;
$ qstats - > end ;
exit ;
}
my $ qdatas = $ qstats - > get_all_questions ( ) ;
my $ sort_method = $ ranks { $ opt } - > { sort } ;
@$ qdatas = sort $ sort_method @$ qdatas ;
my @ ranking ;
my $ rank = 0 ;
my $ last_value = - 1 ;
foreach my $ qdata ( @$ qdatas ) {
my $ entry = $ ranks { $ opt } - > { print } - > ( $ qdata ) ;
if ( defined $ entry ) {
my ( $ value ) = $ entry =~ /\((.*)\)$/ ;
$ rank + + if $ value ne $ last_value ;
$ last_value = $ value ;
next if $ rank < $ offset ;
push @ ranking , "#$rank $entry" if defined $ entry ;
last if scalar @ ranking >= 15 ;
}
}
if ( not scalar @ ranking ) {
if ( $ offset > 1 ) {
print "No rankings available at offset #$offset.\n" ;
} else {
print "No rankings available yet.\n" ;
}
} else {
print "Rankings for $ranks{$opt}->{title}: " ;
print join ', ' , @ ranking ;
print "\n" ;
}
$ qstats - > end ;
2015-05-23 15:24:49 +02:00
} elsif ( $ command =~ m/^\d+$/ ) {
my $ qstats = QStatskeeper - > new ;
$ qstats - > begin ;
if ( not $ qstats - > find_question ( $ command ) ) {
print "No such question $command.\n" ;
$ qstats - > end ;
exit ;
}
my $ qdata = $ qstats - > get_question_data ( $ command ) ;
my $ wrong_answers = $ qstats - > get_wrong_answers ( $ command ) ;
$ qstats - > end ;
my $ stats = "Question $command: " ;
$ stats . = "asked: $qdata->{asked_count}" ;
if ( $ qdata - > { last_asked } ) {
my $ date = strftime '%b %e %H:%M %Y' , localtime $ qdata - > { last_asked } ;
$ stats . = " (last on $date)" ;
}
$ stats . = ", " ;
$ stats . = "correct: $qdata->{correct}" ;
if ( $ qdata - > { last_correct_time } ) {
my $ date = strftime '%b %e %H:%M %Y' , localtime $ qdata - > { last_correct_time } ;
$ stats . = " (last by $qdata->{last_correct_nick} on $date)" ;
}
$ stats . = ", " ;
$ stats . = "wrong: $qdata->{wrong}, wrong streak: $qdata->{wrong_streak}, highest wrong streak: $qdata->{highest_wrong_streak}, " ;
$ stats . = "hints: $qdata->{hints}, " ;
$ stats . = "quickest: " ;
if ( $ qdata - > { quickest_answer_time } ) {
if ( $ qdata - > { quickest_answer_time } < 60 ) {
$ stats . = sprintf ( "%.2fs" , $ qdata - > { quickest_answer_time } ) ;
} else {
$ stats . = concise duration $ qdata - > { quickest_answer_time } ;
}
my $ date = strftime '%b %e %H:%M %Y' , localtime $ qdata - > { quickest_answer_date } ;
$ stats . = " by $qdata->{quickest_answer_nick} on $date" ;
} else {
$ stats . = "N/A" ;
}
$ stats . = ", " ;
$ stats . = "longest: " ;
if ( $ qdata - > { longest_answer_time } ) {
if ( $ qdata - > { longest_answer_time } < 60 ) {
$ stats . = sprintf ( "%.2fs" , $ qdata - > { longest_answer_time } ) ;
} else {
$ stats . = concise duration $ qdata - > { longest_answer_time } ;
}
my $ date = strftime '%b %e %H:%M %Y' , localtime $ qdata - > { longest_answer_date } ;
$ stats . = " by $qdata->{longest_answer_nick} on $date" ;
} else {
$ stats . = "N/A" ;
}
$ stats . = ", " ;
$ stats . = "average: " ;
if ( $ qdata - > { average_answer_time } ) {
if ( $ qdata - > { average_answer_time } < 60 ) {
$ stats . = sprintf ( "%.2fs" , $ qdata - > { average_answer_time } ) ;
} else {
$ stats . = concise duration $ qdata - > { average_answer_time } ;
}
} else {
$ stats . = "N/A" ;
}
if ( @$ wrong_answers ) {
$ stats . = ", wrong answers: " ;
my $ count = 0 ;
my $ sep = "" ;
foreach my $ answer ( sort { $ b - > { count } <=> $ a - > { count } } @$ wrong_answers ) {
last if + + $ count >= 10 ;
$ stats . = $ sep ;
$ stats . = $ answer - > { answer } ;
if ( $ answer - > { count } > 1 ) {
$ stats . = "($answer->{count})" ;
}
$ sep = ", " ;
}
}
print "$stats\n" ;
} else {
print "Usage: `qstats <question id>` or `qstats rank [keyword]`; See `qstats rank` for available keywords.\n" ;
}