| File | /usr/local/share/perl/5.10.0/Package/Stash.pm |
| Statements Executed | 15912 |
| Total Time | 0.0398491999999999 seconds |
| Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
|---|---|---|---|---|---|
| 681 | 2 | 2 | 16.6ms | 23.4ms | Package::Stash::add_package_symbol |
| 917 | 2 | 2 | 12.1ms | 21.1ms | Package::Stash::get_package_symbol |
| 947 | 3 | 2 | 3.56ms | 3.56ms | Package::Stash::namespace |
| 397 | 1 | 1 | 2.89ms | 4.01ms | Package::Stash::_valid_for_type |
| 681 | 1 | 1 | 2.69ms | 2.69ms | Package::Stash::name |
| 73 | 1 | 1 | 1.02ms | 1.02ms | Package::Stash::new |
| 104 | 1 | 1 | 592µs | 3.63ms | Package::Stash::get_or_add_package_symbol |
| 14 | 1 | 1 | 235µs | 491µs | Package::Stash::has_package_symbol |
| 18 | 2 | 1 | 185µs | 185µs | Package::Stash::_deconstruct_variable_name |
| 0 | 0 | 0 | 0s | 0s | Package::Stash::BEGIN |
| 0 | 0 | 0 | 0s | 0s | Package::Stash::list_all_package_symbols |
| 0 | 0 | 0 | 0s | 0s | Package::Stash::remove_package_glob |
| 0 | 0 | 0 | 0s | 0s | Package::Stash::remove_package_symbol |
| Line | Stmts. | Exclusive Time | Avg. | Code |
|---|---|---|---|---|
| 1 | package Package::Stash; | |||
| 2 | BEGIN { | |||
| 3 | 1 | 1µs | 1µs | $Package::Stash::VERSION = '0.08'; |
| 4 | 1 | 22µs | 22µs | } |
| 5 | 3 | 29µs | 10µs | use strict; # spent 14µs making 1 call to strict::import |
| 6 | 3 | 29µs | 10µs | use warnings; # spent 22µs making 1 call to warnings::import |
| 7 | # ABSTRACT: routines for manipulating stashes | |||
| 8 | ||||
| 9 | 3 | 31µs | 10µs | use Carp qw(confess); # spent 36µs making 1 call to Exporter::import |
| 10 | 3 | 59µs | 20µs | use Scalar::Util qw(reftype); # spent 30µs making 1 call to Exporter::import |
| 11 | ||||
| 12 | ||||
| 13 | # spent 1.02ms within Package::Stash::new which was called 73 times, avg 14µs/call:
# 73 times (1.02ms+0s) by Class::MOP::Package::_package_stash at line 94 of /usr/local/lib/perl/5.10.0/Class/MOP/Package.pm, avg 14µs/call | |||
| 14 | 73 | 47µs | 649ns | my $class = shift; |
| 15 | 73 | 127µs | 2µs | my ($package) = @_; |
| 16 | 73 | 18µs | 248ns | my $namespace; |
| 17 | { | |||
| 18 | 76 | 591µs | 8µs | no strict 'refs'; # spent 23µs making 1 call to strict::unimport |
| 19 | # supposedly this caused a bug in earlier perls, but I can't reproduce | |||
| 20 | # it, so re-enabling the caching | |||
| 21 | 73 | 281µs | 4µs | $namespace = \%{$package . '::'}; |
| 22 | } | |||
| 23 | 73 | 320µs | 4µs | return bless { |
| 24 | 'package' => $package, | |||
| 25 | 'namespace' => $namespace, | |||
| 26 | }, $class; | |||
| 27 | } | |||
| 28 | ||||
| 29 | ||||
| 30 | # spent 2.69ms within Package::Stash::name which was called 681 times, avg 4µs/call:
# 681 times (2.69ms+0s) by Package::Stash::add_package_symbol at line 86, avg 4µs/call | |||
| 31 | 681 | 1.44ms | 2µs | return $_[0]->{package}; |
| 32 | } | |||
| 33 | ||||
| 34 | ||||
| 35 | # spent 3.56ms within Package::Stash::namespace which was called 947 times, avg 4µs/call:
# 917 times (3.43ms+0s) by Package::Stash::get_package_symbol at line 157, avg 4µs/call
# 16 times (71µs+0s) at line 97 of /usr/local/lib/perl/5.10.0/Class/MOP/Package.pm, avg 4µs/call
# 14 times (55µs+0s) by Package::Stash::has_package_symbol at line 129, avg 4µs/call | |||
| 36 | 947 | 1.70ms | 2µs | return $_[0]->{namespace}; |
| 37 | } | |||
| 38 | ||||
| 39 | { | |||
| 40 | 2 | 5µs | 2µs | my %SIGIL_MAP = ( |
| 41 | '$' => 'SCALAR', | |||
| 42 | '@' => 'ARRAY', | |||
| 43 | '%' => 'HASH', | |||
| 44 | '&' => 'CODE', | |||
| 45 | '' => 'IO', | |||
| 46 | ); | |||
| 47 | ||||
| 48 | sub _deconstruct_variable_name { | |||
| 49 | 18 | 25µs | 1µs | my ($self, $variable) = @_; |
| 50 | ||||
| 51 | 18 | 16µs | 900ns | (defined $variable && length $variable) |
| 52 | || confess "You must pass a variable name"; | |||
| 53 | ||||
| 54 | 18 | 45µs | 3µs | my $sigil = substr($variable, 0, 1, ''); |
| 55 | ||||
| 56 | 18 | 62µs | 3µs | if (exists $SIGIL_MAP{$sigil}) { |
| 57 | return ($variable, $sigil, $SIGIL_MAP{$sigil}); | |||
| 58 | } | |||
| 59 | else { | |||
| 60 | return ("${sigil}${variable}", '', $SIGIL_MAP{''}); | |||
| 61 | } | |||
| 62 | } | |||
| 63 | } | |||
| 64 | ||||
| 65 | ||||
| 66 | # spent 4.01ms (2.89+1.12) within Package::Stash::_valid_for_type which was called 397 times, avg 10µs/call:
# 397 times (2.89ms+1.12ms) by Package::Stash::add_package_symbol at line 89, avg 10µs/call | |||
| 67 | 397 | 183µs | 460ns | my $self = shift; |
| 68 | 397 | 573µs | 1µs | my ($value, $type) = @_; |
| 69 | 397 | 2.35ms | 6µs | if ($type eq 'HASH' || $type eq 'ARRAY' # spent 1.12ms making 397 calls to Scalar::Util::reftype, avg 3µs/call |
| 70 | || $type eq 'IO' || $type eq 'CODE') { | |||
| 71 | return reftype($value) eq $type; | |||
| 72 | } | |||
| 73 | else { | |||
| 74 | my $ref = reftype($value); | |||
| 75 | return !defined($ref) || $ref eq 'SCALAR' || $ref eq 'REF' || $ref eq 'LVALUE'; | |||
| 76 | } | |||
| 77 | } | |||
| 78 | ||||
| 79 | # spent 23.4ms (16.6+6.73) within Package::Stash::add_package_symbol which was called 681 times, avg 34µs/call:
# 397 times (12.2ms+5.59ms) by Moose::import or Moose::unimport or Moose::Object::meta or MARC::Moose::Field::new or Moose::Meta::Role::_new or Moose::Meta::Role::meta or MARC::Moose::Field::tag or Class::MOP::Mixin::meta or Class::MOP::Object::meta or MARC::Moose::Record::new or MARC::Moose::Field::meta or Moose::Meta::Class::_new or MARC::Moose::Parser::new or Moose::Meta::Class::roles or Moose::Meta::Method::_new or MARC::Moose::Parser::meta or MARC::Moose::Record::meta or MARC::Moose::Record::leader or MARC::Moose::Field::DESTROY or Moose::Meta::Instance::_new or MARC::Moose::Record::fields or Class::MOP::Module::version or Class::MOP::Instance::slots or MARC::Moose::Field::Std::new or Moose::Meta::Attribute::_new or MARC::Moose::Parser::DESTROY or MARC::Moose::Record::_leader or MARC::Moose::Record::DESTROY or Class::MOP::Attribute::clone or Moose::Meta::Role::get_roles or MARC::Moose::Field::Std::ind2 or MARC::Moose::Field::Std::ind1 or Class::MOP::Module::authority or MARC::Moose::Field::Std::meta or MARC::Moose::Field::Std::subf or Class::MOP::Package::namespace or Moose::Meta::TypeCoercion::meta or Class::MOP::Class::superclasses or Moose::Meta::TypeCoercion::_new or Moose::Meta::Role::Method::_new or Moose::Meta::Class::error_class or Class::MOP::Instance::slot_hash or MARC::Moose::Field::Control::new or Moose::Meta::Role::excludes_role or Moose::Meta::Role::Attribute::is or Class::MOP::Instance::attributes or MARC::Moose::Field::Std::DESTROY or Moose::Meta::TypeConstraint::meta or Moose::Meta::TypeConstraint::_new or Class::MOP::Instance::_class_name or MARC::Moose::Parser::Marcxml::new or Moose::Meta::TypeConstraint::name or MARC::Moose::Field::Control::meta or Moose::Meta::Role::Composite::_new or Moose::Meta::Role::Attribute::_new or MARC::Moose::Parser::Marcxml::meta or Moose::Meta::Role::Composite::name or Class::MOP::Class::immutable_trait or Moose::Meta::Role::Composite::meta or MARC::Moose::Field::Control::value or Moose::Meta::Role::requires_method or Class::MOP::Class::constructor_name or MARC::Moose::Parser::Marcxml::parse or Moose::Meta::Method::Accessor::_new or MARC::Moose::Parser::MarcxmlSax::xs or Moose::Meta::Class::immutable_trait or Class::MOP::Method::original_method or Class::MOP::Class::destructor_class or Moose::Meta::Role::method_metaclass or Moose::Meta::TypeConstraint::parent or Moose::Util::TypeConstraints::import or Moose::Meta::Method::Augmented::_new or Moose::Meta::Role::Application::_new or Moose::Meta::TypeConstraint::message or MARC::Moose::Field::Control::DESTROY or Moose::Meta::Role::Application::meta or Class::MOP::Class::constructor_class or Moose::Meta::Class::destructor_class or MARC::Moose::Parser::MarcxmlSax::new or Class::MOP::Class::instance_metaclass or Moose::Meta::Class::constructor_class or Moose::Meta::TypeConstraint::coercion or Moose::Meta::Method::Destructor::_new or Moose::Meta::Role::add_excluded_roles or MARC::Moose::Parser::MarcxmlSax::meta or MARC::Moose::Field::Std::as_formatted or MARC::Moose::Parser::Marcxml::DESTROY or Moose::Meta::Method::Overridden::_new or Moose::Meta::Method::Constructor::_new or Moose::Meta::TypeCoercion::Union::_new or Moose::Meta::Attribute::applied_traits or Moose::Meta::TypeCoercion::Union::meta or MARC::Moose::Parser::MarcxmlSax::parse or Moose::Util::TypeConstraints::unimport or Moose::Meta::TypeConstraint::Enum::_new or Moose::Meta::TypeConstraint::Enum::meta or Moose::Meta::TypeConstraint::Role::role or Moose::Meta::TypeConstraint::Role::_new or Moose::Meta::TypeConstraint::Role::meta or Class::MOP::Package::add_package_symbol or Class::MOP::Attribute::associated_class or Moose::Meta::TypeConstraint::constraint or Moose::Meta::Role::Attribute::metaclass or Moose::Meta::TypeConstraint::has_parent or Moose::Meta::TypeConstraint::Union::meta or Class::MOP::Method::Generated::is_inline or Moose::Meta::TypeConstraint::Class::_new or MARC::Moose::Parser::MarcxmlSax::DESTROY or Class::MOP::Mixin::AttributeCore::reader or Class::MOP::Method::Constructor::options or Class::MOP::Method::associated_metaclass or Moose::Meta::TypeConstraint::has_message or Moose::Meta::TypeConstraint::Class::meta or Class::MOP::Mixin::AttributeCore::writer or Moose::Meta::TypeConstraint::Union::_new or Class::MOP::Method::_set_original_method or Class::MOP::Mixin::AttributeCore::builder or Moose::Meta::Role::Composite::_method_map or Moose::Meta::Role::Method::Required::_new or Moose::Meta::Role::get_excluded_roles_map or MARC::Moose::Field::Control::as_formatted or Class::MOP::Mixin::AttributeCore::clearer or Class::MOP::Attribute::associated_methods or Moose::Meta::TypeConstraint::Enum::values or Moose::Meta::Role::Method::Required::meta or Moose::Meta::TypeConstraint::Class::class or Moose::Meta::Role::Method::Required::name or Moose::Meta::TypeConstraint::has_coercion or Moose::Meta::Mixin::AttributeCore::is_lazy or Moose::Meta::Attribute::has_applied_traits or Moose::Meta::Role::get_excluded_roles_list or Moose::Meta::TypeCoercion::type_constraint or Class::MOP::Instance::associated_metaclass or Moose::Meta::Class::_get_role_applications or Class::MOP::Mixin::AttributeCore::accessor or Class::MOP::Mixin::AttributeCore::init_arg or Moose::Meta::Mixin::AttributeCore::handles or Moose::Meta::Mixin::AttributeCore::trigger or Moose::Meta::Role::remove_required_methods or Moose::Meta::TypeConstraint::DuckType::meta or Moose::Meta::Role::get_required_methods_map or Moose::Meta::TypeConstraint::DuckType::_new or Class::MOP::Mixin::AttributeCore::predicate or Class::MOP::Method::Accessor::accessor_type or Moose::Meta::TypeConstraint::Registry::_new or Moose::Meta::Role::get_required_method_list or Moose::Meta::TypeConstraint::Registry::meta or Moose::Meta::Role::_get_compatible_metaclass or Moose::Meta::Role::Application::ToRole::meta or Moose::Meta::Role::application_to_role_class or Moose::Meta::TypeCoercion::type_coercion_map or Moose::Meta::Role::Application::ToRole::_new or Moose::Meta::TypeConstraint::_set_constraint or Moose::Meta::Role::add_after_method_modifier or Class::MOP::Mixin::AttributeCore::has_writer or Moose::Meta::Role::required_method_metaclass or Moose::Meta::Role::Method::Conflicting::_new or Class::MOP::Mixin::AttributeCore::has_reader or Moose::Meta::Role::has_after_method_modifiers or Class::MOP::Mixin::AttributeCore::has_default or Moose::Meta::Class::_get_compatible_metaclass or Moose::Meta::Role::get_after_method_modifiers or Class::MOP::Mixin::AttributeCore::has_clearer or Moose::Meta::Role::Application::ToClass::role or Moose::Meta::Role::application_to_class_class or Class::MOP::Mixin::AttributeCore::has_builder or Moose::Meta::Role::add_around_method_modifier or Moose::Meta::Role::add_before_method_modifier or Moose::Meta::Role::Attribute::associated_role or Moose::Meta::Role::Method::Conflicting::roles or Class::MOP::Mixin::AttributeCore::initializer or Moose::Meta::Role::Application::ToClass::_new or Moose::Meta::Role::Application::ToClass::meta or Moose::Meta::Role::has_around_method_modifiers or Class::MOP::Mixin::AttributeCore::has_init_arg or Class::MOP::Mixin::AttributeCore::has_accessor or Moose::Meta::Mixin::AttributeCore::has_trigger or Moose::Meta::Role::get_before_method_modifiers or Moose::Meta::Role::has_before_method_modifiers or Moose::Meta::Mixin::AttributeCore::is_required or Moose::Meta::Method::_get_compatible_metaclass or Moose::Meta::TypeConstraint::DuckType::methods or Moose::Meta::Mixin::AttributeCore::has_handles or Moose::Meta::Role::get_around_method_modifiers or Moose::Meta::Role::Application::ToClass::class or Moose::Meta::Mixin::AttributeCore::is_weak_ref or Moose::Meta::Role::Attribute::original_options or Class::MOP::Mixin::HasMethods::method_metaclass or Moose::Meta::Mixin::AttributeCore::_is_metadata or Moose::Meta::Mixin::AttributeCore::_set_handles or Class::MOP::Mixin::AttributeCore::has_predicate or Class::MOP::Mixin::HasMethods::_full_method_map or Moose::Meta::Role::conflicting_method_metaclass or Moose::Meta::Mixin::AttributeCore::documentation or Moose::Error::Default::_get_compatible_metaclass or Moose::Meta::TypeConstraint::Parameterized::meta or Moose::Meta::Role::Application::ToInstance::_new or Moose::Meta::Instance::_get_compatible_metaclass or Moose::Meta::TypeConstraint::Parameterized::_new or Moose::Meta::Role::application_to_instance_class or Moose::Meta::Role::Application::ToInstance::meta or Moose::Meta::TypeConstraint::_package_defined_in or Moose::Meta::Mixin::AttributeCore::_isa_metadata or Moose::Meta::Mixin::AttributeCore::is_lazy_build or Class::MOP::Mixin::HasAttributes::_attribute_map or Moose::Meta::Mixin::AttributeCore::should_coerce or Class::MOP::Mixin::AttributeCore::insertion_order or Class::MOP::Method::Generated::definition_context or Moose::Meta::Attribute::_get_compatible_metaclass or Class::MOP::Mixin::AttributeCore::has_initializer or Moose::Meta::Mixin::AttributeCore::_does_metadata or Moose::Meta::Role::get_after_method_modifiers_map or Moose::Meta::TypeConstraint::Parameterizable::_new or Class::MOP::Method::Accessor::associated_attribute or Moose::Meta::TypeConstraint::Parameterizable::meta or Moose::Meta::Mixin::AttributeCore::type_constraint or Moose::Meta::Role::Application::get_method_aliases or Moose::Meta::Role::get_before_method_modifiers_map or Moose::Meta::TypeCoercion::_compiled_type_coercion or Moose::Meta::Role::get_around_method_modifiers_map or Moose::Meta::Role::Application::RoleSummation::meta or Moose::Meta::Role::Application::RoleSummation::_new or Class::MOP::Method::Inlined::_expected_method_class or Moose::Meta::Role::get_override_method_modifiers_map or Moose::Meta::TypeConstraint::Union::type_constraints or Class::MOP::Mixin::AttributeCore::definition_context or Moose::Meta::Mixin::AttributeCore::has_documentation or Moose::Meta::Mixin::AttributeCore::should_auto_deref or Class::MOP::Mixin::AttributeCore::has_insertion_order or Moose::Meta::Role::Application::get_method_exclusions or Class::MOP::Method::Constructor::associated_metaclass or Class::MOP::Mixin::HasAttributes::attribute_metaclass or Class::MOP::Class::Immutable::Class::MOP::Class::meta or Class::MOP::Mixin::AttributeCore::_set_insertion_order or Moose::Meta::TypeConstraint::_compiled_type_constraint or Class::MOP::Class::Immutable::Moose::Meta::Class::meta or Moose::Meta::Mixin::AttributeCore::has_type_constraint or Class::MOP::Mixin::HasMethods::wrapped_method_metaclass or Moose::Meta::TypeConstraint::Registry::type_constraints or Moose::Meta::Role::Application::ToInstance::rebless_params or Moose::Meta::TypeConstraint::Parameterized::type_parameter or Moose::Meta::TypeConstraint::Registry::get_parent_registry or Moose::Meta::TypeConstraint::Registry::has_parent_registry or Moose::Meta::TypeConstraint::_has_compiled_type_constraint or Moose::Meta::TypeConstraint::Registry::set_parent_registry or Class::MOP::Class::Immutable::Moose::Meta::Class::add_role or Moose::Meta::Role::Application::RoleSummation::role_params or Moose::Meta::TypeConstraint::hand_optimized_type_constraint or Class::MOP::Class::Immutable::Moose::Meta::Class::does_role or Class::MOP::Class::Immutable::Class::MOP::Class::is_mutable or Class::MOP::Class::Immutable::Class::MOP::Class::add_method or Class::MOP::Class::Immutable::Moose::Meta::Class::add_method or Class::MOP::Class::Immutable::Class::MOP::Class::_method_map or Class::MOP::Class::Immutable::Moose::Meta::Class::is_mutable or Class::MOP::Class::Immutable::Moose::Meta::Class::_method_map or Class::MOP::Class::Immutable::Class::MOP::Class::superclasses or Class::MOP::Class::Immutable::Class::MOP::Class::is_immutable or Class::MOP::Class::Immutable::Class::MOP::Class::alias_method or Moose::Meta::Role::Composite::application_role_summation_class or Moose::Meta::TypeConstraint::Parameterized::has_type_parameter or Class::MOP::Class::Immutable::Class::MOP::Class::remove_method or Class::MOP::Class::Immutable::Moose::Meta::Class::superclasses or Class::MOP::Class::Immutable::Class::MOP::Class::add_attribute or Class::MOP::Class::Immutable::Moose::Meta::Class::is_immutable or Class::MOP::Class::Immutable::Moose::Meta::Class::alias_method or Class::MOP::Class::Immutable::Class::MOP::Class::linearized_isa or Moose::Meta::TypeConstraint::has_hand_optimized_type_constraint or Class::MOP::Class::Immutable::Moose::Meta::Class::add_attribute or Class::MOP::Class::Immutable::Moose::Meta::Class::remove_method or Class::MOP::Class::Immutable::Class::MOP::Class::get_all_methods or Class::MOP::Class::Immutable::Moose::Meta::Class::linearized_isa or Class::MOP::Class::Immutable::Class::MOP::Class::remove_attribute or Class::MOP::Class::Immutable::Moose::Meta::Class::get_all_methods or Moose::Meta::TypeConstraint::Parameterizable::constraint_generator or Class::MOP::Class::Immutable::Class::MOP::Class::get_meta_instance or Class::MOP::Class::Immutable::Moose::Meta::Class::remove_attribute or Class::MOP::Class::Immutable::Class::MOP::Class::add_package_symbol or Class::MOP::Class::Immutable::Moose::Meta::Class::get_meta_instance or Class::MOP::Class::Immutable::Class::MOP::Class::get_all_attributes or Moose::Meta::Role::_get_compatible_metaclass_by_role_reconciliation or Class::MOP::Class::Immutable::Moose::Meta::Class::get_all_attributes or Moose::Meta::Attribute::Custom::Trait::Bool::register_implementation or Moose::Meta::Class::_get_compatible_metaclass_by_role_reconciliation or Moose::Meta::Attribute::Custom::Trait::Hash::register_implementation or Moose::Meta::Attribute::Custom::Trait::Code::register_implementation or Class::MOP::Class::Immutable::Moose::Meta::Class::add_package_symbol or Class::MOP::Class::Immutable::Moose::Meta::Class::calculate_all_roles or Class::MOP::Class::Immutable::Class::MOP::Class::_immutable_metaclass or Moose::Meta::Method::_get_compatible_metaclass_by_role_reconciliation or Class::MOP::Class::Immutable::Class::MOP::Class::get_all_method_names or Moose::Meta::Attribute::Custom::Trait::Array::register_implementation or Moose::Meta::TypeConstraint::Parameterizable::has_constraint_generator or Class::MOP::Class::Immutable::Class::MOP::Class::remove_package_symbol or Class::MOP::Class::Immutable::Moose::Meta::Class::get_all_method_names or Class::MOP::Class::Immutable::Class::MOP::Class::class_precedence_list or Class::MOP::Class::Immutable::Moose::Meta::Class::_immutable_metaclass or Moose::Meta::Attribute::Custom::Trait::String::register_implementation or Moose::Meta::Attribute::Custom::Trait::Number::register_implementation or Class::MOP::Class::Immutable::Class::MOP::Class::_immutable_cannot_call or Moose::Error::Default::_get_compatible_metaclass_by_role_reconciliation or Class::MOP::Class::Immutable::Moose::Meta::Class::class_precedence_list or Moose::Meta::Attribute::Custom::Trait::Counter::register_implementation or Moose::Meta::Instance::_get_compatible_metaclass_by_role_reconciliation or Class::MOP::Class::Immutable::Moose::Meta::Class::remove_package_symbol or Class::MOP::Class::Immutable::Moose::Meta::Class::_immutable_cannot_call or Moose::Meta::Attribute::_get_compatible_metaclass_by_role_reconciliation or Class::MOP::Class::Immutable::Class::MOP::Class::_get_mutable_metaclass_name or Class::MOP::Class::Immutable::Moose::Meta::Class::_get_mutable_metaclass_name or Class::MOP::Class::Immutable::Moose::Meta::Class::calculate_all_roles_with_inheritance at line 106 of /usr/local/lib/perl/5.10.0/Class/MOP/Package.pm, avg 45µs/call
# 284 times (4.40ms+1.14ms) by Package::Stash::get_package_symbol at line 174, avg 20µs/call | |||
| 80 | 681 | 1.02ms | 1µs | my ($self, $variable, $initial_value, %opts) = @_; |
| 81 | ||||
| 82 | my ($name, $sigil, $type) = ref $variable eq 'HASH' | |||
| 83 | 681 | 2.19ms | 3µs | ? @{$variable}{qw[name sigil type]} # spent 27µs making 4 calls to Package::Stash::_deconstruct_variable_name, avg 7µs/call |
| 84 | : $self->_deconstruct_variable_name($variable); | |||
| 85 | ||||
| 86 | 681 | 2.22ms | 3µs | my $pkg = $self->name; # spent 2.69ms making 681 calls to Package::Stash::name, avg 4µs/call |
| 87 | ||||
| 88 | 681 | 588µs | 863ns | if (@_ > 2) { |
| 89 | 397 | 1.57ms | 4µs | $self->_valid_for_type($initial_value, $type) # spent 4.01ms making 397 calls to Package::Stash::_valid_for_type, avg 10µs/call |
| 90 | || confess "$initial_value is not of type $type"; | |||
| 91 | ||||
| 92 | # cheap fail-fast check for PERLDBf_SUBLINE and '&' | |||
| 93 | 397 | 999µs | 3µs | if ($^P and $^P & 0x10 && $sigil eq '&') { |
| 94 | 397 | 204µs | 515ns | my $filename = $opts{filename}; |
| 95 | 397 | 141µs | 356ns | my $first_line_num = $opts{first_line_num}; |
| 96 | ||||
| 97 | 397 | 1.03ms | 3µs | (undef, $filename, $first_line_num) = caller |
| 98 | if not defined $filename; | |||
| 99 | ||||
| 100 | 397 | 242µs | 611ns | my $last_line_num = $opts{last_line_num} || ($first_line_num ||= 0); |
| 101 | ||||
| 102 | # http://perldoc.perl.org/perldebguts.html#Debugger-Internals | |||
| 103 | 397 | 2.53ms | 6µs | $DB::sub{$pkg . '::' . $name} = "$filename:$first_line_num-$last_line_num"; |
| 104 | } | |||
| 105 | } | |||
| 106 | ||||
| 107 | 3 | 28µs | 9µs | no strict 'refs'; # spent 16µs making 1 call to strict::unimport |
| 108 | 3 | 101µs | 34µs | no warnings 'redefine', 'misc', 'prototype'; # spent 27µs making 1 call to warnings::unimport |
| 109 | 681 | 4.59ms | 7µs | *{$pkg . '::' . $name} = ref $initial_value ? $initial_value : \$initial_value; |
| 110 | } | |||
| 111 | ||||
| 112 | ||||
| 113 | sub remove_package_glob { | |||
| 114 | my ($self, $name) = @_; | |||
| 115 | 3 | 320µs | 107µs | no strict 'refs'; # spent 18µs making 1 call to strict::unimport |
| 116 | delete ${$self->name . '::'}{$name}; | |||
| 117 | } | |||
| 118 | ||||
| 119 | # ... these functions deal with stuff on the namespace level | |||
| 120 | ||||
| 121 | ||||
| 122 | # spent 491µs (235+256) within Package::Stash::has_package_symbol which was called 14 times, avg 35µs/call:
# 14 times (235µs+256µs) by Class::MOP::Package::has_package_symbol at line 118 of /usr/local/lib/perl/5.10.0/Class/MOP/Package.pm, avg 35µs/call | |||
| 123 | 14 | 24µs | 2µs | my ($self, $variable) = @_; |
| 124 | ||||
| 125 | my ($name, $sigil, $type) = ref $variable eq 'HASH' | |||
| 126 | 14 | 97µs | 7µs | ? @{$variable}{qw[name sigil type]} # spent 158µs making 14 calls to Package::Stash::_deconstruct_variable_name, avg 11µs/call |
| 127 | : $self->_deconstruct_variable_name($variable); | |||
| 128 | ||||
| 129 | 14 | 54µs | 4µs | my $namespace = $self->namespace; # spent 55µs making 14 calls to Package::Stash::namespace, avg 4µs/call |
| 130 | ||||
| 131 | 14 | 16µs | 1µs | return unless exists $namespace->{$name}; |
| 132 | ||||
| 133 | 11 | 9µs | 782ns | my $entry_ref = \$namespace->{$name}; |
| 134 | 11 | 59µs | 5µs | if (reftype($entry_ref) eq 'GLOB') { # spent 43µs making 11 calls to Scalar::Util::reftype, avg 4µs/call |
| 135 | if ( $type eq 'SCALAR' ) { | |||
| 136 | return defined ${ *{$entry_ref}{SCALAR} }; | |||
| 137 | } | |||
| 138 | else { | |||
| 139 | 11 | 29µs | 3µs | return defined *{$entry_ref}{$type}; |
| 140 | } | |||
| 141 | } | |||
| 142 | else { | |||
| 143 | # a symbol table entry can be -1 (stub), string (stub with prototype), | |||
| 144 | # or reference (constant) | |||
| 145 | return $type eq 'CODE'; | |||
| 146 | } | |||
| 147 | } | |||
| 148 | ||||
| 149 | ||||
| 150 | # spent 21.1ms (12.1+8.98) within Package::Stash::get_package_symbol which was called 917 times, avg 23µs/call:
# 813 times (10.4ms+7.68ms) by Class::MOP::Package::get_package_symbol at line 123 of /usr/local/lib/perl/5.10.0/Class/MOP/Package.pm, avg 22µs/call
# 104 times (1.74ms+1.30ms) by Package::Stash::get_or_add_package_symbol at line 197, avg 29µs/call | |||
| 151 | 917 | 1.29ms | 1µs | my ($self, $variable, %opts) = @_; |
| 152 | ||||
| 153 | my ($name, $sigil, $type) = ref $variable eq 'HASH' | |||
| 154 | 917 | 2.80ms | 3µs | ? @{$variable}{qw[name sigil type]} |
| 155 | : $self->_deconstruct_variable_name($variable); | |||
| 156 | ||||
| 157 | 917 | 2.94ms | 3µs | my $namespace = $self->namespace; # spent 3.43ms making 917 calls to Package::Stash::namespace, avg 4µs/call |
| 158 | ||||
| 159 | 917 | 1.30ms | 1µs | if (!exists $namespace->{$name}) { |
| 160 | # assigning to the result of this function like | |||
| 161 | # @{$stash->get_package_symbol('@ISA')} = @new_ISA | |||
| 162 | # makes the result not visible until the variable is explicitly | |||
| 163 | # accessed... in the case of @ISA, this might never happen | |||
| 164 | # for instance, assigning like that and then calling $obj->isa | |||
| 165 | # will fail. see t/005-isa.t | |||
| 166 | 284 | 406µs | 1µs | if ($opts{vivify} && $type eq 'ARRAY' && $name ne 'ISA') { |
| 167 | $self->add_package_symbol($variable, []); | |||
| 168 | } | |||
| 169 | elsif ($opts{vivify} && $type eq 'HASH') { | |||
| 170 | $self->add_package_symbol($variable, {}); | |||
| 171 | } | |||
| 172 | else { | |||
| 173 | # FIXME | |||
| 174 | 284 | 943µs | 3µs | $self->add_package_symbol($variable) # spent 5.54ms making 284 calls to Package::Stash::add_package_symbol, avg 20µs/call |
| 175 | } | |||
| 176 | } | |||
| 177 | ||||
| 178 | 917 | 855µs | 932ns | my $entry_ref = \$namespace->{$name}; |
| 179 | ||||
| 180 | 917 | 2.14ms | 2µs | if (ref($entry_ref) eq 'GLOB') { |
| 181 | return *{$entry_ref}{$type}; | |||
| 182 | } | |||
| 183 | else { | |||
| 184 | if ($type eq 'CODE') { | |||
| 185 | 3 | 694µs | 231µs | no strict 'refs'; # spent 23µs making 1 call to strict::unimport |
| 186 | return \&{ $self->name . '::' . $name }; | |||
| 187 | } | |||
| 188 | else { | |||
| 189 | return undef; | |||
| 190 | } | |||
| 191 | } | |||
| 192 | } | |||
| 193 | ||||
| 194 | ||||
| 195 | # spent 3.63ms (592µs+3.03) within Package::Stash::get_or_add_package_symbol which was called 104 times, avg 35µs/call:
# 104 times (592µs+3.03ms) by Class::MOP::Package::get_or_add_package_symbol at line 128 of /usr/local/lib/perl/5.10.0/Class/MOP/Package.pm, avg 35µs/call | |||
| 196 | 104 | 48µs | 463ns | my $self = shift; |
| 197 | 104 | 431µs | 4µs | $self->get_package_symbol(@_, vivify => 1); # spent 3.03ms making 104 calls to Package::Stash::get_package_symbol, avg 29µs/call |
| 198 | } | |||
| 199 | ||||
| 200 | ||||
| 201 | sub remove_package_symbol { | |||
| 202 | my ($self, $variable) = @_; | |||
| 203 | ||||
| 204 | my ($name, $sigil, $type) = ref $variable eq 'HASH' | |||
| 205 | ? @{$variable}{qw[name sigil type]} | |||
| 206 | : $self->_deconstruct_variable_name($variable); | |||
| 207 | ||||
| 208 | # FIXME: | |||
| 209 | # no doubt this is grossly inefficient and | |||
| 210 | # could be done much easier and faster in XS | |||
| 211 | ||||
| 212 | my ($scalar_desc, $array_desc, $hash_desc, $code_desc, $io_desc) = ( | |||
| 213 | { sigil => '$', type => 'SCALAR', name => $name }, | |||
| 214 | { sigil => '@', type => 'ARRAY', name => $name }, | |||
| 215 | { sigil => '%', type => 'HASH', name => $name }, | |||
| 216 | { sigil => '&', type => 'CODE', name => $name }, | |||
| 217 | { sigil => '', type => 'IO', name => $name }, | |||
| 218 | ); | |||
| 219 | ||||
| 220 | my ($scalar, $array, $hash, $code, $io); | |||
| 221 | if ($type eq 'SCALAR') { | |||
| 222 | $array = $self->get_package_symbol($array_desc) if $self->has_package_symbol($array_desc); | |||
| 223 | $hash = $self->get_package_symbol($hash_desc) if $self->has_package_symbol($hash_desc); | |||
| 224 | $code = $self->get_package_symbol($code_desc) if $self->has_package_symbol($code_desc); | |||
| 225 | $io = $self->get_package_symbol($io_desc) if $self->has_package_symbol($io_desc); | |||
| 226 | } | |||
| 227 | elsif ($type eq 'ARRAY') { | |||
| 228 | $scalar = $self->get_package_symbol($scalar_desc); | |||
| 229 | $hash = $self->get_package_symbol($hash_desc) if $self->has_package_symbol($hash_desc); | |||
| 230 | $code = $self->get_package_symbol($code_desc) if $self->has_package_symbol($code_desc); | |||
| 231 | $io = $self->get_package_symbol($io_desc) if $self->has_package_symbol($io_desc); | |||
| 232 | } | |||
| 233 | elsif ($type eq 'HASH') { | |||
| 234 | $scalar = $self->get_package_symbol($scalar_desc); | |||
| 235 | $array = $self->get_package_symbol($array_desc) if $self->has_package_symbol($array_desc); | |||
| 236 | $code = $self->get_package_symbol($code_desc) if $self->has_package_symbol($code_desc); | |||
| 237 | $io = $self->get_package_symbol($io_desc) if $self->has_package_symbol($io_desc); | |||
| 238 | } | |||
| 239 | elsif ($type eq 'CODE') { | |||
| 240 | $scalar = $self->get_package_symbol($scalar_desc); | |||
| 241 | $array = $self->get_package_symbol($array_desc) if $self->has_package_symbol($array_desc); | |||
| 242 | $hash = $self->get_package_symbol($hash_desc) if $self->has_package_symbol($hash_desc); | |||
| 243 | $io = $self->get_package_symbol($io_desc) if $self->has_package_symbol($io_desc); | |||
| 244 | } | |||
| 245 | elsif ($type eq 'IO') { | |||
| 246 | $scalar = $self->get_package_symbol($scalar_desc); | |||
| 247 | $array = $self->get_package_symbol($array_desc) if $self->has_package_symbol($array_desc); | |||
| 248 | $hash = $self->get_package_symbol($hash_desc) if $self->has_package_symbol($hash_desc); | |||
| 249 | $code = $self->get_package_symbol($code_desc) if $self->has_package_symbol($code_desc); | |||
| 250 | } | |||
| 251 | else { | |||
| 252 | confess "This should never ever ever happen"; | |||
| 253 | } | |||
| 254 | ||||
| 255 | $self->remove_package_glob($name); | |||
| 256 | ||||
| 257 | $self->add_package_symbol($scalar_desc => $scalar); | |||
| 258 | $self->add_package_symbol($array_desc => $array) if defined $array; | |||
| 259 | $self->add_package_symbol($hash_desc => $hash) if defined $hash; | |||
| 260 | $self->add_package_symbol($code_desc => $code) if defined $code; | |||
| 261 | $self->add_package_symbol($io_desc => $io) if defined $io; | |||
| 262 | } | |||
| 263 | ||||
| 264 | ||||
| 265 | sub list_all_package_symbols { | |||
| 266 | my ($self, $type_filter) = @_; | |||
| 267 | ||||
| 268 | my $namespace = $self->namespace; | |||
| 269 | return keys %{$namespace} unless defined $type_filter; | |||
| 270 | ||||
| 271 | # NOTE: | |||
| 272 | # or we can filter based on | |||
| 273 | # type (SCALAR|ARRAY|HASH|CODE) | |||
| 274 | if ($type_filter eq 'CODE') { | |||
| 275 | return grep { | |||
| 276 | (ref($namespace->{$_}) | |||
| 277 | ? (ref($namespace->{$_}) eq 'SCALAR') | |||
| 278 | : (ref(\$namespace->{$_}) eq 'GLOB' | |||
| 279 | && defined(*{$namespace->{$_}}{CODE}))); | |||
| 280 | } keys %{$namespace}; | |||
| 281 | } else { | |||
| 282 | return grep { *{$namespace->{$_}}{$type_filter} } keys %{$namespace}; | |||
| 283 | } | |||
| 284 | } | |||
| 285 | ||||
| 286 | ||||
| 287 | 1 | 10µs | 10µs | 1; |
| 288 | ||||
| 289 | __END__ | |||
| 290 | =pod | |||
| 291 | ||||
| 292 | =head1 NAME | |||
| 293 | ||||
| 294 | Package::Stash - routines for manipulating stashes | |||
| 295 | ||||
| 296 | =head1 VERSION | |||
| 297 | ||||
| 298 | version 0.08 | |||
| 299 | ||||
| 300 | =head1 SYNOPSIS | |||
| 301 | ||||
| 302 | my $stash = Package::Stash->new('Foo'); | |||
| 303 | $stash->add_package_symbol('%foo', {bar => 1}); | |||
| 304 | # $Foo::foo{bar} == 1 | |||
| 305 | $stash->has_package_symbol('$foo') # false | |||
| 306 | my $namespace = $stash->namespace; | |||
| 307 | *{ $namespace->{foo} }{HASH} # {bar => 1} | |||
| 308 | ||||
| 309 | =head1 DESCRIPTION | |||
| 310 | ||||
| 311 | Manipulating stashes (Perl's symbol tables) is occasionally necessary, but | |||
| 312 | incredibly messy, and easy to get wrong. This module hides all of that behind a | |||
| 313 | simple API. | |||
| 314 | ||||
| 315 | NOTE: Most methods in this class require a variable specification that includes | |||
| 316 | a sigil. If this sigil is absent, it is assumed to represent the IO slot. | |||
| 317 | ||||
| 318 | =head1 METHODS | |||
| 319 | ||||
| 320 | =head2 new $package_name | |||
| 321 | ||||
| 322 | Creates a new C<Package::Stash> object, for the package given as the only | |||
| 323 | argument. | |||
| 324 | ||||
| 325 | =head2 name | |||
| 326 | ||||
| 327 | Returns the name of the package that this object represents. | |||
| 328 | ||||
| 329 | =head2 namespace | |||
| 330 | ||||
| 331 | Returns the raw stash itself. | |||
| 332 | ||||
| 333 | =head2 add_package_symbol $variable $value %opts | |||
| 334 | ||||
| 335 | Adds a new package symbol, for the symbol given as C<$variable>, and optionally | |||
| 336 | gives it an initial value of C<$value>. C<$variable> should be the name of | |||
| 337 | variable including the sigil, so | |||
| 338 | ||||
| 339 | Package::Stash->new('Foo')->add_package_symbol('%foo') | |||
| 340 | ||||
| 341 | will create C<%Foo::foo>. | |||
| 342 | ||||
| 343 | Valid options (all optional) are C<filename>, C<first_line_num>, and | |||
| 344 | C<last_line_num>. | |||
| 345 | ||||
| 346 | C<$opts{filename}>, C<$opts{first_line_num}>, and C<$opts{last_line_num}> can | |||
| 347 | be used to indicate where the symbol should be regarded as having been defined. | |||
| 348 | Currently these values are only used if the symbol is a subroutine ('C<&>' | |||
| 349 | sigil) and only if C<$^P & 0x10> is true, in which case the special C<%DB::sub> | |||
| 350 | hash is updated to record the values of C<filename>, C<first_line_num>, and | |||
| 351 | C<last_line_num> for the subroutine. If these are not passed, their values are | |||
| 352 | inferred (as much as possible) from C<caller> information. | |||
| 353 | ||||
| 354 | This is especially useful for debuggers and profilers, which use C<%DB::sub> to | |||
| 355 | determine where the source code for a subroutine can be found. See | |||
| 356 | L<http://perldoc.perl.org/perldebguts.html#Debugger-Internals> for more | |||
| 357 | information about C<%DB::sub>. | |||
| 358 | ||||
| 359 | =head2 remove_package_glob $name | |||
| 360 | ||||
| 361 | Removes all package variables with the given name, regardless of sigil. | |||
| 362 | ||||
| 363 | =head2 has_package_symbol $variable | |||
| 364 | ||||
| 365 | Returns whether or not the given package variable (including sigil) exists. | |||
| 366 | ||||
| 367 | =head2 get_package_symbol $variable | |||
| 368 | ||||
| 369 | Returns the value of the given package variable (including sigil). | |||
| 370 | ||||
| 371 | =head2 get_or_add_package_symbol $variable | |||
| 372 | ||||
| 373 | Like C<get_package_symbol>, except that it will return an empty hashref or | |||
| 374 | arrayref if the variable doesn't exist. | |||
| 375 | ||||
| 376 | =head2 remove_package_symbol $variable | |||
| 377 | ||||
| 378 | Removes the package variable described by C<$variable> (which includes the | |||
| 379 | sigil); other variables with the same name but different sigils will be | |||
| 380 | untouched. | |||
| 381 | ||||
| 382 | =head2 list_all_package_symbols $type_filter | |||
| 383 | ||||
| 384 | Returns a list of package variable names in the package, without sigils. If a | |||
| 385 | C<type_filter> is passed, it is used to select package variables of a given | |||
| 386 | type, where valid types are the slots of a typeglob ('SCALAR', 'CODE', 'HASH', | |||
| 387 | etc). | |||
| 388 | ||||
| 389 | =head1 BUGS | |||
| 390 | ||||
| 391 | No known bugs. | |||
| 392 | ||||
| 393 | Please report any bugs through RT: email | |||
| 394 | C<bug-package-stash at rt.cpan.org>, or browse to | |||
| 395 | L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Package-Stash>. | |||
| 396 | ||||
| 397 | =head1 SUPPORT | |||
| 398 | ||||
| 399 | You can find this documentation for this module with the perldoc command. | |||
| 400 | ||||
| 401 | perldoc Package::Stash | |||
| 402 | ||||
| 403 | You can also look for information at: | |||
| 404 | ||||
| 405 | =over 4 | |||
| 406 | ||||
| 407 | =item * AnnoCPAN: Annotated CPAN documentation | |||
| 408 | ||||
| 409 | L<http://annocpan.org/dist/Package-Stash> | |||
| 410 | ||||
| 411 | =item * CPAN Ratings | |||
| 412 | ||||
| 413 | L<http://cpanratings.perl.org/d/Package-Stash> | |||
| 414 | ||||
| 415 | =item * RT: CPAN's request tracker | |||
| 416 | ||||
| 417 | L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Package-Stash> | |||
| 418 | ||||
| 419 | =item * Search CPAN | |||
| 420 | ||||
| 421 | L<http://search.cpan.org/dist/Package-Stash> | |||
| 422 | ||||
| 423 | =back | |||
| 424 | ||||
| 425 | =head1 AUTHOR | |||
| 426 | ||||
| 427 | Jesse Luehrs <doy at tozt dot net> | |||
| 428 | ||||
| 429 | Mostly copied from code from L<Class::MOP::Package>, by Stevan Little and the | |||
| 430 | Moose Cabal. | |||
| 431 | ||||
| 432 | =head1 SEE ALSO | |||
| 433 | ||||
| 434 | =over 4 | |||
| 435 | ||||
| 436 | =item * L<Class::MOP::Package> | |||
| 437 | ||||
| 438 | This module is a factoring out of code that used to live here | |||
| 439 | ||||
| 440 | =back | |||
| 441 | ||||
| 442 | =head1 COPYRIGHT AND LICENSE | |||
| 443 | ||||
| 444 | This software is copyright (c) 2010 by Jesse Luehrs. | |||
| 445 | ||||
| 446 | This is free software; you can redistribute it and/or modify it under | |||
| 447 | the same terms as the Perl 5 programming language system itself. | |||
| 448 | ||||
| 449 | =cut | |||
| 450 |