The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
use strict;

use lib ('./blib','../blib', './lib','../lib');

# Before `make install' is performed this script should be runnable with
# `make test'. After `make install' it should work as `perl Text-FixEOL.t'

#########################
# change 'tests => 9' to 'tests => last_test_to_print';

use File::Temp qw (tempdir);
use Test::More (tests => 9);

#########################
# Insert your test code below, the Test::More module is use()ed here so read
# its man page ( perldoc Test::More ) for help writing this test script.

my $TESTDIR = tempdir(CLEANUP => 1);

#########
# Test 1
BEGIN {
    use_ok('Tie::FileLRUCache');
}

#########
# Test 2
require_ok ('Tie::FileLRUCache');

#########
# Test 3
ok (test_bare_constructor());

#########
# Test 4
ok (test_parameterized_constructor());

#########
# Test 5
ok (test_tie());

#########
# Test 6
ok (test_obj_cache());

#########
# Test 7
ok (test_tied_cache());

#########
# Test 8
ok (test_clear_cache());

#########
# Test 9
ok (test_make_cache_key());

exit;

#####################################################################
#####################################################################

sub test_directory {
    return $TESTDIR;
}

#####################################################################
#####################################################################

sub test_tied_cache {


    {
        my %cache = ();
        unless (tie (%cache, 'Tie::FileLRUCache', test_directory())) {
                diag("Cache tie failed");
                return 0;
        }

    }

    eval {
        my %cache = ();
        tie (%cache, 'Tie::FileLRUCache');
    };
    unless ($@) {
        diag("Cache tie failed to catch bad tie parameters");
        return 0;
    }

    {
        my %cache = ();
        my $cache_obj;
        unless ($cache_obj = tie (%cache, 'Tie::FileLRUCache', test_directory(), 5)) {
                diag("Cache tie failed");
                return 0;
        }

        {
            my $test_key   = 'test';
            my $test_value = 'value';
            $cache{$test_key} = $test_value;
            unless (exists ($cache{$test_key}) and ($cache{$test_key} eq $test_value)) {
                diag("Tied cache existance check for key $test_key failed unexpectedly");
                return 0;
            }
            delete $cache{$test_key};
            if (exists ($cache{$test_key})) {
                diag("Cache value was found after deletion");
                return 0;
            }
        }

        {
            my $test_key   = { 'test' => 'key' };
            my $test_value = 'value';
            $cache{$test_key} = $test_value;
            unless (exists ($cache{$test_key}) and ($cache{$test_key} eq $test_value)) {
                diag("Tied cache existance check for non-scalar key failed unexpectedly");
                return 0;
            }
            delete $cache{$test_key};
            if (exists ($cache{$test_key})) {
                diag("Cache value was found after deletion");
                return 0;
            }
        }
        {
            my %test_items = qw ( a b    c d    e f
                                  g h    i j    k l
                                  m n
                                );

            my @item_keys = sort keys %test_items;
            foreach my $item (@item_keys) {
                $cache{$item} = $test_items{$item};
                sleep 1;
            }
            my $entries_count = $cache_obj->number_of_entries;
            unless (5 == $entries_count) {
                diag("Unexpected number of cache entries (expected 5, found $entries_count)");
                return 0;
            }
            my $match_counter = 0;
            my %expired_items = qw( a b   c d);
            foreach my $item (@item_keys) {
                unless (exists $cache{$item}) {
                    unless (defined $expired_items{$item}) {
                        diag("Cache value for item $item was expired out of sequence");
                        return 0;
                    }
                    next;
                }
                my $item_value = $cache{$item};
                $match_counter++;
                unless ($item_value eq $test_items{$item}) {
                    diag("Cache value for item was incorrect");
                    return 0;
                }
            }
            while (my ($cache_key, $cache_value) = each %cache) {
                diag("Iteration on tied hash returned results (should not)");
                return 0;
            }

            %cache = ();
            foreach my $item (@item_keys) {
                if (exists $cache{$item}) {
                    diag("Cache clear failed to completely clear tied cache");
                    return 0;
                }
            }
        }
    }

    return 1;
}

#####################################################################
#####################################################################

