Jim Schueler

sub lowercase {
    return map { lc } @_ ;
}

$jim = lowercase('jim') ;
print "$jim\n" ;

Naturally that this snippet of code prints 1. I understand the explanation of "an array in scalar context blah blah blah". But it's so counter-intuitive because many functions are intended to mutate each element in a list. Presumably one should define separate functions depending on whether an array is expected, but that's so non-perlish. There's no elegant way to throw the wantarray operator in that example function. And even if there was, it's awkward to use the same idiom repeatedly.

I'd prefer simply to use a pragma such as the following:

use Function::ReturnScalar qw( first ) ;

## use Function::ReturnScalar qw( last ) ;      # optional alternative

## use Function::ReturnScalar qw( count ) ;   # optional alternative

sub lowercase {
    return map { lc } @_ ;
    }

$jim = lowercase('Jim') ;                                  # $jim == 'jim'

The pragmas in the above example don't exist. At least, even after posting on perlmonks, I can't find anything equivalent. But in a couple of hours, I wrote a rudimentary module that performs this function.

So if in fact there isn't one already, and others are interested in this functionality, I'd be perfectly happy to press on. In that case, please comment as appropriate.

Here's my prototype:

package Function::ReturnScalar ;

use strict ;
use warnings ;

my $originals_of_package_ref ;
my @callers ;
my %behavior_of ;

$behavior_of{first} = sub { $_[0] } ;
$behavior_of{last} = sub { $_[-1] } ;
$behavior_of{count} = sub { @_ } ;
		
INIT {
	map { _replace_package_symbols( @$_ ) } @callers ;
	}

##
#  Accepts one of first|last|count 
##

sub import {
	my ( $package, $behave_how ) = @_ ;
	push @callers, [ scalar caller, $behave_how ] ;
	}

sub _replace_package_symbols {
	my ( $package, $behave_how ) = @_ ;

	no strict qw( refs ) ;
	no warnings ;

	my $scalar_code_ref = $behavior_of{ $behave_how } ;
	return unless $scalar_code_ref ;

	my %symbols = %{ "${package}::" } ;
	my @subs = grep $_->[1],
			map { [ $_ => *{ $symbols{$_} }{CODE} ] } 
			keys %symbols ;
	map { $originals_of_package_ref->{ $package }->{ $_->[0] } = $_->[1] }
			@subs ;
	map { *{ "$symbols{ $_->[0] }" } 
			  = _create_closure( $package, $_->[0], 
			  $scalar_code_ref ) }
			@subs ;

	return ;
	}

sub _create_closure {
	my ( $package, $symbol_name, $scalar_code_ref ) = @_ ;
	return sub {
		my $original = 
		  $originals_of_package_ref->{ $package }->{ $symbol_name } ;
		return ( wantarray ? sub { @_ } : $scalar_code_ref
		  )->( $original->( @_ ) ) ;
		} ;
	}

1;