view release on metacpan or  search on metacpan

t/8001-file-callbacks.t  view on Meta::CPAN

subtest 'map_lines with $_' => sub {
    my $result = file::map_lines($test_file, sub {
        length($_);
    });

    is($result->[0], 5, 'apple length');
    is($result->[1], 6, 'banana length');
    is($result->[2], 0, 'empty line length');
};

subtest 'map_lines transformation' => sub {
    my $result = file::map_lines($test_file, sub {
        my $line = shift;
        return ">> $line <<";
    });

    is($result->[0], '>> apple <<', 'wrapped first line');
    is($result->[3], '>> cherry <<', 'wrapped fourth line');
};

subtest 'map_lines empty file' => sub {
    my $empty = "$tmpdir/empty_map.txt";
    file::spew($empty, "");
    my $result = file::map_lines($empty, sub { uc(shift) });
    is(scalar(@$result), 0, 'empty array for empty file');
};

# ============================================
# register_line_callback tests
# ============================================

subtest 'register custom callback' => sub {
    # Register a custom predicate
    file::register_line_callback('has_vowels', sub {
        shift =~ /[aeiou]/i;
    });

    # Use it
    my $result = file::grep_lines($test_file, 'has_vowels');
    ok(scalar(@$result) > 0, 'custom callback works');
    ok((grep { $_ eq 'apple' } @$result), 'apple has vowels');
};

subtest 'register overwrites existing' => sub {
    file::register_line_callback('custom_test', sub { 0 });
    my $r1 = file::grep_lines($test_file, 'custom_test');
    is(scalar(@$r1), 0, 'first callback matches nothing');

    file::register_line_callback('custom_test', sub { 1 });
    my $r2 = file::grep_lines($test_file, 'custom_test');
    is(scalar(@$r2), 9, 'replaced callback matches all');
};

subtest 'register_line_callback requires coderef' => sub {
    eval { file::register_line_callback('bad', 'not a coderef') };
    like($@, qr/coderef/, 'dies without coderef');
};

# ============================================
# list_line_callbacks tests
# ============================================

subtest 'list_line_callbacks' => sub {
    my $list = file::list_line_callbacks();
    is(ref($list), 'ARRAY', 'returns arrayref');

    # Check builtins exist
    my %callbacks = map { $_ => 1 } @$list;
    ok($callbacks{'is_blank'}, 'is_blank registered');
    ok($callbacks{'is_not_blank'}, 'is_not_blank registered');
    ok($callbacks{'is_empty'}, 'is_empty registered');
    ok($callbacks{'is_not_empty'}, 'is_not_empty registered');
    ok($callbacks{'is_comment'}, 'is_comment registered');
    ok($callbacks{'is_not_comment'}, 'is_not_comment registered');

    # Aliases
    ok($callbacks{'blank'}, 'blank alias registered');
    ok($callbacks{'not_blank'}, 'not_blank alias registered');
};

# ============================================
# Edge cases and stress tests
# ============================================

subtest 'callback with die' => sub {
    eval {
        file::each_line($test_file, sub {
            die "intentional error" if shift eq 'cherry';
        });
    };
    like($@, qr/intentional error/, 'callback die propagates');
};

subtest 'large file callbacks' => sub {
    my $large = "$tmpdir/large_callback.txt";
    my @lines = map { "line number $_" } 1..1000;  # Reduced from 10000
    file::spew($large, join("\n", @lines));

    my $count = 0;
    file::each_line($large, sub { $count++ });
    is($count, 1000, 'processes all 1000 lines');

    my $filtered = file::grep_lines($large, sub { /555/ });
    ok(scalar(@$filtered) > 0, 'grep works on large file');

    my $total = file::count_lines($large);
    is($total, 1000, 'count_lines on large file');
};

subtest 'lines with special characters' => sub {
    my $special = "$tmpdir/special.txt";
    file::spew($special, "line with\ttab\nline with spaces   \n\$pecial \@chars!");

    my @collected;
    file::each_line($special, sub { push @collected, shift });

    is($collected[0], "line with\ttab", 'tab preserved');
    is($collected[1], 'line with spaces   ', 'trailing spaces preserved');
    is($collected[2], '$pecial @chars!', 'special chars preserved');
};

subtest 'unicode content' => sub {
    my $unicode = "$tmpdir/unicode.txt";
    file::spew($unicode, "hello\nworld\ncafe");  # Simple ASCII for now

    my $result = file::grep_lines($unicode, sub { length(shift) >= 5 });
    is(scalar(@$result), 2, 'filters unicode correctly');
};

subtest 'chained operations' => sub {
    # grep then count - simulate pipeline
    my $non_blank = file::grep_lines($test_file, 'is_not_blank');
    my $comment_count = scalar(grep { /^#/ } @$non_blank);
    is($comment_count, 2, 'can chain operations');
};

done_testing();