sub test_obj_cache {

    my $cache = Tie::FileLRUCache->new;
    $cache->keep_last(5);
    $cache->cache_dir(test_directory());

    {
        my $test_key   = 'test';
        my $test_value = 'value';
        eval {
            $cache->update( -cache_ky => $test_key, -value => $test_value );
        };
        unless ($@) {
            diag("'update' failed to catch bad calling parameter");
            return 0;
        }

        eval {
            $cache->update( -value => $test_value );
        };
        unless ($@) {
            diag("'update' failed to catch missing -cache_key/-key parameters");
            return 0;
        }

        $cache->cache_dir(undef);
        eval {
            $cache->update( -cache_key => $test_key, -value => $test_value );
        };
        unless ($@) {
            diag("'update' failed to catch missing cache dir");
            return 0;
        }
        $cache->cache_dir(test_directory());

        $cache->update( -cache_key => $test_key, -value => $test_value );

        eval {
            my ($cache_hit, $cache_result) = $cache->check( -cache_ky => $test_key );
        };
        unless ($@) {
            diag("'check' failed to catch bad calling parameter");
            return 0;
        }

        eval {
            $cache->check( -cache_key => $test_key );
        };
        unless ($@) {
            diag("'check' failed to catch bad calling context");
            return 0;
        }

        eval {
            my ($cache_hit, $cache_result) = $cache->check($test_key);
        };
        unless ($@) {
            diag("'check' failed to catch bad calling parameter");
            return 0;
        }

        eval {
            my ($cache_hit, $cache_result) = $cache->check();
        };
        unless ($@) {
            diag("'check' failed to catch missing parameters");
            return 0;
        }

        $cache->cache_dir(undef);
        eval {
            my ($cache_hit, $cache_result) = $cache->check( -cache_key => $test_key );
        };
        unless ($@) {
            diag("'check' failed to catch missing cache dir");
            return 0;
        }
        $cache->cache_dir(test_directory());

        my ($cache_hit, $check_value) = $cache->check( -cache_key => $test_key);
        if (not ($cache_hit) or ($check_value ne $test_value)) {
            diag("Cache check for key failed unexpectedly");
            return 0;
        }
        $cache->delete( -cache_key => $test_key );
        ($cache_hit, $check_value) = $cache->check({ -cache_key => $test_key });
        if ($cache_hit) {
            diag("Cache value was found after deletion");
            return 0;
        }
    }

    {
        my $test_key   = 'test';
        my $test_value = 'value';
        $cache->update( -key => $test_key, -value => $test_value );
        my ($cache_hit, $check_value) = $cache->check( -key => $test_key);
        if (not ($cache_hit) or ($check_value ne $test_value)) {
            diag("Cache check for raw key failed unexpectedly");
            return 0;
        }

        eval {
            $cache->delete( -cache_ky => $test_key );
        };
        unless ($@) {
            diag("'delete' failed to catch bad calling parameter");
            return 0;
        }

        eval {
            $cache->delete($test_key);
        };
        unless ($@) {
            diag("'delete' failed to catch bad calling parameter");
            return 0;
        }

        eval {
            $cache->delete();
        };
        unless ($@) {
            diag("'delete' failed to catch missing parameters");
            return 0;
        }

        $cache->cache_dir(undef);
        eval {
            $cache->delete( -cache_key => $test_key );
        };
        unless ($@) {
            diag("'delete' failed to catch missing cache dir");
            return 0;
        }
        $cache->cache_dir(test_directory());

        $cache->delete( -key => $test_key );
        ($cache_hit, $check_value) = $cache->check({ -key => $test_key });
        if ($cache_hit) {
            diag("Cache value was found after deletion using raw key");
            return 0;
        }
    }

    {
        my %test_items = qw ( a b    c d    e f
                              g h    i j    k l
                              m n
                            );

        my @item_keys = sort keys %test_items;
        foreach my $item (@item_keys) {
            $cache->update({ -cache_key => $item, -value => $test_items{$item} });
            sleep 1;
        }
        my $entries_count = $cache->number_of_entries;
        unless (5 == $entries_count) {
            diag("Unexpected number of cache entries");
            return 0;
        }
        my $match_counter = 0;
        my %expired_items = qw( a b   c d);
        foreach my $item (@item_keys) {
            my ($cache_hit, $item_value) = $cache->check({ -cache_key => $item });
            unless ($cache_hit) {
                unless (defined $expired_items{$item}) {
                    diag("Cache value for item $item was expired out of sequence");
                    return 0;
                }
                next;
            }

            $match_counter++;
            unless ($item_value eq $test_items{$item}) {
                diag("Cache value for item was incorrect");
                return 0;
            }
        }

        $cache->clear;
        foreach my $item (@item_keys) {
            my ($cache_hit, $item_value) = $cache->check({ -cache_key => $item });
            if ($cache_hit) {
                diag("Cache clear failed to completely clear cache");
                return 0;
            }
        }
    }

    return 1;
}

