Ancient

 view release on metacpan or  search on metacpan

lib/util.pm  view on Meta::CPAN

package
    util;
use strict;
use warnings;
our $VERSION = '0.18';
require XSLoader;
XSLoader::load('util', $VERSION);
1;

__END__

=head1 NAME

util - Functional programming utilities with XS acceleration

=head1 SYNOPSIS

    use util qw(
        memo pipeline compose partial lazy force dig tap clamp identity always
        noop stub_true stub_false stub_array stub_hash stub_string stub_zero
        nvl coalesce first any all none
        first_gt first_lt first_ge first_le first_eq first_ne
        final final_gt final_lt final_ge final_le final_eq final_ne
        any_gt any_lt any_ge any_le any_eq any_ne
        all_gt all_lt all_ge all_le all_eq all_ne
        none_gt none_lt none_ge none_le none_eq none_ne
        uniq partition pick omit pluck defaults count replace_all negate once
        is_ref is_array is_hash is_code is_defined is_string
        is_empty starts_with ends_with trim ltrim rtrim
        is_true is_false bool
        is_num is_int is_blessed is_scalar_ref is_regex is_glob
        is_positive is_negative is_zero
        is_even is_odd is_between
        is_empty_array is_empty_hash array_len hash_size
        array_first array_last
        maybe sign min2 max2
    );

    # Type predicates - compile-time optimized
    if (is_array($data)) { ... }
    if (is_hash($config)) { ... }
    if (is_code($callback)) { ... }
    if (is_defined($value)) { ... }

    # Boolean/Truthiness predicates
    if (is_true($value)) { ... }   # Perl truth semantics
    if (is_false($value)) { ... }  # Perl false semantics
    my $normalized = bool($value); # Normalize to 1 or ''

    # Extended type predicates
    if (is_num($value)) { ... }        # Numeric value or looks like number
    if (is_int($value)) { ... }        # Integer value
    if (is_blessed($obj)) { ... }      # Blessed reference
    if (is_scalar_ref($ref)) { ... }   # Scalar reference
    if (is_regex($qr)) { ... }         # Compiled regex (qr//)
    if (is_glob(*FH)) { ... }          # Glob

    # Numeric predicates
    if (is_positive($num)) { ... }     # > 0
    if (is_negative($num)) { ... }     # < 0
    if (is_zero($num)) { ... }         # == 0
    if (is_even($num)) { ... }         # n & 1 == 0
    if (is_odd($num)) { ... }          # n & 1 == 1
    if (is_between($n, 1, 10)) { ... } # Range check (inclusive)

    # Collection predicates - direct AvFILL/HvKEYS access
    if (is_empty_array($aref)) { ... }
    if (is_empty_hash($href)) { ... }
    my $len = array_len($aref);        # Direct AvFILL access
    my $size = hash_size($href);       # Direct HvKEYS access
    my $first = array_first($aref);    # Without slice overhead
    my $last = array_last($aref);      # Without slice overhead

    # String predicates - direct SvPV/SvCUR access
    if (is_empty($str)) { ... }
    if (starts_with($filename, '/')) { ... }
    if (ends_with($filename, '.txt')) { ... }

    # Memoization - cache function results
    my $fib = memo(sub {
        my $n = shift;
        return $n if $n < 2;
        return $fib->($n-1) + $fib->($n-2);
    });

    # Pipelines - chain transformations
    my $result = pipeline($data,
        \&fetch,
        \&transform,
        \&process
    );

    # Lazy evaluation - defer computation
    my $expensive = lazy { heavy_computation() };
    my $result = force($expensive);

    # Safe navigation - no exceptions
    my $val = dig($hash, qw(deep nested key));

    # Null coalescing
    my $val = nvl($maybe_undef, $default);
    my $val = coalesce($a, $b, $c);  # First defined

    # List operations with callbacks
    my $found = first(sub { $_->{active} }, \@users);
    if (any(sub { $_ > 10 }, \@numbers)) { ... }
    if (all(sub { $_->{valid} }, \@records)) { ... }

    # Specialized predicates - pure C, no callback overhead
    my $large = first_gt(\@numbers, 100);              # first > 100
    my $adult = first_ge(\@users, 'age', 18);          # first user age >= 18
    my $last_minor = final_lt(\@users, 'age', 18);     # last user age < 18
    if (any_gt(\@values, $threshold)) { ... }          # any > threshold
    if (all_ge(\@scores, 60)) { ... }                  # all >= 60
    if (none_lt(\@ages, 18)) { ... }                   # no minors

    # Debugging helper - execute side effect, return original
    my $result = tap(sub { print "Got: $_\n" }, $value);

    # Constrain value to range
    my $clamped = clamp($value, $min, $max);

    # Identity function - returns argument unchanged
    my $same = identity($x);

    # Constant function factory
    my $get_zero = always(0);
    my $get_config = always({ debug => 1 });
    $get_zero->();  # Always returns 0

=head1 DESCRIPTION

C<util> provides functional programming utilities implemented in XS/C.

B<Custom ops> (compile-time optimization, no function call overhead):

=over 4

=item * C<identity> - eliminated entirely at compile time

