From: gfx Date: Mon, 7 Dec 2009 04:52:04 +0000 (+0900) Subject: Remove has_package_symbol and add_package_symbol X-Git-Tag: 0.43~14 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=gitmo%2FMouse.git;a=commitdiff_plain;h=ca861dd989ddc9868e5c69a39844e1e888bb9508 Remove has_package_symbol and add_package_symbol This is introduced for compatibility with Moose, but it seems useless in Mouse. --- diff --git a/lib/Mouse/PurePerl.pm b/lib/Mouse/PurePerl.pm index 9b072ee..e77f312 100644 --- a/lib/Mouse/PurePerl.pm +++ b/lib/Mouse/PurePerl.pm @@ -204,78 +204,6 @@ sub add_method { return; } -my %SIGIL_MAP = ( - '$' => 'SCALAR', - '@' => 'ARRAY', - '%' => 'HASH', - '&' => 'CODE', - '*' => 'GLOB', -); - -sub _deconstruct_variable_name { - my($self, $variable) = @_; - - (defined $variable) - || $self->throw_error("You must pass a variable name"); - - my $sigil = substr($variable, 0, 1, ''); - - (defined $sigil) - || $self->throw_error("The variable name must include a sigil"); - - (exists $SIGIL_MAP{$sigil}) - || $self->throw_error("I do not recognize that sigil '$sigil'"); - - return ($variable, $SIGIL_MAP{$sigil}); -} - -sub has_package_symbol { - my($self, $variable) = @_; - - my($name, $type) = $self->_deconstruct_variable_name($variable); - - my $namespace = $self->namespace; - - return 0 unless exists $namespace->{$name}; - - my $entry_ref = \$namespace->{$name}; - if ( ref($entry_ref) eq 'GLOB' ) { - return defined( *{$entry_ref}{$type} ); - } - else { - # a symbol table entry can be -1 (stub), string (stub with prototype), - # or reference (constant) - return $type eq 'CODE'; - } -} - -sub get_package_symbol { - my ($self, $variable) = @_; - - my($name, $type) = $self->_deconstruct_variable_name($variable); - - my $namespace = $self->namespace; - - return undef - unless exists $namespace->{$name}; - - my $entry_ref = \$namespace->{$name}; - - if ( ref($entry_ref) eq 'GLOB' ) { - return *{$entry_ref}{$type}; - } - else { - if ( $type eq 'CODE' ) { - no strict 'refs'; - return \&{ $self->name . '::' . $name }; - } - else { - return undef; - } - } -} - - package Mouse::Meta::Class; diff --git a/t/001_mouse/062-package-symbol.t b/t/001_mouse/062-package-symbol.t deleted file mode 100644 index b9b3d0b..0000000 --- a/t/001_mouse/062-package-symbol.t +++ /dev/null @@ -1,38 +0,0 @@ -#!perl -use strict; -use warnings; - -use Test::More; - -{ - package Foo; - use Mouse; - - sub code { 42 } - - our $scalar = 'bar'; - - our %hash = (a => 'b'); - - our @array = ('foo'); -} - -my $meta = Foo->meta; - -foreach my $sym(qw(&code $scalar %hash @array)){ - ok $meta->has_package_symbol($sym), "has_package_symbol('$sym')"; -} - -ok !$meta->has_package_symbol('$hogehoge'); -ok !$meta->has_package_symbol('%array'); - -is $meta->get_package_symbol('&code'), \&Foo::code; -is $meta->get_package_symbol('$scalar'), \$Foo::scalar; -is $meta->get_package_symbol('%hash'), \%Foo::hash; -is $meta->get_package_symbol('@array'), \@Foo::array; - -is $meta->get_package_symbol('@hogehoge'), undef; -is $meta->get_package_symbol('%array'), undef; -is $meta->get_package_symbol('&hash'), undef; - -done_testing; diff --git a/xs-src/Mouse.xs b/xs-src/Mouse.xs index 6ae3817..0a94ec8 100644 --- a/xs-src/Mouse.xs +++ b/xs-src/Mouse.xs @@ -335,122 +335,6 @@ mouse_initialize_metaclass(pTHX_ SV* const klass) { return meta; } - -/* copied from Class-MOP/topic/symbol-manipluator */ -static GV* -mouse_get_gv(pTHX_ SV* const self, svtype const type, const char* const var_name, I32 const var_name_len, I32 const flags){ - SV* package_name; - STRLEN len; - const char* pv; - - if(!flags){ - SV* const ns = mcall0(self, mouse_namespace); - GV** gvp; - if(!(SvROK(ns) && SvTYPE(SvRV(ns)) == SVt_PVHV)){ - croak("namespace() did not return a hash reference"); - } - gvp = (GV**)hv_fetch((HV*)SvRV(ns), var_name, var_name_len, FALSE); - if(gvp && isGV_with_GP(*gvp)){ - return *gvp; - } - } - - package_name = get_slot(self, mouse_package); - - if(!(package_name && SvOK(package_name))){ - croak("No package name defined"); - } - - pv = SvPV_const(package_name, len); - - return gv_fetchpvn_flags(Perl_form(aTHX_ "%s::%s", pv, var_name), (len + var_name_len + 2), flags, type); -} - -/* copied from Class-MOP/topic/symbol-manipluator */ -static SV* -mouse_gv_elem(pTHX_ GV* const gv, svtype const type, I32 const add){ - SV* sv; - - if(!gv){ - return NULL; - } - - assert(isGV_with_GP(gv)); - - switch(type){ - case SVt_PVAV: - sv = (SV*)(add ? GvAVn(gv) : GvAV(gv)); - break; - case SVt_PVHV: - sv = (SV*)(add ? GvHVn(gv) : GvHV(gv)); - break; - case SVt_PVCV: - sv = (SV*)GvCV(gv); - break; - case SVt_PVIO: - sv = (SV*)(add ? GvIOn(gv) : GvIO(gv)); - break; - case SVt_PVGV: - sv = (SV*)gv; - break; - default: /* SCALAR */ - sv = add ? GvSVn(gv) : GvSV(gv); - break; - } - - return sv; -} - -/* copied from Class-MOP/topic/symbol-manipluator */ -static void -mouse_deconstruct_variable_name(pTHX_ SV* const variable, - const char** const var_name, STRLEN* const var_name_len, - svtype* const type, - const char** const type_name) { - - STRLEN len; - const char* pv; - - /* e.g. variable = '$foo' */ - - if(!SvOK(variable)) { - croak("You must pass a variable name"); - } - pv = SvPV_const(variable, len); - if(len < 2){ - croak("You must pass a variable name including a sigil"); - } - - *var_name = pv + 1; - *var_name_len = len - 1; - - switch(pv[0]){ - case '$': - *type = SVt_PV; /* for all the types of scalars */ - *type_name = "SCALAR"; - break; - case '@': - *type = SVt_PVAV; - *type_name = "ARRAY"; - break; - case '%': - *type = SVt_PVHV; - *type_name = "HASH"; - break; - case '&': - *type = SVt_PVCV; - *type_name = "CODE"; - break; - case '*': - *type = SVt_PVGV; - *type_name = "GLOB"; - break; - default: - croak("I do not recognize that sigil '%c'", pv[0]); - } -} - - MODULE = Mouse PACKAGE = Mouse PROTOTYPES: DISABLE @@ -547,41 +431,6 @@ CODE: } } -bool -has_package_symbol(SV* self, SV* variable) -PREINIT: - svtype type; - const char* type_name; - const char* var_name; - STRLEN var_name_len; - GV* gv; -CODE: - mouse_deconstruct_variable_name(aTHX_ variable, &var_name, &var_name_len, &type, &type_name); - gv = mouse_get_gv(aTHX_ self, type, var_name, var_name_len, 0); - RETVAL = mouse_gv_elem(aTHX_ gv, type, FALSE) ? TRUE : FALSE; -OUTPUT: - RETVAL - -SV* -get_package_symbol(SV* self, SV* variable) -PREINIT: - svtype type; - const char* type_name; - const char* var_name; - STRLEN var_name_len; - I32 flags = 0; - GV* gv; - SV* sv; -CODE: - mouse_deconstruct_variable_name(aTHX_ variable, &var_name, &var_name_len, &type, &type_name); - gv = mouse_get_gv(aTHX_ self, type, var_name, var_name_len, flags); - sv = mouse_gv_elem(aTHX_ gv, type, FALSE); - - RETVAL = sv ? newRV_inc(sv) : &PL_sv_undef; -OUTPUT: - RETVAL - - MODULE = Mouse PACKAGE = Mouse::Meta::Class BOOT: