From 23aa7eca080d8c8a6785b28a5c64feff3849e9cf Mon Sep 17 00:00:00 2001 From: Marius Gavrilescu Date: Mon, 30 Mar 2015 14:17:17 +0300 Subject: [PATCH] Remove DBIC --- MANIFEST | 1 - Makefile.PL | 10 +- bm.pl | 55 --- lib/Gruntmaster/Data.pm | 215 +--------- lib/Gruntmaster/Data/Result/Contest.pm | 292 -------------- lib/Gruntmaster/Data/Result/ContestProblem.pm | 125 ------ lib/Gruntmaster/Data/Result/ContestStatus.pm | 121 ------ lib/Gruntmaster/Data/Result/Job.pm | 290 -------------- lib/Gruntmaster/Data/Result/Limit.pm | 90 ----- lib/Gruntmaster/Data/Result/Open.pm | 161 -------- lib/Gruntmaster/Data/Result/Problem.pm | 377 ------------------ lib/Gruntmaster/Data/Result/ProblemStatus.pm | 148 ------- lib/Gruntmaster/Data/Result/User.pm | 303 -------------- t/Gruntmaster-Data.t | 16 +- 14 files changed, 10 insertions(+), 2194 deletions(-) delete mode 100644 bm.pl delete mode 100644 lib/Gruntmaster/Data/Result/Contest.pm delete mode 100644 lib/Gruntmaster/Data/Result/ContestProblem.pm delete mode 100644 lib/Gruntmaster/Data/Result/ContestStatus.pm delete mode 100644 lib/Gruntmaster/Data/Result/Job.pm delete mode 100644 lib/Gruntmaster/Data/Result/Limit.pm delete mode 100644 lib/Gruntmaster/Data/Result/Open.pm delete mode 100644 lib/Gruntmaster/Data/Result/Problem.pm delete mode 100644 lib/Gruntmaster/Data/Result/ProblemStatus.pm delete mode 100644 lib/Gruntmaster/Data/Result/User.pm diff --git a/MANIFEST b/MANIFEST index 3952d78..66be71b 100644 --- a/MANIFEST +++ b/MANIFEST @@ -1,4 +1,3 @@ -bm.pl Changes db.sql gruntmaster-contest diff --git a/Makefile.PL b/Makefile.PL index 8edc120..e05c015 100644 --- a/Makefile.PL +++ b/Makefile.PL @@ -16,23 +16,15 @@ WriteMakefile( POSIX 0 Term::ANSIColor 0 - Authen::Passphrase 0 - Authen::Passphrase::BlowfishCrypt 0 - Bytes::Random::Secure 0 - Class::Method::Modifiers 0 Date::Parse 0 DBI 0 - DBIx::Class 0 DBIx::Simple 0 DBD::Pg 0 - Digest::SHA 0 File::Slurp 0 IO::Prompter 0 - Lingua::EN::Inflect 0 JSON::MaybeXS 0 PerlX::Maybe 0 - SQL::Abstract 0 - Sub::Name 0/, + SQL::Abstract 0/, }, BUILD_REQUIRES => { qw/DBD::SQLite 0 diff --git a/bm.pl b/bm.pl deleted file mode 100644 index 0dc688d..0000000 --- a/bm.pl +++ /dev/null @@ -1,55 +0,0 @@ -#!/usr/bin/perl -use v5.14; -use warnings; - -use lib 'lib'; - -use Benchmark; -use Gruntmaster::Data; - -my $db = Gruntmaster::Data->connect('dbi:Pg:'); - -timethese(-1, { - orig => sub { $db->user_list_orig }, - new => sub { $db->user_entry }, -}); - -timethese(-1, { - orig => sub { $db->user_entry_orig('PlayLikeNeverB4') }, - new => sub { $db->user_entry('PlayLikeNeverB4') }, -}); - -timethese(-1, { - orig => sub { $db->contest_list_orig }, - new => sub { $db->contest_entry }, -}); - -timethese(-1, { - orig => sub { $db->contest_entry_orig('mc2015r4') }, - new => sub { $db->contest_entry('mc2015r4') }, -}); - -timethese(-1, { - orig => sub { $db->problem_list_orig }, - new => sub { $db->problem_list }, -}); - -timethese(-1, { - orig => sub { $db->problem_entry_orig('aplusb') }, - new => sub { $db->problem_entry('aplusb') }, -}); - -timethese(50, { - orig => sub { $db->job_list_orig }, - new => sub { $db->job_list }, -}); - -timethese(-1, { - orig => sub { $db->job_entry_orig(9000) }, - new => sub { $db->job_entry(9000) }, -}); - -timethese(10, { - orig => sub { $db->update_status_orig }, - new => sub { $db->update_status }, -}); diff --git a/lib/Gruntmaster/Data.pm b/lib/Gruntmaster/Data.pm index 3da2529..44ea4b4 100644 --- a/lib/Gruntmaster/Data.pm +++ b/lib/Gruntmaster/Data.pm @@ -1,30 +1,14 @@ -use utf8; package Gruntmaster::Data; - -# Created by DBIx::Class::Schema::Loader -# DO NOT MODIFY THE FIRST PART OF THIS FILE - -use strict; +use v5.14; use warnings; -use base 'DBIx::Class::Schema'; - -__PACKAGE__->load_namespaces; - - -# Created by DBIx::Class::Schema::Loader v0.07039 @ 2014-03-05 13:11:39 -# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:dAEmtAexvUaNXLgYz2rNEg - use parent qw/Exporter/; our $VERSION = '5999.000_013'; our @EXPORT = qw/purge/; ## no critic (ProhibitAutomaticExportation) -use Lingua::EN::Inflect qw/PL_N/; use JSON::MaybeXS qw/decode_json/; use HTTP::Tiny; use PerlX::Maybe qw/maybe/; -use Sub::Name qw/subname/; -use Class::Method::Modifiers qw/around/; use DBI; use DBIx::Simple; @@ -36,21 +20,6 @@ use constant PROBLEM_PUBLIC_COLUMNS => [qw/id author writer level name owner pri use constant USER_PUBLIC_COLUMNS => [qw/id admin name town university country level/]; use constant JOBS_PER_PAGE => 50; -sub dynsub{ - our ($name, $sub) = @_; - no strict 'refs'; ## no critic (Strict) - *$name = subname $name => $sub -} - -BEGIN { - for my $rs (qw/contest contest_problem job open limit problem user problem_status contest_status/) { - my $rsname = ucfirst $rs; - $rsname =~ s/_([a-z])/\u$1/gs; - dynsub PL_N($rs) => sub { $_[0]->resultset($rsname) }; - dynsub $rs => sub { $_[0]->resultset($rsname)->find($_[1]) }; - } -} - my %statements = ( user_list_sth => 'SELECT * FROM user_list LIMIT 200', user_entry_sth => 'SELECT * FROM user_data WHERE id = ?', @@ -73,13 +42,14 @@ my %statements = ( job_full_sth => 'SELECT * FROM jobs WHERE id = ?', ); -around connect => sub { - my $orig = shift; - my $self = $orig->(@_); - $self->{dbh} = DBI->connect($_[1]); - $self->{dbis} = DBIx::Simple->new($self->{dbh}); +sub connect { + my ($class, @args) = @_; + + my $self = { + dbis => DBIx::Simple->new(@args), + }; $self->{dbis}->keep_statements = 100; - $self + bless $self, $class }; sub purge; @@ -119,37 +89,6 @@ sub add_names { $el } -sub user_list_orig { - my ($self) = @_; - my $rs = $self->users->search(undef, {columns => USER_PUBLIC_COLUMNS} ); - my (%solved, %attempted, %contests); - - for my $row ($self->problem_statuses->all) { - $solved {$row->rawowner}++ if $row->solved; - $attempted{$row->rawowner}++ unless $row->solved; - } - $contests{$_->rawowner}++ for $self->contest_statuses->all; - - my @users = sort { $b->{solved} <=> $a->{solved} or $b->{attempted} <=> $a->{attempted} } ## no critic (ProhibitReverseSort) - map { - my $id = $_->id; - +{ $_->get_columns, - solved => ($solved{$id} // 0), - attempted => ($attempted{$id} // 0), - contests => ($contests{$id} // 0) } - } $rs->all; - @users = @users[0 .. 199] if @users > 200; - \@users -} - -sub user_entry_orig { - my ($self, $id) = @_; - my $user = $self->users->find($id, {columns => USER_PUBLIC_COLUMNS, prefetch => [qw/problem_statuses contest_statuses/]}); - my @problems = map { {problem => $_->get_column('problem'), solved => $_->solved} } $user->problem_statuses->search(undef, {order_by => 'problem'}); - my @contests = map { {contest => $_->contest->id, contest_name => $_->contest->name, rank => $_->rank, score => $_->score} } $user->contest_statuses->search(undef, {prefetch => 'contest', order_by => 'contest.start DESC'}); - +{ $user->get_columns, problems => \@problems, contests => \@contests } -} - sub user_list { my ($self) = @_; scalar $self->query('user_list_sth')->hashes @@ -166,23 +105,6 @@ sub user_entry { $ret; } -sub problem_list_orig { - my ($self, %args) = @_; - my @columns = @{PROBLEM_PUBLIC_COLUMNS()}; - push @columns, 'solution' if $args{solution} && $args{contest} && !$self->contest($args{contest})->is_running; - my $rs = $self->problems->search(undef, {order_by => 'me.name', columns => \@columns, prefetch => 'owner'}); - $rs = $rs->search({'private' => 0}) unless $args{contest} || $args{private}; - $rs = $rs->search({'contest_problems.contest' => $args{contest}}, {join => 'contest_problems'}) if $args{contest}; - $rs = $rs->search({'me.owner' => $args{owner}}) if $args{owner}; - my %params; - $params{contest} = $args{contest} if $args{contest} && $self->contest($args{contest})->is_running; - for ($rs->all) { - $params{$_->level} //= []; - push @{$params{$_->level}}, {$_->get_columns, owner_name => $_->owner->name} ; - } - \%params -} - sub problem_list { my ($self, %args) = @_; my @columns = @{PROBLEM_PUBLIC_COLUMNS()}; @@ -204,38 +126,6 @@ sub problem_list { \%params } -sub problem_entry_orig { - my ($self, $id, $contest, $user) = @_; - my $running = $contest && $self->contest($contest)->is_running; - my @columns = @{PROBLEM_PUBLIC_COLUMNS()}; - push @columns, 'statement'; - push @columns, 'solution' unless $running; - my $pb = $self->problems->find($id, {columns => \@columns, prefetch => 'owner'}); - my @limits = map { +{ - format => $_->format, - timeout => $_->timeout, - } } $self->limits->search({problem => $id}); - my $open; - $open = $self->opens->find_or_create({ - contest => $contest, - problem => $id, - owner => $user, - time => time, - }) if $running; - $contest &&= $self->contest($contest); - +{ - $pb->get_columns, - @limits ? (limits => \@limits) : (), - owner_name => $pb->owner->name, - cansubmit => !$contest || !$contest->is_finished, - $running ? ( - contest_start => $contest->start, - contest_stop => $contest->stop, - open_time => $open->time - ) : (), - } -} - sub problem_entry { my ($self, $id, $contest, $user) = @_; $contest &&= $self->contest_entry($contest); @@ -252,25 +142,6 @@ sub problem_entry { $ret } -sub contest_list_orig { - my ($self, %args) = @_; - my $rs = $self->contests->search(undef, {columns => CONTEST_PUBLIC_COLUMNS, order_by => {-desc => 'start'}, prefetch => 'owner'}); - $rs = $rs->search({owner => $args{owner}}) if $args{owner}; - my %params; - for ($rs->all) { - my $state = $_->is_pending ? 'pending' : $_->is_running ? 'running' : 'finished'; - $params{$state} //= []; - push @{$params{$state}}, { $_->get_columns, owner_name => $_->owner->name }; - } - \%params -} - -sub contest_entry_orig { - my ($self, $id) = @_; - my $ct = $self->contests->find($id,{columns => CONTEST_PUBLIC_COLUMNS}); - +{ $ct->get_columns, started => !$ct->is_pending, finished => $ct->is_finished, owner_name => $ct->owner->name } -} - sub contest_list { my ($self) = @_; my $ret = $self->query('contest_list_sth')->hashes; @@ -302,46 +173,6 @@ sub contest_has_problem { $self->query('contest_has_problem_sth')->flat } -sub job_list_orig { - my ($self, %args) = @_; - $args{page} //= 1; - my $rs = $self->jobs->search(undef, {order_by => {-desc => 'me.id'}, prefetch => ['problem', 'owner', 'contest'], rows => JOBS_PER_PAGE, page => $args{page}}); - $rs = $rs->search({contest => $args{contest} || undef}) if exists $args{contest}; - $rs = $rs->search({'me.private'=> 0}) unless $args{private}; - $rs = $rs->search({'me.owner' => $args{owner}}) if $args{owner}; - $rs = $rs->search({problem => $args{problem}}) if $args{problem}; - $rs = $rs->search({result => $args{result}}) if defined $args{result}; - return { - log => [map { - my %params = $_->get_columns; - $params{owner_name} = $_->owner->name; - $params{problem_name} = $_->problem->name; - $params{contest_name} = $_->contest->name if $params{contest}; - $params{results} &&= decode_json $params{results}; - $params{size} = length $params{source}; - delete $params{source}; - \%params - } $rs->all], - current_page => $rs->pager->current_page, - maybe previous_page => $rs->pager->previous_page, - maybe next_page => $rs->pager->next_page, - maybe last_page => $rs->pager->last_page, - } -} - -sub job_entry_orig { - my ($self, $id) = @_; - my $job = $self->jobs->find($id, {prefetch => ['problem', 'owner', 'contest']}); - my %params = $job->get_columns; - $params{owner_name} = $job->owner->name; - $params{problem_name} = $job->problem->name; - $params{contest_name} = $job->contest->name if $params{contest}; - $params{results} &&= decode_json $params{results}; - $params{size} = length $params{source}; - delete $params{source}; - \%params -} - sub job_list { my ($self, %args) = @_; $args{page} //= 1; @@ -444,36 +275,6 @@ sub standings { } } -sub update_status_orig { - my ($self) = @_; - my @jobs = $self->jobs->search({'me.private' => 0}, {cache => 1, prefetch => 'problem', order_by => 'me.id'})->all; - - my %private; - my %hash; - for (@jobs) { - my $pb = $_->get_column('problem'); - $private{$pb} //= $_->problem->private; - next if $private{$pb}; - $hash{$pb, $_->get_column('owner')} = [$_->id, $_->result ? 0 : 1]; - } - - my @problem_statuses = map { [split ($;), @{$hash{$_}} ] } keys %hash; - - my @contest_statuses = map { - my $contest = $_->id; - map { [$contest, $_->{user}, $_->{score}, $_->{rank}] } $_->standings - } $self->contests->all; - - my $txn = sub { - $self->problem_statuses->delete; - $self->problem_statuses->populate([[qw/problem owner job solved/], @problem_statuses]); - $self->contest_statuses->delete; - $self->contest_statuses->populate([[qw/contest owner score rank/], @contest_statuses]); - }; - - $self->txn_do($txn); -} - sub update_status { my ($self) = @_; my $jobs = $self->{dbis}->select('jobs', 'id,owner,problem,result', {}, 'id'); diff --git a/lib/Gruntmaster/Data/Result/Contest.pm b/lib/Gruntmaster/Data/Result/Contest.pm deleted file mode 100644 index 453982b..0000000 --- a/lib/Gruntmaster/Data/Result/Contest.pm +++ /dev/null @@ -1,292 +0,0 @@ -use utf8; -package Gruntmaster::Data::Result::Contest; - -# Created by DBIx::Class::Schema::Loader -# DO NOT MODIFY THE FIRST PART OF THIS FILE - -=head1 NAME - -Gruntmaster::Data::Result::Contest - List of contests - -=cut - -use strict; -use warnings; - -use base 'DBIx::Class::Core'; - -=head1 TABLE: C - -=cut - -__PACKAGE__->table("contests"); - -=head1 ACCESSORS - -=head2 id - - data_type: 'text' - is_nullable: 0 - -=head2 name - - data_type: 'text' - is_nullable: 0 - -=head2 editorial - - data_type: 'text' - is_nullable: 1 - -HTML fragment placed before the editorial - -=head2 description - - data_type: 'text' - is_nullable: 1 - -HTML fragment placed on contest page - -=head2 start - - data_type: 'integer' - is_nullable: 0 - -Unix time when contest starts - -=head2 stop - - data_type: 'integer' - is_nullable: 0 - -Unix time when contest ends - -=head2 owner - - data_type: 'text' - is_foreign_key: 1 - is_nullable: 0 - -=cut - -__PACKAGE__->add_columns( - "id", - { data_type => "text", is_nullable => 0 }, - "name", - { data_type => "text", is_nullable => 0 }, - "editorial", - { data_type => "text", is_nullable => 1 }, - "description", - { data_type => "text", is_nullable => 1 }, - "start", - { data_type => "integer", is_nullable => 0 }, - "stop", - { data_type => "integer", is_nullable => 0 }, - "owner", - { data_type => "text", is_foreign_key => 1, is_nullable => 0 }, -); - -=head1 PRIMARY KEY - -=over 4 - -=item * L - -=back - -=cut - -__PACKAGE__->set_primary_key("id"); - -=head1 RELATIONS - -=head2 contest_problems - -Type: has_many - -Related object: L - -=cut - -__PACKAGE__->has_many( - "contest_problems", - "Gruntmaster::Data::Result::ContestProblem", - { "foreign.contest" => "self.id" }, - { cascade_copy => 0, cascade_delete => 0 }, -); - -=head2 contest_statuses - -Type: has_many - -Related object: L - -=cut - -__PACKAGE__->has_many( - "contest_statuses", - "Gruntmaster::Data::Result::ContestStatus", - { "foreign.contest" => "self.id" }, - { cascade_copy => 0, cascade_delete => 0 }, -); - -=head2 jobs - -Type: has_many - -Related object: L - -=cut - -__PACKAGE__->has_many( - "jobs", - "Gruntmaster::Data::Result::Job", - { "foreign.contest" => "self.id" }, - { cascade_copy => 0, cascade_delete => 0 }, -); - -=head2 opens - -Type: has_many - -Related object: L - -=cut - -__PACKAGE__->has_many( - "opens", - "Gruntmaster::Data::Result::Open", - { "foreign.contest" => "self.id" }, - { cascade_copy => 0, cascade_delete => 0 }, -); - -=head2 owner - -Type: belongs_to - -Related object: L - -=cut - -__PACKAGE__->belongs_to( - "owner", - "Gruntmaster::Data::Result::User", - { id => "owner" }, - { is_deferrable => 0, on_delete => "CASCADE", on_update => "NO ACTION" }, -); - -=head2 problems - -Type: many_to_many - -Composing rels: L -> problem - -=cut - -__PACKAGE__->many_to_many("problems", "contest_problems", "problem"); - - -# Created by DBIx::Class::Schema::Loader v0.07042 @ 2015-02-14 10:52:58 -# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:UTfqBbyhmo0r1HyWtGXidA - -use Class::Method::Modifiers qw/after/; -use List::Util qw/sum/; - -after qw/insert update delete/ => sub { - my ($self) = @_; - Gruntmaster::Data::purge '/ct/'; - Gruntmaster::Data::purge '/ct/' . $self->id; -}; - -sub is_pending { - my ($self, $time) = @_; - $self->start > ($time // time) -} - -sub is_finished { - my ($self, $time) = @_; - $self->stop <= ($time // time) -} - -sub is_running { - my ($self, $time) = @_; - !$self->is_pending($time) && !$self->is_finished($time) -} - -sub calc_score{ - my ($mxscore, $time, $tries, $totaltime) = @_; - my $score = $mxscore; - $time = 0 if $time < 0; - $time = 300 if $time > $totaltime; - $score = ($totaltime - $time) / $totaltime * $score; - $score -= $tries / 10 * $mxscore; - $score = $mxscore * 3 / 10 if $score < $mxscore * 3 / 10; - int $score + 0.5 -} - -sub standings { - my ($self) = @_; - my $ct = $self->id; - - my @problems = map { $_->rawproblem } $self->contest_problems->search({contest => $ct}, {qw/join problem order_by problem.value/}); - my (%scores, %tries, %opens); - $opens{$_->rawproblem, $_->rawowner} = $_ for $self->opens->search({contest => $ct}); - for my $job ($self->jobs->search({contest => $ct, result => {'!=', undef}}, {qw/order_by me.id prefetch/ => [qw/problem/]})) { - my $open = $opens{$job->rawproblem, $job->rawowner}; - my $time = $job->date - ($open ? $open->time : $self->start); - next if $time < 0; - my $value = $job->problem->value; - my $factor = $job->result ? 0 : 1; - $factor = $1 / 100 if $job->result_text =~ /^(\d+ )/s; - $scores{$job->rawowner}{$job->rawproblem} = int ($factor * calc_score ($value, $time, $tries{$job->rawowner}{$job->rawproblem}++, $self->stop - $self->start)); - } - - my %user_to_name = map { $_->id => $_->name } $self->result_source->schema->users->all; - - my @st = sort { $b->{score} <=> $a->{score} or $a->{user} cmp $b->{user} } map { ## no critic (ProhibitReverseSortBlock) - my $user = $_; - +{ - user => $user, - user_name => $user_to_name{$user}, - score => sum (values %{$scores{$user}}), - scores => [map { $scores{$user}{$_} // '-'} @problems], - } - } keys %scores; - - $st[0]->{rank} = 1 if @st; - $st[$_]->{rank} = $st[$_ - 1]->{rank} + ($st[$_]->{score} < $st[$_ - 1]->{score}) for 1 .. $#st; - @st -} - -1; - -__END__ - -=head1 METHODS - -=head2 is_pending(I<[$time]>) - -Returns true if the contest is pending at time I<$time> (which defaults to C