=item * C<is_ref>, C<is_array>, C<is_hash>, C<is_code>, C<is_defined> - single SV flag check

=item * C<is_true>, C<is_false>, C<bool> - direct SvTRUE check

=item * C<is_num>, C<is_int>, C<is_blessed>, C<is_scalar_ref>, C<is_regex>, C<is_glob> - extended type checks

=item * C<is_positive>, C<is_negative>, C<is_zero> - numeric comparisons

=item * C<is_even>, C<is_odd> - single bitwise AND

=item * C<is_between> - range check (two comparisons)

=item * C<is_empty_array>, C<is_empty_hash> - direct AvFILL/HvKEYS check

=item * C<array_len>, C<hash_size> - direct AvFILL/HvKEYS access

=item * C<array_first>, C<array_last> - direct av_fetch without slice overhead

=item * C<is_empty>, C<starts_with>, C<ends_with> - direct SvPV/SvCUR string access

=item * C<trim>, C<ltrim>, C<rtrim> - whitespace trimming

=item * C<maybe> - conditional return (if defined)

=item * C<sign> - return -1/0/1 based on sign

=item * C<min2>, C<max2> - two-value min/max

=item * C<clamp> - inlined numeric comparison

=back

B<XS functions> (faster than pure Perl, but still have call overhead):

=over 4

=item * C<memo>, C<force>, C<dig> - memoization and safe navigation

=item * C<nvl>, C<coalesce> - null coalescing

=item * C<first>, C<any>, C<all>, C<none> - short-circuit list operations

=item * C<pipeline>, C<compose> - micro improvements (~15-20%)

=item * C<lazy>, C<tap>, C<always> - deferred evaluation and debugging

=back

Functions that call arbitrary Perl coderefs (C<pipeline>, C<compose>, C<tap>,
C<first>, C<any>, C<all>, C<none>) are limited by C<call_sv()> overhead and
cannot achieve the same performance as pure data operations.

=head1 FUNCTIONS

=head2 memo

    my $cached = memo(\&expensive_function);
    my $result = $cached->($arg);

Returns a memoized version of the given function. Results are cached
based on arguments, so repeated calls with the same arguments return
instantly from the cache.

=head2 pipeline

lib/util.pm  view on Meta::CPAN

These functions use custom ops for Perl truth semantics checks.

=head2 is_true

    my $bool = is_true($value);

Returns true if C<$value> is truthy according to Perl semantics.
This means: defined, non-empty string, non-zero number.

=head2 is_false

    my $bool = is_false($value);

Returns true if C<$value> is falsy according to Perl semantics.
This includes: undef, empty string "", string "0", numeric 0.

=head2 bool

    my $normalized = bool($value);

Normalizes C<$value> to a boolean (1 for true, '' for false).
Useful when you need a consistent boolean representation.

=head1 EXTENDED TYPE PREDICATES

These functions use custom ops for extended type checking.

=head2 is_num

    my $bool = is_num($value);

Returns true if C<$value> is numeric (has a numeric value or
looks like a number). Uses C<looks_like_number> for strings.

=head2 is_int

    my $bool = is_int($value);

Returns true if C<$value> is an integer. Returns true for
whole number floats like 5.0.

=head2 is_blessed

    my $bool = is_blessed($value);

Returns true if C<$value> is a blessed reference (an object).
Uses C<sv_isobject>.

=head2 is_scalar_ref

    my $bool = is_scalar_ref($value);

Returns true if C<$value> is a scalar reference (not array/hash/code).

=head2 is_regex

    my $bool = is_regex($value);

Returns true if C<$value> is a compiled regular expression (qr//).

=head2 is_glob

    my $bool = is_glob($value);

Returns true if C<$value> is a glob (like *STDIN, *main::foo).

=head1 NUMERIC PREDICATES

These functions use custom ops for numeric comparisons.
They first check if the value is numeric, then perform the comparison.

=head2 is_positive

    my $bool = is_positive($value);

Returns true if C<$value> is numeric and greater than zero.
Returns false for non-numeric values.

=head2 is_negative

    my $bool = is_negative($value);

Returns true if C<$value> is numeric and less than zero.
Returns false for non-numeric values.

=head2 is_zero

    my $bool = is_zero($value);

Returns true if C<$value> is numeric and equals zero.
Returns false for non-numeric values.

=head2 is_even

    my $bool = is_even($value);

Returns true if C<$value> is an integer and even (divisible by 2).

=head2 is_odd

    my $bool = is_odd($value);

Returns true if C<$value> is an integer and odd (not divisible by 2).

=head2 is_between

    my $bool = is_between($value, $min, $max);

Returns true if C<$value> is numeric and between C<$min> and C<$max>
(inclusive). Returns false for non-numeric values.

=head1 COLLECTION PREDICATES

These functions use custom ops for collection operations
with direct AvFILL/HvKEYS access.

=head2 is_empty_array

    my $bool = is_empty_array($arrayref);

Returns true if C<$arrayref> is an array reference with no elements.
Returns false for non-arrayrefs. Uses direct AvFILL check.

=head2 is_empty_hash



( run in 0.933 second using v1.01-cache-2.11-cpan-df04353d9ac )