File Coverage

blib/lib/Acme/Lvalue.pm

Criterion	Covered	Total	%
statement	40	45	88.8
branch	3	6	50.0
condition			n/a
subroutine	12	14	85.7
pod			n/a
total	55	65	84.6

package Acme::Lvalue;

use warnings;
use strict;

use v5.16.0;  # earliest release with #51408 fixed

*VERSION = \'0.03';

{
	package Acme::Lvalue::Proxy;

	sub TIESCALAR {
		my ($class, $ref, $func, $cnuf) = @_;
		bless [$ref, $func, $cnuf], $class
	}

	sub FETCH {
		my ($self) = @_;
		$self->[1]->(${$self->[0]})
	}

	sub STORE {
		my ($self, $val) = @_;
		my $ref = $self->[0];
		$$ref = $self->[2]->($val, $$ref);
	}

	sub UNTIE {}
	sub DESTROY {}
}

use Math::Trig;
use Carp qw(croak);

sub _export {
	my ($where, $what, $how, $woh) = @_;
	my $fun = sub ($) :lvalue {
		tie my $proxy, 'Acme::Lvalue::Proxy', \$_[0], $how, $woh;
		$proxy
	};
	no strict 'refs';
	*{$where . '::' . $what} = $fun;
}

our %builtins = map +($_->[0] => [eval "sub {scalar $_->[0] \$_[0]}", $_->[1]]),
	[chr       => sub { ord $_[0] }],
	[cos       => sub { acos $_[0] }],
	[defined   =>
		sub {
			$_[0]
				? defined $_[1]
					? $_[1]
					: 1
				: undef
		}
	],
	[exp       => sub { log $_[0] }],
	[hex       => sub { sprintf '%x', $_[0] }],
	[length    =>
		sub {
			my ($n, $x) = @_;
			my $l = length $x;
			$n <= $l
				? substr $x, 0, $n
				: $x . "\0" x ($n - $l)
		}
	],
	[log       => sub { exp $_[0] }],
	[oct       => sub { sprintf '%o', $_[0] }],
	[ord       => sub { chr $_[0] }],
	[quotemeta => sub { $_[0] =~ s/\\(.)/$1/sgr }],
	[reverse   => sub { scalar reverse $_[0] }],
	[sin       => sub { asin $_[0] }],
	[sqrt      => sub { my $x = shift; $x * $x }],
;

sub import {
	my $class = shift;
	my $caller = caller;

	for my $item (@_) {
		if (ref $item) {
			_export $caller, @$item;
		} elsif ($item eq ':builtins') {
			for my $f (keys %builtins) {
				_export $caller, $f, @{$builtins{$f}};
			}
		} elsif ($builtins{$item}) {
			_export $caller, $item, @{$builtins{$item}};
		} else {
			croak qq{"$item" is not exported by the $class module};
		}
	}
}

'ok'
__END__