t/mech.t

   1 #!/usr/bin/perl -w
   2 use strict;
   3 use warnings;
   4
   5 use Test::MockTime ':all';
   6 use Test::More tests => 14;
   7 use Test::WWW::Mechanize::PSGI;
   8
   9 use Gruntmaster::Data;
  10 use JSON::MaybeXS qw/decode_json/;
  11 use Log::Log4perl qw/:easy/;
  12
  13 set_fixed_time 25;
  14
  15 my $mech = Test::WWW::Mechanize::PSGI->new(app => do 'app.psgi');
  16 my $result;
  17 my $content;
  18
  19 Log::Log4perl->easy_init($OFF);
  20
  21 sub get {
  22         my ($url, $expect_fail) = @_;
  23         my $param = $url =~ /[?]/ ? '&format=json' : '?format=json';
  24         $expect_fail ? $mech->get("$url$param") : $mech->get_ok("$url$param");
  25         $result = $mech->response->code;
  26         $content = $result == 200 ? decode_json $mech->content(decoded_by_headers => 1) : '';
  27 }
  28
  29 our $db = Gruntmaster::Data->connect('dbi:SQLite:dbname=:memory:');
  30 $db->deploy;
  31
  32 $db->users->create({id => 'MGV', admin => 1});
  33 $db->contests->create({id => 'fc', start => 10, stop => 20, name => 'Finished contest', owner => 'MGV'});
  34 $db->contests->create({id => 'rc', start => 20, stop => 30, name => 'Running contest', owner => 'MGV'});
  35 $db->contests->create({id => 'pc', start => 30, stop => 40, name => 'Pending contest', owner => 'MGV'});
  36
  37 my @pbjunk = (
  38         name      => 'Problem',
  39         generator => 'Undef',
  40         runner    => 'File',
  41         judge     => 'Absolute',
  42         level     => 'beginner',
  43         value     => 100,
  44         owner     => 'MGV',
  45         statement => '...',
  46         testcnt   => 1,
  47         timeout   => 1
  48 );
  49
  50 $db->problems->create({id => 'fca', private => 0, @pbjunk});
  51 $db->problems->create({id => 'rca', private => 0, @pbjunk});
  52 $db->problems->create({id => 'pca', private => 0, @pbjunk});
  53 $db->problems->create({id => 'arc', private => 0, @pbjunk});
  54 $db->problems->create({id => 'prv', private => 1, @pbjunk});
  55 $db->contest_problems->create({problem => "${_}a", contest => $_}) for qw/fc rc pc/;
  56
  57 sub problem_list () { [sort map {$_->{id}} @{$content->{beginner}}] }
  58 get '/pb/';
  59 is_deeply problem_list, [qw/arc fca/], '/pb/ has correct problems';
  60 get '/pb/?contest=pc', 1;
  61 is $result, 401, '/pb/?contest=pc returns 401';
  62 get '/pb/?contest=rc';
  63 is_deeply problem_list, [qw/rca/], '/pb/?contest=rc has correct problems';
  64 get '/pb/?contest=fc';
  65 is_deeply problem_list, [qw/fca/], '/pb/?contest=fc has correct problems';
  66
  67 get '/us/';
  68 my ($mgv) = @{$content->{us}};
  69 is $mgv->{id}, 'MGV', 'first (and only) user is MGV';
  70 is $mgv->{admin}, 1, 'MGV is an admin';
  71
  72 get '/ct/';
  73 my $pc = $content->{pending}->[0];
  74 my $rc = $content->{running}->[0];
  75 my $fc = $content->{finished}->[0];
  76 is $pc->{id}, 'pc', 'pc is pending';
  77 is $rc->{id}, 'rc', 'rc is running';
  78 is $fc->{id}, 'fc', 'fc is running';