Ancient
view release on metacpan or search on metacpan
lib/util.pm view on Meta::CPAN
# 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)
lib/util.pm view on Meta::CPAN
B<Note:> Creating AND calling a partial is 125% faster than pure Perl.
However, repeatedly calling an already-created partial is ~20% slower
than a hand-written closure. Use partial when you create once and call
many times from different contexts, or for cleaner functional code.
=head2 lazy
my $deferred = lazy { expensive_computation() };
Creates a lazy value that defers computation until forced. The computation
runs at most once; subsequent forces return the cached result.
=head2 force
my $result = force($lazy_value);
Forces evaluation of a lazy value, returning the computed result.
If the value has already been forced, returns the cached result.
Non-lazy values pass through unchanged.
=head2 dig
my $val = dig($hashref, @keys);
my $val = dig($hashref, 'a', 'b', 'c'); # $hashref->{a}{b}{c}
Safely traverses a nested hash structure. Returns undef if any key
is missing, without throwing an exception.
=head2 tap
my $result = tap(\&block, $value);
my $result = tap(sub { print "Debug: $_\n" }, $value);
Executes a side-effect block with the value (setting C<$_> and passing
as argument), then returns the original value unchanged. Useful for
debugging pipelines without affecting data flow.
=head2 clamp
my $clamped = clamp($value, $min, $max);
Constrains a numeric value to a range. Returns C<$min> if C<$value E<lt> $min>,
C<$max> if C<$value E<gt> $max>, otherwise returns C<$value>.
=head2 identity
my $same = identity($value);
Returns the argument unchanged. Uses compile-time optimization to
eliminate the function call entirely. Useful as a default transformer
in pipelines or when an API requires a function but you want a no-op.
=head2 always
my $get_value = always($constant);
$get_value->(); # Returns $constant
$get_value->(1,2,3); # Still returns $constant (args ignored)
Creates a function that always returns the same value, ignoring any arguments.
Useful for callbacks that need to return a fixed value.
=head2 noop
noop(); # Returns undef
noop(1, 2, 3); # Ignores args, returns undef
Does nothing, returns undef. Ignores all arguments. Useful as a default
callback or placeholder.
B<Note:> This returns C<undef> (not empty list) for correct behavior in
map contexts. The standalone C<noop> module returns empty list which is
~45% faster but produces different results in C<map { noop() } @list>.
=head2 stub_true, stub_false
stub_true(); # Always returns 1
stub_false(); # Always returns ''
Constant functions that always return true or false. Useful as default
predicates:
my @all = grep { stub_true() } @items; # Accepts all
my @none = grep { stub_false() } @items; # Rejects all
=head2 stub_array, stub_hash
my $arr = stub_array(); # Returns new []
my $hash = stub_hash(); # Returns new {}
Factory functions that return new empty arrayrefs or hashrefs.
Each call returns a fresh reference.
=head2 stub_string, stub_zero
stub_string(); # Returns ''
stub_zero(); # Returns 0
Return empty string or zero. Unlike C<stub_false>, these return
specific values rather than just falsy values.
=head2 nvl
my $val = nvl($value, $default);
Returns C<$value> if defined, otherwise returns C<$default>. This is the
null coalescing operator found in many languages (C<??> in C#, C<//> in Perl 5.10+).
=head2 coalesce
my $val = coalesce($a, $b, $c, ...);
Returns the first defined value from the argument list. If all arguments
are undefined, returns C<undef>.
=head2 first
my $found = first(sub { $_->{active} }, \@list);
Returns the first element in C<\@list> for which the block returns true.
Sets C<$_> to each element in turn. Returns C<undef> if no element matches.
lib/util.pm view on Meta::CPAN
=back
=head2 first_gt, first_ge, first_lt, first_le, first_eq, first_ne
# Find first element > 500
my $found = first_gt(\@numbers, 500);
# Find first user with age >= 18
my $adult = first_ge(\@users, 'age', 18);
Returns the first element matching the comparison, or undef if none match.
=head2 final, final_gt, final_ge, final_lt, final_le, final_eq, final_ne
# Find last element > 500 (with callback)
my $found = final(sub { $_ > 500 }, \@numbers);
# Find last element > 500 (specialized)
my $found = final_gt(\@numbers, 500);
# Find last user with age < 18 (most recent minor)
my $minor = final_lt(\@users, 'age', 18);
Returns the last element matching the comparison, or undef if none match.
Uses backwards iteration for efficiency - stops as soon as a match is found
from the end of the array.
=head2 any_gt, any_ge, any_lt, any_le, any_eq, any_ne
# Check if any element > threshold
if (any_gt(\@numbers, 100)) { ... }
# Check if any user is under 18
if (any_lt(\@users, 'age', 18)) { ... }
Returns true if any element matches the comparison.
=head2 all_gt, all_ge, all_lt, all_le, all_eq, all_ne
# Check if all scores are passing
if (all_ge(\@scores, 60)) { ... }
# Check if all users are adults
if (all_ge(\@users, 'age', 18)) { ... }
Returns true if all elements match the comparison. Returns true for empty arrays.
=head2 none_gt, none_ge, none_lt, none_le, none_eq, none_ne
# Check if no element exceeds limit
if (none_gt(\@values, 1000)) { ... }
# Check if no user is a minor
if (none_lt(\@users, 'age', 18)) { ... }
Returns true if no element matches the comparison.
=head1 CALLBACK REGISTRY
The callback registry provides named callbacks that can be used with
the C<*_cb> functions. This avoids Perl callback overhead for common
predicates and enables XS modules to register C-level callbacks for
maximum performance.
=head2 Built-in Predicates
All built-in predicates are prefixed with C<:> to distinguish them
from user-registered callbacks:
:is_defined - SvOK check
:is_true - SvTRUE check
:is_false - !SvTRUE check
:is_ref - SvROK check
:is_array - Array reference
:is_hash - Hash reference
:is_code - Code reference
:is_positive - Numeric > 0
:is_negative - Numeric < 0
:is_zero - Numeric == 0
:is_even - Integer divisible by 2
:is_odd - Integer not divisible by 2
:is_empty - Undefined, empty string, empty array, or empty hash
:is_nonempty - Defined and non-empty
:is_string - Defined, not a reference
:is_number - Looks like a number
:is_integer - Integer value
=head2 any_cb, all_cb, none_cb
my $bool = any_cb(\@numbers, ':is_positive');
my $bool = all_cb(\@numbers, ':is_even');
my $bool = none_cb(\@numbers, ':is_negative');
Like C<any>, C<all>, and C<none> but use a registered callback by name.
No Perl callback overhead - runs entirely in C.
=head2 first_cb
my $found = first_cb(\@numbers, ':is_positive');
Returns the first element for which the callback returns true.
Returns undef if no element matches.
=head2 grep_cb
my @positives = grep_cb(\@numbers, ':is_positive');
Returns all elements for which the callback returns true.
=head2 count_cb
my $n = count_cb(\@numbers, ':is_positive');
Counts elements for which the callback returns true.
=head2 partition_cb
my ($pass, $fail) = partition_cb(\@numbers, ':is_positive');
Splits an array into two arrayrefs: the first contains elements
matching the predicate, the second contains non-matching elements.
Returns two arrayrefs.
=head2 final_cb
my $last = final_cb(\@numbers, ':is_positive');
Returns the last element for which the callback returns true.
Searches from the end of the array for efficiency. Returns undef
if no element matches.
=head2 register_callback
register_callback('divisible_by_3', sub { $_[0] % 3 == 0 });
Registers a Perl coderef as a named callback. The coderef receives
the element as its first argument. Names cannot start with C<:>
(reserved for built-ins) and cannot re-register existing names.
=head2 has_callback
if (has_callback('divisible_by_3')) { ... }
Returns true if a callback with the given name is registered.
=head2 list_callbacks
my $callbacks = list_callbacks();
Returns an arrayref of all registered callback names.
=head2 XS Callback Registration
External XS modules can register C-level callbacks for maximum performance.
Include the header in your XS code:
#include "util_callbacks.h"
Then register callbacks:
static bool my_is_valid(pTHX_ SV *elem) {
return SvOK(elem) && SvIV(elem) > 0;
}
BOOT:
util_register_predicate_xs("my_is_valid", my_is_valid);
The C callback avoids all Perl overhead - no call_sv, no stack manipulation.
See C<xs/util/util_callbacks.h> for the full API.
=head1 DATA MANIPULATION
These functions transform and extract data from arrays and hashes.
=head2 uniq
my @unique = uniq(@list);
Returns a list with duplicate values removed, preserving order.
The first occurrence of each value is kept. Uses a hash for O(1) lookups.
=head2 partition
my ($evens, $odds) = partition(sub { $_ % 2 == 0 }, \@numbers);
Splits an array into two arrayrefs based on a predicate. The first
contains elements for which the predicate returns true, the second
contains elements for which it returns false.
=head2 pick
my $subset = pick(\%hash, @keys);
Returns a new hashref containing only the specified keys from the
source hash. Missing keys are silently ignored.
my $user_info = pick(\%user, 'name', 'email');
=head2 omit
my $filtered = omit(\%hash, @keys);
Returns a new hashref with the specified keys removed.
Opposite of C<pick>.
my $safe = omit(\%user, 'password', 'secret_token');
=head2 pluck
my @ids = pluck(\@users, 'id');
Extracts a single field from an array of hashes. Returns a list
of values for that field from each hash.
my @names = pluck(\@employees, 'name');
=head2 defaults
my $merged = defaults(\%hash, \%defaults);
Returns a new hashref with values from C<%defaults> filled in for
any missing keys in C<%hash>. Does not modify the original hashes.
my $config = defaults(\%user_config, { timeout => 30, retries => 3 });
=head2 count
my $n = count(sub { $_ > 10 }, \@numbers);
( run in 0.475 second using v1.01-cache-2.11-cpan-cdf2f3d4e48 )