Toby Inkster avatar Toby Inkster committed 5f04718

Add module for generating class attribute accessors

Comments (0)

Files changed (2)

lib/Method/Generate/Accessor/Classy.pm

+package Method::Generate::Accessor::Classy;
+
+use 5.008;
+use strict;
+use warnings;
+no warnings qw( void once uninitialized numeric );
+
+use B 'perlstring';
+
+use base qw(Method::Generate::Accessor);
+
+sub generate_method
+{
+	my ($self, $into, $name, $spec, $quote_opts) = @_;
+	local $Method::Generate::Accessor::CAN_HAZ_XS = 0; # sorry
+	$spec->{_classy} ||= $into;
+	$self->SUPER::generate_method($into, $name, $spec, $quote_opts);
+}
+
+sub _generate_simple_get
+{
+	my ($self, $me, $name, $spec) = @_;
+	my $classy = $spec->{_classy};
+	"\$$classy\::__ClassAttributeValues{${\perlstring $name}}";
+}
+
+sub _generate_core_set
+{
+	my ($self, $me, $name, $spec, $value) = @_;
+	my $classy = $spec->{_classy};
+	"\$$classy\::__ClassAttributeValues{${\perlstring $name}} = $value";
+}
+
+sub _generate_simple_has
+{
+	my ($self, $me, $name, $spec) = @_;
+	my $classy = $spec->{_classy};
+	"exists \$$classy\::__ClassAttributeValues{${\perlstring $name}}";
+}
+
+sub _generate_simple_clear
+{
+	my ($self, $me, $name, $spec) = @_;
+	my $classy = $spec->{_classy};
+	"delete \$$classy\::__ClassAttributeValues{${\perlstring $name}}";
+}
+
+1;
+
+use strict;
+use warnings;
+use Test::More;
+
+use Method::Generate::Accessor::Classy;
+use Sub::Defer;
+use constant Gen => 'Method::Generate::Accessor::Classy';
+use constant Pkg => 'Local::Test::Package';
+
+my $generator = Gen->new;
+isa_ok $generator, 'Method::Generate::Accessor';
+
+$generator->generate_method(
+	Pkg,
+	foo => {
+		is        => 'rw',
+		writer    => 'set_foo',
+		reader    => 'get_foo',
+		accessor  => 'access_foo',
+		predicate => 'has_foo',
+		clearer   => 'clear_foo',
+		handles   => [qw/ bar baz /],
+	},
+);
+
+my @methods = qw/
+	set_foo get_foo access_foo has_foo clear_foo
+	_assert_foo bar baz
+/;
+
+can_ok Pkg, @methods;
+
+Pkg->set_foo('42');
+ok Pkg->has_foo;
+is(Pkg->get_foo, 42);
+Pkg->clear_foo;
+ok not Pkg->has_foo;
+Pkg->access_foo('Local::Bottoms');
+is(Pkg->access_foo, 'Local::Bottoms');
+
+ok not eval { Pkg->baz };
+like $@, qr{^Can't locate object method "baz" via package "Local::Bottoms"};
+
+done_testing;
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.