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 | add_package_symbol | Package::Stash::
917 | 2 | 2 | 12.1ms | 21.1ms | get_package_symbol | Package::Stash::
947 | 3 | 2 | 3.56ms | 3.56ms | namespace | Package::Stash::
397 | 1 | 1 | 2.89ms | 4.01ms | _valid_for_type | Package::Stash::
681 | 1 | 1 | 2.69ms | 2.69ms | name | Package::Stash::
73 | 1 | 1 | 1.02ms | 1.02ms | new | Package::Stash::
104 | 1 | 1 | 592µs | 3.63ms | get_or_add_package_symbol | Package::Stash::
14 | 1 | 1 | 235µs | 491µs | has_package_symbol | Package::Stash::
18 | 2 | 1 | 185µs | 185µs | _deconstruct_variable_name | Package::Stash::
0 | 0 | 0 | 0s | 0s | BEGIN | Package::Stash::
0 | 0 | 0 | 0s | 0s | list_all_package_symbols | Package::Stash::
0 | 0 | 0 | 0s | 0s | remove_package_glob | Package::Stash::
0 | 0 | 0 | 0s | 0s | remove_package_symbol | Package::Stash::
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 | 365 | 560µs | 2µs | my $class = shift; |
15 | my ($package) = @_; | |||
16 | my $namespace; | |||
17 | { | |||
18 | 3 | 543µs | 181µ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 | 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 | 72 | 149µs | 2µs | my ($self, $variable) = @_; |
50 | ||||
51 | (defined $variable && length $variable) | |||
52 | || confess "You must pass a variable name"; | |||
53 | ||||
54 | my $sigil = substr($variable, 0, 1, ''); | |||
55 | ||||
56 | 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 | 1191 | 3.10ms | 3µs | my $self = shift; |
68 | my ($value, $type) = @_; | |||
69 | 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 | 3405 | 10.6ms | 3µs | my ($self, $variable, $initial_value, %opts) = @_; |
81 | ||||
82 | my ($name, $sigil, $type) = ref $variable eq 'HASH' | |||
83 | ? @{$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 | my $pkg = $self->name; # spent 2.69ms making 681 calls to Package::Stash::name, avg 4µs/call | |||
87 | ||||
88 | 794 | 2.57ms | 3µs | if (@_ > 2) { |
89 | $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 | 1985 | 4.15ms | 2µs | if ($^P and $^P & 0x10 && $sigil eq '&') { |
94 | my $filename = $opts{filename}; | |||
95 | my $first_line_num = $opts{first_line_num}; | |||
96 | ||||
97 | (undef, $filename, $first_line_num) = caller | |||
98 | if not defined $filename; | |||
99 | ||||
100 | my $last_line_num = $opts{last_line_num} || ($first_line_num ||= 0); | |||
101 | ||||
102 | # http://perldoc.perl.org/perldebguts.html#Debugger-Internals | |||
103 | $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 | *{$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 | 78 | 259µs | 3µs | my ($self, $variable) = @_; |
124 | ||||
125 | my ($name, $sigil, $type) = ref $variable eq 'HASH' | |||
126 | ? @{$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 | my $namespace = $self->namespace; # spent 55µs making 14 calls to Package::Stash::namespace, avg 4µs/call | |||
130 | ||||
131 | return unless exists $namespace->{$name}; | |||
132 | ||||
133 | my $entry_ref = \$namespace->{$name}; | |||
134 | 11 | 29µs | 3µ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 | 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 | 5502 | 11.3ms | 2µs | my ($self, $variable, %opts) = @_; |
152 | ||||
153 | my ($name, $sigil, $type) = ref $variable eq 'HASH' | |||
154 | ? @{$variable}{qw[name sigil type]} | |||
155 | : $self->_deconstruct_variable_name($variable); | |||
156 | ||||
157 | my $namespace = $self->namespace; # spent 3.43ms making 917 calls to Package::Stash::namespace, avg 4µs/call | |||
158 | ||||
159 | 284 | 406µs | 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 | 943µs | 3µ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 | $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 | my $entry_ref = \$namespace->{$name}; | |||
179 | ||||
180 | 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 | 208 | 479µs | 2µs | my $self = shift; |
197 | $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 |