#####################################################################
#####################################################################

sub test_clear_cache {
    {
        eval {
            my $cache = Tie::FileLRUCache->new();
            $cache->clear;
        };
        unless ($@) {
            diag("'clear' failed to catch unset cache directory");
            return 0;
        }
    }

    {
        eval {
            my $cache = Tie::FileLRUCache->new({ -cache_dir => '' });
            $cache->clear;
        };
        unless ($@) {
            diag("'clear' failed to catch unset cache directory");
            return 0;
        }
    }

    return 1;
}

#####################################################################
#####################################################################

sub test_make_cache_key {
    {
        eval {
            my $cache = Tie::FileLRUCache->new();
            my $cache_key = $cache->make_cache_key ({ -key => { 'a' => 'b', 'c' => 'd' } });
        };
        if ($@) {
            diag("Cache key constructor failed $@");
            return 0;
        }
    }

    {
        eval {
            my $cache = Tie::FileLRUCache->new();
            my $cache_key = $cache->make_cache_key ({ -ky => { 'a' => 'b', 'c' => 'd' } });
        };
        unless ($@) {
            diag("Cache key constructor failed to catch bad parameters");
            return 0;
        }
    }

    return 1;
}

#####################################################################
#####################################################################

sub test_bare_constructor {
    {
        my $result = eval {
            my $fixer = Tie::FileLRUCache::new();
            return $fixer;
        };
        if ($@ or not $result) {
            diag("Direct mode constructor failed");
            return 0;
        }
    }

    {
        my $result = eval {
            my $fixer = Tie::FileLRUCache->new();
            return $fixer;
        };
        if ($@ or not $result) {
            diag("Direct mode constructor failed");
            return 0;
        }
    }

    {
        my $result = eval {
            my $fixer_proto = Tie::FileLRUCache->new();
            my $fixer       = $fixer_proto->new();
            return $fixer;
        };
        if ($@ or not $result) {
            diag("Instance mode constructor failed");
            return 0;
        }
    }

    {
        my $result = eval {
            my $fixer = Tie::FileLRUCache::new();
            return $fixer;
        };
        if ($@ or not $result) {
            diag("Static mode constructor failed");
            return 0;
        }
    }

    {
        my $result = eval {
            my $fixer = new Tie::FileLRUCache();
            return $fixer;
        };
        if ($@ or not $result) {
            diag("Indirect mode constructor failed");
            return 0;
        }
    }

    return 1;
}

#####################################################################
#####################################################################

sub test_parameterized_constructor {
    {
        my $result = eval {
            my $fixer = Tie::FileLRUCache->new({ -cache_dir => test_directory(), -keep_last => 10 });
            return $fixer;
        };
        if ($@ or not $result) {
            diag("Direct mode constructor failed");
            return 0;
        }
    }

    {
        my $result = eval {
            my $fixer = Tie::FileLRUCache->new({ -cache_dir => test_directory(), -keep_lst => 10 });
            return $fixer;
        };
        unless ($@) {
            diag("Direct mode constructor failed to catch bad parameters");
            return 0;
        }
    }

    return 1;
}

#####################################################################
#####################################################################

sub test_tie {
    {
        my $result = eval {
            my %cache_hash;
            my $fixer = tie (%cache_hash, 'Tie::FileLRUCache', test_directory(), 10);
            return $fixer;
        };
        if ($@ or not $result) {
            diag("Direct mode constructor failed");
            return 0;
        }
    }

    return 1;
}