← Index
Performance Profile   « block view • line view • sub view »
For t/test-parsing
  Run on Sun Nov 14 09:49:57 2010
Reported on Sun Nov 14 09:50:09 2010

File /usr/local/share/perl/5.10.0/Package/Stash.pm
Statements Executed 15912
Total Time 0.0398491999999999 seconds
Subroutines — ordered by exclusive time
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
6812216.6ms23.4msPackage::Stash::::add_package_symbolPackage::Stash::add_package_symbol
9172212.1ms21.1msPackage::Stash::::get_package_symbolPackage::Stash::get_package_symbol
947323.56ms3.56msPackage::Stash::::namespacePackage::Stash::namespace
397112.89ms4.01msPackage::Stash::::_valid_for_typePackage::Stash::_valid_for_type
681112.69ms2.69msPackage::Stash::::namePackage::Stash::name
73111.02ms1.02msPackage::Stash::::newPackage::Stash::new
10411592µs3.63msPackage::Stash::::get_or_add_package_symbolPackage::Stash::get_or_add_package_symbol
1411235µs491µsPackage::Stash::::has_package_symbolPackage::Stash::has_package_symbol
1821185µs185µsPackage::Stash::::_deconstruct_variable_namePackage::Stash::_deconstruct_variable_name
0000s0sPackage::Stash::::BEGINPackage::Stash::BEGIN
0000s0sPackage::Stash::::list_all_package_symbolsPackage::Stash::list_all_package_symbols
0000s0sPackage::Stash::::remove_package_globPackage::Stash::remove_package_glob
0000s0sPackage::Stash::::remove_package_symbolPackage::Stash::remove_package_symbol
LineStmts.Exclusive
Time
Avg.Code
1package Package::Stash;
2BEGIN {
311µs1µs $Package::Stash::VERSION = '0.08';
4122µs22µs}
5329µs10µsuse strict;
# spent 14µs making 1 call to strict::import
6329µs10µsuse warnings;
# spent 22µs making 1 call to warnings::import
7# ABSTRACT: routines for manipulating stashes
8
9331µs10µsuse Carp qw(confess);
# spent 36µs making 1 call to Exporter::import
10359µs20µsuse 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
sub new {
14365560µs2µs my $class = shift;
15 my ($package) = @_;
16 my $namespace;
17 {
183543µs181µ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
2173281µs4µ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
sub name {
316811.44ms2µ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
sub namespace {
369471.70ms2µs return $_[0]->{namespace};
37}
38
39{
4025µs2µs my %SIGIL_MAP = (
41 '$' => 'SCALAR',
42 '@' => 'ARRAY',
43 '%' => 'HASH',
44 '&' => 'CODE',
45 '' => 'IO',
46 );
47
48
# spent 185µs within Package::Stash::_deconstruct_variable_name which was called 18 times, avg 10µs/call: # 14 times (158µs+0s) by Package::Stash::has_package_symbol at line 126, avg 11µs/call # 4 times (27µs+0s) by Package::Stash::add_package_symbol at line 83, avg 7µs/call
sub _deconstruct_variable_name {
4972149µs2µ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
sub _valid_for_type {
6711913.10ms3µ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
sub add_package_symbol {
80340510.6ms3µ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
887942.57ms3µ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 '&'
9319854.15ms2µ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
107328µs9µs no strict 'refs';
# spent 16µs making 1 call to strict::unimport
1083101µs34µ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
113sub remove_package_glob {
114 my ($self, $name) = @_;
1153320µs107µ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
sub has_package_symbol {
12378259µs3µ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};
1341129µs3µ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
sub get_package_symbol {
151550211.3ms2µ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
159284406µs1µ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
166284943µs3µ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') {
1853694µs231µ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
sub get_or_add_package_symbol {
196208479µs2µ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
201sub 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
265sub 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
287110µs10µs1;
288
289__END__
290=pod
291
292=head1 NAME
293
294Package::Stash - routines for manipulating stashes
295
296=head1 VERSION
297
298version 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
311Manipulating stashes (Perl's symbol tables) is occasionally necessary, but
312incredibly messy, and easy to get wrong. This module hides all of that behind a
313simple API.
314
315NOTE: Most methods in this class require a variable specification that includes
316a 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
322Creates a new C<Package::Stash> object, for the package given as the only
323argument.
324
325=head2 name
326
327Returns the name of the package that this object represents.
328
329=head2 namespace
330
331Returns the raw stash itself.
332
333=head2 add_package_symbol $variable $value %opts
334
335Adds a new package symbol, for the symbol given as C<$variable>, and optionally
336gives it an initial value of C<$value>. C<$variable> should be the name of
337variable including the sigil, so
338
339 Package::Stash->new('Foo')->add_package_symbol('%foo')
340
341will create C<%Foo::foo>.
342
343Valid options (all optional) are C<filename>, C<first_line_num>, and
344C<last_line_num>.
345
346C<$opts{filename}>, C<$opts{first_line_num}>, and C<$opts{last_line_num}> can
347be used to indicate where the symbol should be regarded as having been defined.
348Currently these values are only used if the symbol is a subroutine ('C<&>'
349sigil) and only if C<$^P & 0x10> is true, in which case the special C<%DB::sub>
350hash is updated to record the values of C<filename>, C<first_line_num>, and
351C<last_line_num> for the subroutine. If these are not passed, their values are
352inferred (as much as possible) from C<caller> information.
353
354This is especially useful for debuggers and profilers, which use C<%DB::sub> to
355determine where the source code for a subroutine can be found. See
356L<http://perldoc.perl.org/perldebguts.html#Debugger-Internals> for more
357information about C<%DB::sub>.
358
359=head2 remove_package_glob $name
360
361Removes all package variables with the given name, regardless of sigil.
362
363=head2 has_package_symbol $variable
364
365Returns whether or not the given package variable (including sigil) exists.
366
367=head2 get_package_symbol $variable
368
369Returns the value of the given package variable (including sigil).
370
371=head2 get_or_add_package_symbol $variable
372
373Like C<get_package_symbol>, except that it will return an empty hashref or
374arrayref if the variable doesn't exist.
375
376=head2 remove_package_symbol $variable
377
378Removes the package variable described by C<$variable> (which includes the
379sigil); other variables with the same name but different sigils will be
380untouched.
381
382=head2 list_all_package_symbols $type_filter
383
384Returns a list of package variable names in the package, without sigils. If a
385C<type_filter> is passed, it is used to select package variables of a given
386type, where valid types are the slots of a typeglob ('SCALAR', 'CODE', 'HASH',
387etc).
388
389=head1 BUGS
390
391No known bugs.
392
393Please report any bugs through RT: email
394C<bug-package-stash at rt.cpan.org>, or browse to
395L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Package-Stash>.
396
397=head1 SUPPORT
398
399You can find this documentation for this module with the perldoc command.
400
401 perldoc Package::Stash
402
403You can also look for information at:
404
405=over 4
406
407=item * AnnoCPAN: Annotated CPAN documentation
408
409L<http://annocpan.org/dist/Package-Stash>
410
411=item * CPAN Ratings
412
413L<http://cpanratings.perl.org/d/Package-Stash>
414
415=item * RT: CPAN's request tracker
416
417L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Package-Stash>
418
419=item * Search CPAN
420
421L<http://search.cpan.org/dist/Package-Stash>
422
423=back
424
425=head1 AUTHOR
426
427Jesse Luehrs <doy at tozt dot net>
428
429Mostly copied from code from L<Class::MOP::Package>, by Stevan Little and the
430Moose Cabal.
431
432=head1 SEE ALSO
433
434=over 4
435
436=item * L<Class::MOP::Package>
437
438This module is a factoring out of code that used to live here
439
440=back
441
442=head1 COPYRIGHT AND LICENSE
443
444This software is copyright (c) 2010 by Jesse Luehrs.
445
446This is free software; you can redistribute it and/or modify it under
447the same terms as the Perl 5 programming language system itself.
448
449=cut
450