view release on metacpan or  search on metacpan

lib/Aion/Meta/FeatureConstruct.pm  view on Meta::CPAN

END
		writer => <<'END',
package %(pkg)s {
	sub %(writer_name)s {
		my ($self, $val) = @_;
		%(write)s
		%(selfret)s
	}
}
END
		predicate => <<'END',
package %(pkg)s {
	sub %(predicate_name)s {
		my ($self) = @_;
		%(has)s
	}
}
END
		clearer => <<'END',
package %(pkg)s {
	sub %(clearer_name)s {
		my ($self) = @_;
		if (%(has)s) {
			%(cleaner)s%(clear)s
		}
		%(clearret)s
	}
}
END
		accessor_name  => '%(name)s',
		reader_name    => '_get_%(name)s',
		writer_name    => '_set_%(name)s',
		attr           => '',
		write          => '%(preset)s%(set)s%(trigger)s',
		read           => '%(access)s%(getvar)s%(release)s%(ret)s',
		setter         => '%(write)s',
		getter         => '%(read)s',
		initer         => "%(initvar)s%(write)s",
		init_arg       => '%(name)s',
		initvar        => 'my $val = delete $value{%(init_arg)s};',
		not_specified  => '',
		preset         => '',
		set            => '$self->{%(name)s} = $val;',
		trigger        => '',
		selfret        => '$self',
		access         => '',
		getvar         => '%(get)s',
		get            => '$self->{%(name)s}',
		release        => '',
		ret            => '',
		predicate_name => 'has_%(name)s',
		has            => 'exists $self->{%(name)s}',
		clearer_name   => 'clear_%(name)s',
		clear          => 'delete $self->{%(name)s}',
		clearret       => '$self',
		cleaner        => '',
		weaken         => 'Scalar::Util::weaken(%(get)s);',
	}, ref $cls || $cls;
}

sub add_attr	{ shift->_expand('attr',	@_) }
sub add_preset  { shift->_expand('preset',  @_) }
sub add_trigger { shift->_expand('trigger', @_) }
sub add_cleaner { shift->_expand('cleaner', @_) }
sub add_access  { shift->_expand('access',  @_) }
sub add_release {
	my $self = shift;
	@$self{qw/getvar ret/} = ('my $val = %(get)s;', '$val') if $self->{ret} eq '';
	$self->_expand('release', @_)
}

sub _expand(@) {
	my ($self, $key, $code, $shift) = @_;

	if(ref $self->{$key}) {
		if($shift) { unshift @{$self->{$key}}, $code }
		else { push @{$self->{$key}}, $code }
	}
	elsif ($self->{$key} eq '') {
		$self->{$key} = $code;
	}
	else {
		$self->{$key} = $shift? [$code, $self->{$key}]: [$self->{$key}, $code];
	}
	
	$self
}

for my $key (qw/initializer destroyer accessor writer reader predicate clearer/) {
	*$key = sub {
		my ($self) = @_;
		_idents($self->_resolv($self->{$key}))
	}
}

sub _resolv {
	my ($self, $s) = @_;
	$s = join '', @$s if ref $s;
	$s =~ s{%\((\w*)\)s}{
		die "has: not construct `$1`\!" unless exists $self->{$1};
		$self->_resolv($self->{$1})
	}ge;
	$s
}

sub _idents {
	local ($_) = @_;
	my $indent;
	s{(^\t*)|;[\t ]*(\S)}{
		if(defined $1) { $indent = $1 } else { ";\n$indent$2" }
	}gme;
	$_
}

1;

__END__

=encoding utf-8

=head1 NAME

Aion::Meta::FeatureConstruct - accessor, predicate, initializer and clearer

=head1 SYNOPSIS

	use Aion::Meta::FeatureConstruct;
	
	our $construct = Aion::Meta::FeatureConstruct->new('My::Package', 'my_feature');
	
	$construct->add_attr(':lvalue');