The London Perl and Raku Workshop takes place on 26th Oct 2024. If your company depends on Perl, please consider sponsoring and/or attending.
#!/usr/bin/env perl
use warnings;
use strict;

=head1 DESCRIPTION

Basic tests for CurrentUser.

=cut

use lib 't/lib';
use Jifty::SubTest;

use Jifty::Test tests => 19;
use Jifty::Test::WWW::Mechanize;

use_ok('TestApp::Model::User');
use_ok('TestApp::CurrentUser');

# Get a system user
my $system_user = TestApp::CurrentUser->superuser;
ok($system_user, "Found a system user");

# Make it so that all users have full access
TestApp::Model::User->add_trigger( before_access => sub { 'allow' } );

# Create two users
my $o = TestApp::Model::User->new(current_user => $system_user);
$o->create( name => 'A User', email => 'auser@example.com', 
            password => 'secret', tasty => 0 );
ok($o->id, "New user has valid id set");
ok(!$o->tasty, "User is not tasty");
$o->create( name => 'Bob', email => 'bob@example.com', 
            password => 'secret2', tasty => 1 );
ok($o->id, "New user has valid id set");
ok($o->tasty, "User is tasty");

# Create a CurrentUser
my $bob = TestApp::CurrentUser->new( name => 'Bob' );
ok($bob->id, "CurrentUser has a valid id set");
is($bob->id, $o->id, "The ids match");
ok($bob->user_object->tasty, "The CurrentUser is tasty");
ok($bob->is_superuser, "CurrentUser is a superuser");

my $server = Jifty::Test->make_server;
isa_ok($server, 'Jifty::Server');

my $URL = $server->started_ok;
my $mech = Jifty::Test::WWW::Mechanize->new();

$mech->get_ok("$URL/currentuser", "Got currentuser page");
$mech->content_contains("No current user set.", "Good, no current user yet");
$mech->get_ok("$URL/setuser/Bob", "Setting currentuser to Bob");
$mech->get_ok("$URL/currentuser", "Refetched currentuser page");
$mech->content_contains("Current user is Bob", "Now the current_user is set");
$mech->content_contains("The current user is a superuser", "... and the current_user is a superuser");