view release on metacpan or  search on metacpan

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

}

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');
	
	$construct->accessor # -> << 'END'
	package My::Package {
		sub my_feature:lvalue {
			if (@_>1) {
				my ($self, $val) = @_;
				$self->{my_feature} = $val;
				$self
			} else {
				my ($self) = @_;
				$self->{my_feature}
			}
		}
	}
	END

=head1 DESCRIPTION

Designed for constructing getters/setters from pieces of code.

=head1 SUBROUTINES

=head2 new ($pkg, $name)

Constructor.

=head2 pkg

The package to which the attribute belongs. Getter.

	$::construct->pkg # -> "My::Package"

=head2 name

Attribute name. Getter.

	$::construct->name # -> "my_feature"

=head2 write

Code for writing the value. Getter.

	$::construct->write # \> %(preset)s%(set)s%(trigger)s

=head2 read

Code to read the value. Getter.