TW::Functional

Functional.pm

package TW::Functional;

=head1 NAME

TW::Functional -- functions for helping write more functional code

=head1 WARNING

This module must contain no TW-specific code.  These are purely abstract functions.

=cut

use warnings;
use strict;

use parent 'Exporter';

no warnings 'experimental::signatures'; ## no critic ( TestingAndDebugging::ProhibitNoWarnings )
use feature 'signatures';

# All the importing shenanigans is copied from List::AllUtils.

use List::Util 1.45       ();
use List::MoreUtils 0.428 ();
use List::UtilsBy 0.10    ();

our @_functions_in_this_file = qw( in sum_by sum0_by );

BEGIN {

    # Figure out which functions we are going to import.  Don't import any functions defined in this file.
    my %imported = map { $_ => 'TW::Functional' } @_functions_in_this_file;
    for my $module (qw( List::Util List::MoreUtils List::UtilsBy )) {
        my @ok = do {
            ## no critic (TestingAndDebugging::ProhibitNoStrict)
            no strict 'refs';
            @{ $module . '::EXPORT_OK' };
        };

        $module->import( grep { !$imported{$_} } @ok );

        @imported{@ok} = ($module) x @ok;
    }
}

our @EXPORT_OK = List::Util::uniqstr(
    @List::Util::EXPORT_OK,
    @List::MoreUtils::EXPORT_OK,
    @List::UtilsBy::EXPORT_OK,
    @_functions_in_this_file,
);

our %EXPORT_TAGS = ( all => \@EXPORT_OK );

=head1 EXPORTS

Nothing by default, but everything can be requested.

This includes all the exports of List::Util, List::MoreUtils and List::UtilsBy.

=head1 FUNCTIONS

These are original functions that aren't just imported from elsewhere.

=head2 in( $needle, \@haystack )

=head2 in( qr/needle/, \@haystack )

Returns a boolean saying if C<$needle> is found in C<@haystack>.
If C<$needle> is a regex ref, each element in C<@haystack> is regex
matched against C<$needle>.  Otherwise, each element in C<@haystack>
is matched with C<eq> operator against C<$needle>.

    # Search for a specific country in a list.
    if ( in( $country, [qw( US UK GB )] ) ) { ....

    # Search for anything matching "ERROR" in a list.
    if ( in ( qr/ERROR/, $results ) ) { ...

=cut

sub in : prototype($$) {
    my $needle   = shift;
    my $haystack = shift;

    if ( !defined($needle) ) {
        return 1 if List::Util::any { !defined } @{$haystack};
    }
    elsif ( ref($needle) eq 'Regexp' ) {
        return 1 if List::Util::any { defined && /$needle/ } @{$haystack};
    }
    else {
        return 1 if List::Util::any { defined && ($_ eq $needle) } @{$haystack};
    }

    return 0;
}


=head2 sum_by

=head2 sum0_by

   $sum = sum_by { VALUEFUNC } @vals;

   $sum = sum0_by { VALUEFUNC } @vals;

Returns the sum of the results of VALUEFUNC applied to each of the values
in C<@vals>.

For example:

   $total_salary = sum_by { $_->salary } @employees;

This is the same as using C<sum> from L<List::Util> like

   $total_salary = sum map { $_->salary } @employees;

but without the intermediate results of the C<map>.

If called on an empty list, C<sum_by> returns undef, and C<sum0_by>
returns 0.

These functions are in here until they get added to List::UtilsBy.
https://rt.cpan.org/Public/Bug/Display.html?id=120194

=cut

sub sum_by : prototype(&@) {
   my $code = shift;

   return undef unless @_;

   local $_;  ## no critic ( Variables::RequireInitializationForLocalVars )

   my $sum = 0;
   foreach ( @_ ) {
       $sum += $code->();
   }

   return $sum;
}

sub sum0_by : prototype(&@) {
   my $code = shift;

   local $_;  ## no critic ( Variables::RequireInitializationForLocalVars )

   my $sum = 0;
   foreach ( @_ ) {
       $sum += $code->();
   }

   return $sum;
}

1;