view release on metacpan or  search on metacpan

t/1062-util-valid-callbacks.t  view on Meta::CPAN

        { name => 'Carol', score => 91 },
        { name => 'Dave', score => 68 },
    );

    # Register callback for passing grade
    register_callback('passed', sub { $_[0]->{score} >= 75 });

    my ($passed, $failed) = partition_cb(\@students, 'passed');

    is(scalar(@$passed), 2, 'two passed');
    is(scalar(@$failed), 2, 'two failed');

    my @passed_names = map { $_->{name} } @$passed;
    is_deeply([sort @passed_names], ['Alice', 'Carol'], 'correct students passed');
};

subtest 'chaining callbacks' => sub {
    my @data = (-10, -5, 0, 5, 10, 15, 20);

    # Find positive numbers, then partition by even/odd
    my @positive = grep_cb(\@data, ':is_positive');
    my ($evens, $odds) = partition_cb(\@positive, ':is_even');

    is_deeply($evens, [10, 20], 'positive evens');
    is_deeply($odds, [5, 15], 'positive odds');
};

subtest 'all_cb edge cases' => sub {
    # Empty array
    my @empty = ();
    ok(all_cb(\@empty, ':is_positive'), 'all_cb empty = true (vacuous)');

    # Single element
    my @single = (5);
    ok(all_cb(\@single, ':is_positive'), 'all_cb single positive');
    ok(!all_cb(\@single, ':is_negative'), 'all_cb single not negative');
};

subtest 'none_cb edge cases' => sub {
    # Empty array
    my @empty = ();
    ok(none_cb(\@empty, ':is_positive'), 'none_cb empty = true');

    # All fail condition
    my @negatives = (-5, -3, -1);
    ok(none_cb(\@negatives, ':is_positive'), 'none_cb all negative');
};

subtest 'first_cb and final_cb with no match' => sub {
    my @positives = (1, 2, 3);

    my $first_neg = first_cb(\@positives, ':is_negative');
    ok(!defined $first_neg, 'first_cb no match = undef');

    my $final_neg = final_cb(\@positives, ':is_negative');
    ok(!defined $final_neg, 'final_cb no match = undef');
};

subtest 'real-world: data filtering pipeline' => sub {
    my @transactions = (
        { amount => 100, type => 'credit' },
        { amount => -50, type => 'debit' },
        { amount => 200, type => 'credit' },
        { amount => -30, type => 'debit' },
        { amount => 0, type => 'adjustment' },
    );

    # Register callbacks for transaction filtering
    register_callback('is_credit', sub { $_[0]->{type} eq 'credit' });
    register_callback('is_debit', sub { $_[0]->{type} eq 'debit' });
    register_callback('non_zero', sub { $_[0]->{amount} != 0 });

    my @credits = grep_cb(\@transactions, 'is_credit');
    is(scalar(@credits), 2, 'two credits');

    my @debits = grep_cb(\@transactions, 'is_debit');
    is(scalar(@debits), 2, 'two debits');

    my @active = grep_cb(\@transactions, 'non_zero');
    is(scalar(@active), 4, 'four non-zero transactions');

    # Calculate totals
    my $credit_total = 0;
    $credit_total += $_->{amount} for @credits;
    is($credit_total, 300, 'credit total = 300');
};

subtest 'real-world: validation framework' => sub {
    # Register validation callbacks
    register_callback('has_name', sub { defined $_[0]->{name} && length($_[0]->{name}) > 0 });
    register_callback('has_email', sub { defined $_[0]->{email} && $_[0]->{email} =~ /@/ });
    register_callback('adult', sub { defined $_[0]->{age} && $_[0]->{age} >= 18 });

    my @users = (
        { name => 'Alice', email => 'alice@example.com', age => 25 },
        { name => 'Bob', age => 17 },
        { name => '', email => 'anon@example.com', age => 30 },
        { name => 'Carol', email => 'carol@example.com', age => 22 },
    );

    my @with_name = grep_cb(\@users, 'has_name');
    is(scalar(@with_name), 3, 'three have names');

    my @with_email = grep_cb(\@users, 'has_email');
    is(scalar(@with_email), 3, 'three have emails');

    my @adults = grep_cb(\@users, 'adult');
    is(scalar(@adults), 3, 'three adults');

    # Find fully valid users (all conditions)
    my @valid = grep {
        first_cb([$_], 'has_name') &&
        first_cb([$_], 'has_email') &&
        first_cb([$_], 'adult')
    } @users;
    is(scalar(@valid), 2, 'two fully valid users');
};

done_testing();