local $@;
my $err;
+
$err = eval { require Sub::Name; 1; } ? undef : do {
delete $INC{'Sub/Name.pm'}; # because older perls suck
$@;
: sub () { 0 }
;
+
+ *__CAG_UNSTABLE_DOLLARAT = ($] < '5.013002')
+ ? sub () { 1 }
+ : sub () { 0 }
+ ;
+
};
# Autodetect unless flag supplied
rw => {
xs_call => 'accessors',
pp_code => sub {
- my $set = "set_$_[1]";
- my $get = "get_$_[1]";
- my $field = $_[2];
+ my $set = "set_$_[0]";
+ my $get = "get_$_[0]";
+ my $field = $_[1];
$field =~ s/'/\\'/g;
"
ro => {
xs_call => 'getters',
pp_code => sub {
- my $get = "get_$_[1]";
- my $field = $_[2];
+ my $get = "get_$_[0]";
+ my $field = $_[1];
$field =~ s/'/\\'/g;
"
? shift->$get('$field')
: do {
my \$caller = caller;
- Carp::croak(\"'\$caller' cannot alter the value of '$field' on \".
- \"objects of class '$_[0]'\");
+ my \$class = ref \$_[0] || \$_[0];
+ Carp::croak(\"'\$caller' cannot alter the value of '$field' \".
+ \"(read-only attributes of class '\$class')\");
}
"
},
wo => {
xs_call => 'setters',
pp_code => sub {
- my $set = "set_$_[1]";
- my $field = $_[2];
+ my $set = "set_$_[0]";
+ my $field = $_[1];
$field =~ s/'/\\'/g;
"
? shift->$set('$field', \@_)
: do {
my \$caller = caller;
- Carp::croak(\"'\$caller' cannot access the value of '$field' on \".
- \"objects of class '$_[0]'\");
+ my \$class = ref \$_[0] || \$_[0];
+ Carp::croak(\"'\$caller' cannot access the value of '$field' \".
+ \"(write-only attributes of class '\$class')\");
}
"
},
$class = $c;
}
+
# When installing an XSA simple accessor, we need to make sure we are not
# short-circuiting a (compile or runtime) get_simple/set_simple override.
# What we do here is install a lazy first-access check, which will decide
die sprintf( "Class::XSAccessor requested but not available:\n%s\n", __CAG_NO_CXSA )
if __CAG_NO_CXSA;
+
sub { sub {
my $current_class = Scalar::Util::blessed( $_[0] ) || $_[0];
# no Sub::Name - just install the coderefs directly (compiling every time)
elsif (__CAG_NO_SUBNAME) {
- my $pp_code = $maker_templates->{$type}{pp_code}->($class, $group, $field);
- eval "sub ${class}::${methname} { $pp_code }; 1" or die $@;
+ my $src = $accessor_maker_cache->{source}{$type}{$group}{$field} ||=
+ $maker_templates->{$type}{pp_code}->($group, $field);
+
+ no warnings 'redefine';
+ local $@ if __CAG_UNSTABLE_DOLLARAT;
+ eval "sub ${class}::${methname}{$src}";
+
undef; # so that no attempt will be made to install anything
}
# a coderef generator with a variable pad (returns a fresh cref on every invocation)
- # also since it is much simpler than the xs one it needs less cache-keys
else {
- ($accessor_maker_cache->{pp}{$field}{$type} ||= do {
- my $pp_code = $maker_templates->{$type}{pp_code}->($class, $group, $field);
- eval "sub { my \$dummy; sub { \$dummy if 0; $pp_code } }" or die $@;
+ ($accessor_maker_cache->{pp}{$group}{$field}{$type} ||= do {
+ my $src = $accessor_maker_cache->{source}{$type}{$group}{$field} ||=
+ $maker_templates->{$type}{pp_code}->($group, $field);
+
+ local $@ if __CAG_UNSTABLE_DOLLARAT;
+ eval "sub { my \$dummy; sub { \$dummy if 0; $src } }" or die $@;
})->()
}
};