Apache2-AuthCookieDBI

 view release on metacpan or  search on metacpan

t/utils24.t  view on Meta::CPAN


        is( $un_hexified, $expected->{$encryption_type},
            "_encrypt_session_key() using '$encryption_type' (returned '$mock_crypt_text')"
        );
    }
    return TRUE;
}

sub test_get_cipher_for_type {

    # ( $dbi_encryption_type, $auth_name, $secret_key )
    my $auth_name  = 'Sample Auth Name';
    my $secret_key = 'Sample Secret Key String';
    my @test_cases = (
        {   dbi_encryption_type  => 'des',
            expected_cipher_type => 'DES',
        },
        {   dbi_encryption_type  => 'idea',
            expected_cipher_type => 'IDEA',
        },
        {   dbi_encryption_type  => 'blowfish',
            expected_cipher_type => 'Blowfish',
        },
        {   dbi_encryption_type  => 'blowfish_pp',
            expected_cipher_type => 'Blowfish_PP',
        },
        {   dbi_encryption_type  => 'BLOWFISH_PP',    # verify case-insensitive
            expected_cipher_type => 'Blowfish_PP',
        },
    );
    foreach my $case (@test_cases) {
        my $dbi_encryption_type = $case->{'dbi_encryption_type'};
        my $mock_cbc
            = CLASS_UNDER_TEST->_get_cipher_for_type( $dbi_encryption_type,
            $auth_name, $secret_key, );
        Test::More::is( $mock_cbc->{'-key'}, $secret_key,
            "_get_cipher_for_type() for $dbi_encryption_type - secret_key" );

        my $expected_cipher_type = $case->{'expected_cipher_type'};
        Test::More::is( $mock_cbc->{'-cipher'},
            $expected_cipher_type,
            "_get_cipher_for_type() for $dbi_encryption_type - cipher_type" );

        my $second_mock_from_same_args
            = CLASS_UNDER_TEST->_get_cipher_for_type( $dbi_encryption_type,
            $auth_name, $secret_key, );

        Test::More::is( $second_mock_from_same_args, $mock_cbc,
            "_get_cipher_for_type($dbi_encryption_type,$auth_name, $secret_key) cached CBC object"
        );
    }

    my $unsupported_type = 'BunnyRabbits';
    eval {
        CLASS_UNDER_TEST->_get_cipher_for_type( $unsupported_type, $auth_name,
            $secret_key, );
    };
    Test::More::like(
        $EVAL_ERROR,
        qr/Unsupported encryption type: '$unsupported_type'/,
        '_get_cipher_for_type() throws exception on unsupported encryption type.'
    );
    return TRUE;
}

sub test_get_crypted_password {
    my $auth_name         = 'test_get_crypted_password';
    my $user              = 'test_user';
    my $r                 = set_up($auth_name);
    my $expected_password = 'mock_crypted_password';
    my $got_password;
    {
        no warnings qw(once redefine);
        local *DBI::Mock::sth::fetchrow_array = sub {
            return ($expected_password);
        };
        $got_password = CLASS_UNDER_TEST->_get_crypted_password( $r, $user );
    }

    Test::More::is( $got_password, $expected_password,
        '_get_crypted_password() with default config.' );

    # Simulate password not found
    {
        no warnings qw(once redefine);
        local *DBI::Mock::sth::fetchrow_array = sub {
            return ()    # empty array, password not found;
        };
        $got_password = CLASS_UNDER_TEST->_get_crypted_password( $r, $user );
    }
    Test::More::ok( !$got_password,
        '_get_crypted_password() with password not found' );
    my $got_errrors = $r->log->error();    # from the mock request object
    Test::More::is( scalar @$got_errrors,
        1, '_get_crypted_password() logs password not found' );

    my $class = CLASS_UNDER_TEST;
    Test::More::like(
        $got_errrors->[0],
        qr/\A${class}\tCould not select password/,
        '_get_crypted_password() error message for password not found'
    );

    return TRUE;
}

sub test_group {
    my $auth_name = 'test_group';
    my $r         = set_up($auth_name);
    my $user      = 'test_user';
    $r->{'user'} = $user;
    my $mock_config = $r->{'mock_config'};
    my @groups      = qw(group_one group_two);

    my @database_queries;
    my $got_result;
    {
        no warnings qw(once redefine);
        local *DBI::Mock::sth::execute = sub {
            my ( $sth, @args ) = @_;
            push @database_queries, \@args;



( run in 1.367 second using v1.01-cache-2.11-cpan-39bf76dae61 )