view release on metacpan or  search on metacpan

t/8013-file-hooks.t  view on Meta::CPAN

    # Clear and re-register to ensure clean state
    file::clear_hooks('read');
    file::register_read_hook(sub {
        my ($path, $data) = @_;
        return uc($data);
    });

    # Read should apply hook
    my $content = file::slurp($testfile);
    is($content, 'HELLO WORLD', 'read hook transformed content');

    file::clear_hooks('read');
};

subtest 'read hook receives path' => sub {
    file::clear_hooks('read');

    my $received_path;
    file::register_read_hook(sub {
        my ($path, $data) = @_;
        $received_path = $path;
        return $data;  # Pass through unchanged
    });

    my $testfile = "$tempdir/path_test.txt";
    file::spew($testfile, "test");

    file::clear_hooks('read');
    file::register_read_hook(sub {
        my ($path, $data) = @_;
        $received_path = $path;
        return $data;
    });

    file::slurp($testfile);
    is($received_path, $testfile, 'hook received correct path');

    file::clear_hooks('read');
};

# ============================================
# Write hooks
# ============================================

subtest 'write hook transforms data' => sub {
    file::clear_hooks('write');

    # Register a hook that lowercases content
    file::register_write_hook(sub {
        my ($path, $data) = @_;
        return lc($data);
    });

    ok(file::has_hooks('write'), 'write hook registered');

    my $testfile = "$tempdir/write_hook_test.txt";
    file::spew($testfile, "HELLO WORLD");

    file::clear_hooks('write');

    # Read raw to verify transformation
    my $content = file::slurp($testfile);
    is($content, 'hello world', 'write hook transformed content');
};

subtest 'write hook can add prefix' => sub {
    file::clear_hooks('write');

    file::register_write_hook(sub {
        my ($path, $data) = @_;
        return "PREFIX: $data";
    });

    my $testfile = "$tempdir/prefix_test.txt";
    file::spew($testfile, "content");

    file::clear_hooks('write');

    my $content = file::slurp($testfile);
    is($content, 'PREFIX: content', 'write hook added prefix');
};

# ============================================
# Hook clearing
# ============================================

subtest 'clear_hooks removes hooks' => sub {
    file::clear_hooks('read');
    file::clear_hooks('write');

    file::register_read_hook(sub { uc($_[1]) });
    file::register_write_hook(sub { lc($_[1]) });

    ok(file::has_hooks('read'), 'read hook present');
    ok(file::has_hooks('write'), 'write hook present');

    file::clear_hooks('read');
    ok(!file::has_hooks('read'), 'read hook cleared');
    ok(file::has_hooks('write'), 'write hook still present');

    file::clear_hooks('write');
    ok(!file::has_hooks('write'), 'write hook cleared');
};

# ============================================
# No hooks = no overhead path
# ============================================

subtest 'operations work without hooks' => sub {
    file::clear_hooks('read');
    file::clear_hooks('write');

    my $testfile = "$tempdir/no_hooks.txt";
    my $data = "test data without hooks";

    file::spew($testfile, $data);
    my $read = file::slurp($testfile);

    is($read, $data, 'read/write work without hooks');
};