From: Jesse Luehrs Date: Wed, 19 Aug 2009 03:21:51 +0000 (-0500) Subject: Revert "Merge branch 'master' into topic/symbol-manipulator" X-Git-Tag: 0.92_01~18 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=86e1c8d8dc9cc1fb9e927f5bcd283b6b672e8b9f;p=gitmo%2FClass-MOP.git Revert "Merge branch 'master' into topic/symbol-manipulator" This reverts commit c8fd7a1e8d0bd8db0b3d7ea745c491e2ce24decd, reversing changes made to 122aa3d6bbb1cc8f7bcb45254e2d7f62c8bb1e0e. Conflicts: lib/Class/MOP/Module.pm xs/Package.xs --- diff --git a/lib/Class/MOP/Class.pm b/lib/Class/MOP/Class.pm index d35f33e..0f80950 100644 --- a/lib/Class/MOP/Class.pm +++ b/lib/Class/MOP/Class.pm @@ -264,19 +264,13 @@ sub _check_metaclass_compatibility { my $current_meta = Class::MOP::get_metaclass_by_name($name); return if $current_meta ne $self; - if(my $isa_ref = $self->get_package_symbol('@ISA')){ - @{$isa_ref} = (); - } - - %{ $self->namespace } = (); - my ($serial_id) = ($name =~ /^$ANON_CLASS_PREFIX(\d+)/o); - - Class::MOP::remove_metaclass_by_name($name); - no strict 'refs'; + @{$name . '::ISA'} = (); + %{$name . '::'} = (); delete ${$ANON_CLASS_PREFIX}{$serial_id . '::'}; - return; + + Class::MOP::remove_metaclass_by_name($name); } } @@ -510,9 +504,10 @@ sub rebless_instance_away { sub superclasses { my $self = shift; + my $var_spec = { sigil => '@', type => 'ARRAY', name => 'ISA' }; if (@_) { my @supers = @_; - @{$self->get_package_symbol('@ISA', create => 1)} = @supers; + @{$self->get_package_symbol($var_spec)} = @supers; # NOTE: # on 5.8 and below, we need to call @@ -531,7 +526,7 @@ sub superclasses { $self->_check_metaclass_compatibility(); $self->_superclasses_updated(); } - @{$self->get_package_symbol('@ISA', create => 1)}; + @{$self->get_package_symbol($var_spec)}; } sub _superclasses_updated { diff --git a/lib/Class/MOP/Class/Immutable/Trait.pm b/lib/Class/MOP/Class/Immutable/Trait.pm index 29c79e8..a21d3a0 100644 --- a/lib/Class/MOP/Class/Immutable/Trait.pm +++ b/lib/Class/MOP/Class/Immutable/Trait.pm @@ -39,7 +39,6 @@ sub remove_method { _immutable_cannot_call() } sub add_attribute { _immutable_cannot_call() } sub remove_attribute { _immutable_cannot_call() } sub remove_package_symbol { _immutable_cannot_call() } -sub add_package_symbol { _immutable_cannot_call() } sub class_precedence_list { my $orig = shift; @@ -84,6 +83,15 @@ sub get_method_map { $self->{__immutable}{get_method_map} ||= $self->$orig; } +sub add_package_symbol { + my $orig = shift; + my $self = shift; + confess "Cannot add package symbols to an immutable metaclass" + unless ( caller(3) )[3] eq 'Class::MOP::Package::get_package_symbol'; + + $self->$orig(@_); +} + 1; __END__ diff --git a/lib/Class/MOP/Module.pm b/lib/Class/MOP/Module.pm index ae89002..e778812 100644 --- a/lib/Class/MOP/Module.pm +++ b/lib/Class/MOP/Module.pm @@ -33,12 +33,12 @@ sub _new { sub version { my $self = shift; - ${$self->get_package_symbol('$VERSION', create => 1)}; + ${$self->get_package_symbol({ sigil => '$', type => 'SCALAR', name => 'VERSION' })}; } sub authority { my $self = shift; - ${$self->get_package_symbol('$AUTHORITY', create => 1)}; + ${$self->get_package_symbol({ sigil => '$', type => 'SCALAR', name => 'AUTHORITY' })}; } sub identifier { @@ -61,8 +61,10 @@ sub _instantiate_module { Class::MOP::_is_valid_class_name($package_name) || confess "creation of $package_name failed: invalid package name"; - ${ $self->get_package_symbol('$VERSION', create => 1) } = $version; - ${ $self->get_package_symbol('$AUTHORITY', create => 1) } = $authority; + no strict 'refs'; + scalar %{ $package_name . '::' }; # touch the stash + ${ $package_name . '::VERSION' } = $version if defined $version; + ${ $package_name . '::AUTHORITY' } = $authority if defined $authority; return; } diff --git a/lib/Class/MOP/Package.pm b/lib/Class/MOP/Package.pm index c69ab02..47767c5 100644 --- a/lib/Class/MOP/Package.pm +++ b/lib/Class/MOP/Package.pm @@ -100,7 +100,6 @@ sub namespace { # we could just store a ref and it would # Just Work, but oh well :\ no strict 'refs'; - no warnings 'uninitialized'; \%{$_[0]->{'package'} . '::'} } @@ -141,9 +140,84 @@ sub _method_map { $_[0]->{'methods'} } # ... these functions have to touch the symbol table itself,.. yuk +sub add_package_symbol { + my ($self, $variable, $initial_value) = @_; + + my ($name, $sigil, $type) = ref $variable eq 'HASH' + ? @{$variable}{qw[name sigil type]} + : $self->_deconstruct_variable_name($variable); + + my $pkg = $self->{'package'}; + + no strict 'refs'; + no warnings 'redefine', 'misc', 'prototype'; + *{$pkg . '::' . $name} = ref $initial_value ? $initial_value : \$initial_value; +} + sub remove_package_glob { my ($self, $name) = @_; - delete $self->namespace->{$name}; + no strict 'refs'; + delete ${$self->name . '::'}{$name}; +} + +# ... these functions deal with stuff on the namespace level + +sub has_package_symbol { + my ( $self, $variable ) = @_; + + my ( $name, $sigil, $type ) + = ref $variable eq 'HASH' + ? @{$variable}{qw[name sigil type]} + : $self->_deconstruct_variable_name($variable); + + my $namespace = $self->namespace; + + return 0 unless exists $namespace->{$name}; + + my $entry_ref = \$namespace->{$name}; + if ( reftype($entry_ref) eq 'GLOB' ) { + if ( $type eq 'SCALAR' ) { + return defined( ${ *{$entry_ref}{SCALAR} } ); + } + else { + 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, $sigil, $type) = ref $variable eq 'HASH' + ? @{$variable}{qw[name sigil type]} + : $self->_deconstruct_variable_name($variable); + + my $namespace = $self->namespace; + + # FIXME + $self->add_package_symbol($variable) + 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; + } + } } sub remove_package_symbol { diff --git a/mop.h b/mop.h index 1b1960b..288c8ad 100644 --- a/mop.h +++ b/mop.h @@ -49,7 +49,6 @@ XS(mop_xs_simple_reader); extern SV *mop_method_metaclass; extern SV *mop_associated_metaclass; extern SV *mop_wrap; -extern SV *mop_namespace; UV mop_check_package_cache_flag(pTHX_ HV *stash); int mop_get_code_info (SV *coderef, char **pkg, char **name); diff --git a/xs/MOP.xs b/xs/MOP.xs index e185fa4..85c7659 100644 --- a/xs/MOP.xs +++ b/xs/MOP.xs @@ -3,7 +3,6 @@ SV *mop_method_metaclass; SV *mop_associated_metaclass; SV *mop_wrap; -SV *mop_namespace; static bool find_method (const char *key, STRLEN keylen, SV *val, void *ud) @@ -30,7 +29,6 @@ BOOT: mop_method_metaclass = newSVpvs("method_metaclass"); mop_wrap = newSVpvs("wrap"); mop_associated_metaclass = newSVpvs("associated_metaclass"); - mop_namespace = newSVpvs("namespace"); MOP_CALL_BOOT (boot_Class__MOP__Package); MOP_CALL_BOOT (boot_Class__MOP__Attribute); diff --git a/xs/Package.xs b/xs/Package.xs index 2ab8c79..362c407 100644 --- a/xs/Package.xs +++ b/xs/Package.xs @@ -1,165 +1,6 @@ - #include "mop.h" static void -mop_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) { - - - if(SvROK(variable) && SvTYPE(SvRV(variable)) == SVt_PVHV){ - /* e.g. variable = { type => "SCALAR", name => "foo" } */ - HV* const hv = (HV*)SvRV(variable); - SV** svp; - STRLEN len; - const char* pv; - - svp = hv_fetchs(hv, "name", FALSE); - if(!(svp && SvOK(*svp))){ - croak("You must pass a variable name"); - } - *var_name = SvPV_const(*svp, len); - *var_name_len = len; - if(len < 1){ - croak("You must pass a variable name"); - } - - svp = hv_fetchs(hv, "type", FALSE); - if(!(svp && SvOK(*svp))) { - croak("You must pass a variable type"); - } - pv = SvPV_nolen_const(*svp); - if(strEQ(pv, "SCALAR")){ - *type = SVt_PV; /* for all the type of scalars */ - } - else if(strEQ(pv, "ARRAY")){ - *type = SVt_PVAV; - } - else if(strEQ(pv, "HASH")){ - *type = SVt_PVHV; - } - else if(strEQ(pv, "CODE")){ - *type = SVt_PVCV; - } - else if(strEQ(pv, "GLOB")){ - *type = SVt_PVGV; - } - else if(strEQ(pv, "IO")){ - *type = SVt_PVIO; - } - else{ - croak("I do not recognize that type '%s'", pv); - } - *type_name = pv; - } - else { - 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]); - } - } -} - -static GV* -mop_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 = mop_call0(aTHX_ self, mop_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 = mop_call0(aTHX_ self, KEY_FOR(name)); - - if(!SvOK(package_name)){ - croak("name() did not return a defined value"); - } - - 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); -} - -static SV* -mop_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; -} - - -static void mop_update_method_map(pTHX_ SV *const self, SV *const class_name, HV *const stash, HV *const map) { const char *const class_name_pv = HvNAME(stash); /* must be HvNAME(stash), not SvPV_nolen_const(class_name) */ @@ -307,123 +148,3 @@ get_method_map(self) BOOT: INSTALL_SIMPLE_READER_WITH_KEY(Package, name, package); - - -SV* -add_package_symbol(SV* self, SV* variable, SV* ref = &PL_sv_undef) -PREINIT: - svtype type; - const char* type_name; - const char* var_name; - STRLEN var_name_len; - GV* gv; -CODE: - mop_deconstruct_variable_name(aTHX_ variable, &var_name, &var_name_len, &type, &type_name); - gv = mop_get_gv(aTHX_ self, type, var_name, var_name_len, GV_ADDMULTI); - - if(SvOK(ref)){ /* add_package_symbol with a value */ - if(type == SVt_PV){ - if(!SvROK(ref)){ - ref = newRV_noinc(newSVsv(ref)); - sv_2mortal(ref); - } - } - else if(!(SvROK(ref) && SvTYPE(SvRV(ref)) == type)){ - croak("You must pass a reference of %s for the value of %s", type_name, GvNAME(CvGV(cv))); - } - - if(type == SVt_PVCV && GvCV(gv)){ - /* XXX: clear it before redefinition */ - SvREFCNT_dec(GvCV(gv)); - GvCV(gv) = NULL; - } - sv_setsv_mg((SV*)gv, ref); /* magical assignment into type glob (*glob = $ref) */ - - if(type == SVt_PVCV){ /* name a subroutine */ - CV* const subr = (CV*)SvRV(ref); - if(CvANON(subr) - && CvGV(subr) - && isGV(CvGV(subr)) - && strEQ(GvNAME(CvGV(subr)), "__ANON__")){ - - /* NOTE: - A gv "has-a" cv, but a cv refers to a gv as a (pseudo) weak ref. - so we can replace CvGV with no SvREFCNT_inc/dec. - */ - CvGV(subr) = gv; - CvANON_off(subr); - } - } - RETVAL = ref; - SvREFCNT_inc_simple_void_NN(ref); - } - else{ - SV* const sv = mop_gv_elem(aTHX_ gv, type, GV_ADDMULTI); - RETVAL = (sv && GIMME_V != G_VOID) ? newRV_inc(sv) : &PL_sv_undef; - } -OUTPUT: - RETVAL - -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: - mop_deconstruct_variable_name(aTHX_ variable, &var_name, &var_name_len, &type, &type_name); - gv = mop_get_gv(aTHX_ self, type, var_name, var_name_len, 0); - if(type == SVt_PV){ - /* In SCALAR, for backword compatibility, - defined(${*gv{SCALAR}}) instead of defined(*gv{SCALAR}) */ - SV* const sv = mop_gv_elem(aTHX_ gv, type, FALSE); - RETVAL = (sv && SvOK(sv)) ? TRUE : FALSE; - } - else{ - /* Otherwise, defined(*gv{TYPE}) */ - RETVAL = mop_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: - if(items > 2){ /* parse options */ - I32 i; - if((items % 2) != 0){ - croak("Odd number of arguments for get_package_symbol()"); - } - for(i = 2; i < items; i += 2){ - SV* const opt = ST(i); - SV* const val = ST(i+1); - if(strEQ(SvPV_nolen_const(opt), "create")){ - if(SvTRUE(val)){ - flags |= GV_ADDMULTI; - } - else{ - flags &= ~GV_ADDMULTI; - } - } - else{ - warn("Unknown option \"%"SVf"\" for get_package_symbol()", opt); - } - } - } - mop_deconstruct_variable_name(aTHX_ variable, &var_name, &var_name_len, &type, &type_name); - gv = mop_get_gv(aTHX_ self, type, var_name, var_name_len, flags); - sv = mop_gv_elem(aTHX_ gv, type, FALSE); - - RETVAL = sv ? newRV_inc(sv) : &PL_sv_undef; -OUTPUT: - RETVAL