view release on metacpan or  search on metacpan

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

package Aion::Meta::FeatureConstruct;

use common::sense;

use Aion::Meta::Util qw//;

Aion::Meta::Util::create_getters(qw/
	pkg name
	write read
	getvar ret
/);
Aion::Meta::Util::create_accessors(qw/
    init_arg
	set get has clear weaken
	accessor_name reader_name writer_name predicate_name clearer_name
	initer not_specified
	getter setter selfret
/);

#  Конструктор
sub new {
	my ($cls, $pkg, $name) = @_;

	bless {
		pkg => $pkg,
		name => $name,
		initializer => <<'END',
		if (exists $value{%(init_arg)s}) {
			%(initer)s
		}%(not_specified)s
END
		destroyer => <<'END',
		if (%(has)s) {
			eval {
				%(cleaner)s
			};
			warn $@ if $@;
		}
END
		accessor => <<'END',
package %(pkg)s {
	sub %(accessor_name)s%(attr)s {
		if (@_>1) {
			my ($self, $val) = @_;
			%(setter)s
			%(selfret)s
		} else {
			my ($self) = @_;
			%(getter)s
		}
	}
}
END
		reader => <<'END',
package %(pkg)s {
	sub %(reader_name)s {
		my ($self) = @_;
		%(read)s
	}
}
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__

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

=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.

	$::construct->read # \> %(access)s%(getvar)s%(release)s%(ret)s

=head2 getvar

Variable to receive the value. Getter.

	$::construct->getvar # \> %(get)s

=head2 ret

Value return code. Getter.

	$::construct->ret # -> ''

=head2 init_arg

The key is in the initialization hash. Accessor.

	$::construct->init_arg # \> %(name)s

=head2 set

Code for setting the value to the object hash. Accessor.

	$::construct->set # \> $self->{%(name)s} = $val;

=head2 get

Code for getting a value from an object hash. Accessor.

	$::construct->get # \> $self->{%(name)s}

=head2 has

Code for checking the existence of a value. Accessor.

	$::construct->has # \> exists $self->{%(name)s}

=head2 clear

Code for deleting a value. Accessor.

	$::construct->clear # \> delete $self->{%(name)s}

=head2 weaken

Link weakening code. Accessor.

	$::construct->weaken # \> Scalar::Util::weaken(%(get)s);

=head2 accessor_name

The name of the accessor method. Accessor.

	$::construct->accessor_name # \> %(name)s

=head2 reader_name

Reader method name. Accessor.

	$::construct->reader_name # \> _get_%(name)s

=head2 writer_name

Writer method name. Accessor.

	$::construct->writer_name # \> _set_%(name)s

=head2 predicate_name

Predicate method name. Accessor.

	$::construct->predicate_name # \> has_%(name)s

=head2 clearer_name

The name of the cleanser method. Accessor.

	$::construct->clearer_name # \> clear_%(name)s

=head2 initer

Attribute initialization code. Accessor.

	$::construct->initer # \> %(initvar)s%(write)s

=head2 not_specified

Initialization code if no value is specified. Accessor.

	$::construct->not_specified # -> ''

=head2 getter

Getter code in the accessor. Accessor.

	$::construct->getter # \> %(read)s

=head2 setter

Setter code in the accessor. Default: '%(write)s'.

	$::construct->setter # \> %(write)s

=head2 selfret

Return code from setter. Accessor.

	$::construct->selfret # \> $self