view release on metacpan or  search on metacpan

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

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();