File: alias.pm

package info (click to toggle)
libkavorka-perl 0.036-2
  • links: PTS, VCS
  • area: main
  • in suites: stretch
  • size: 712 kB
  • ctags: 213
  • sloc: perl: 2,865; makefile: 25
file content (62 lines) | stat: -rw-r--r-- 1,230 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
use 5.014;
use strict;
use warnings;

package Kavorka::TraitFor::Parameter::alias;

our $AUTHORITY = 'cpan:TOBYINK';
our $VERSION   = '0.036';

use Moo::Role;

use constant HAS_REFALIASING => ($] >= 5.022);

around _injection_assignment => sub
{
	my $next = shift;
	my $self = shift;
	my ($sig, $var, $val) = @_;
	
	if ($self->kind eq 'my')
	{
		my $format;
		if (HAS_REFALIASING) {
			$format = <<'EOF';
my %s;
{
	use experimental 'refaliasing';
	\%s = \do { %s };
};
EOF
			return sprintf($format, ($var) x 2, $val);
		}
		else {
			require Data::Alias;
			return sprintf('Data::Alias::alias(my %s = do { %s });', $var, $val);
		}
	}
	elsif ($self->kind eq 'our')
	{
		(my $glob = $var) =~ s/\A./*/;
		return sprintf('our %s; local %s = \\do { %s };', $var, $glob, $val);
	}
	else
	{
		(my $glob = $var) =~ s/\A./*/;
		return sprintf('local %s = \\do { %s };', $glob, $val);
	}
};

after sanity_check => sub
{
	my $self = shift;
	
	my $traits = $self->traits;
	my $name   = $self->name;
	
	croak("Parameter $name cannot be an alias and coerce") if $traits->{coerce};
	croak("Parameter $name cannot be an alias and a copy") if $traits->{copy};
	croak("Parameter $name cannot be an alias and locked") if $traits->{locked};
};

1;