[gitmo/Class-MOP.git] / lib / Class / MOP / Package.pm


package Class::MOP::Package;

use strict;
use warnings;

use B;
use Scalar::Util 'blessed';
use Carp         'confess';

our $VERSION   = '0.71_01';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';

use base 'Class::MOP::Object';

# creation ...

sub initialize {
    my ( $class, @args ) = @_;

    unshift @args, "package" if @args % 2;

    my %options = @args;
    my $package_name = $options{package};


    # we hand-construct the class 
    # until we can bootstrap it
    if ( my $meta = Class::MOP::get_metaclass_by_name($package_name) ) {
        return $meta;
    } else {
        my $meta = ( ref $class || $class )->_new({
            'package'   => $package_name,
        });

        Class::MOP::store_metaclass_by_name($package_name, $meta);

        return $meta;
    }
}

sub reinitialize {
    my ( $class, @args ) = @_;

    unshift @args, "package" if @args % 2;

    my %options = @args;
    my $package_name = delete $options{package};

    (defined $package_name && $package_name && !blessed($package_name))
        || confess "You must pass a package name and it cannot be blessed";

    Class::MOP::remove_metaclass_by_name($package_name);

    $class->initialize($package_name, %options); # call with first arg form for compat
}

sub _new {
    my $class = shift;
    my $options = @_ == 1 ? $_[0] : {@_};

    # NOTE:
    # because of issues with the Perl API 
    # to the typeglob in some versions, we 
    # need to just always grab a new 
    # reference to the hash in the accessor. 
    # Ideally we could just store a ref and 
    # it would Just Work, but oh well :\
    $options->{namespace} ||= \undef;

    bless $options, $class;
}

# Attributes

# NOTE:
# all these attribute readers will be bootstrapped 
# away in the Class::MOP bootstrap section

sub name      { $_[0]->{'package'} }
sub namespace { 
    # NOTE:
    # because of issues with the Perl API 
    # to the typeglob in some versions, we 
    # need to just always grab a new 
    # reference to the hash here. Ideally 
    # we could just store a ref and it would
    # Just Work, but oh well :\    
    no strict 'refs';    
    \%{$_[0]->{'package'} . '::'} 
}

# utility methods

{
    my %SIGIL_MAP = (
        '$' => 'SCALAR',
        '@' => 'ARRAY',
        '%' => 'HASH',
        '&' => 'CODE',
    );
    
    sub _deconstruct_variable_name {
        my ($self, $variable) = @_;

        (defined $variable)
            || confess "You must pass a variable name";    

        my $sigil = substr($variable, 0, 1, '');

        (defined $sigil)
            || confess "The variable name must include a sigil";    

        (exists $SIGIL_MAP{$sigil})
            || confess "I do not recognize that sigil '$sigil'";    
        
        return ($variable, $sigil, $SIGIL_MAP{$sigil});
    }
}

# Class attributes

# ... these functions have to touch the symbol table itself,.. yuk

sub add_package_symbol {
    my ($self, $variable, $initial_value) = @_;

    my ($name, $sigil, $type) = ref $variable eq 'HASH'
        ? @{$variable}{qw[name sigil type]}
        : $self->_deconstruct_variable_name($variable); 

    my $pkg = $self->{'package'};

    no strict 'refs';
    no warnings 'redefine', 'misc';    
    *{$pkg . '::' . $name} = ref $initial_value ? $initial_value : \$initial_value;      
}

sub remove_package_glob {
    my ($self, $name) = @_;
    no strict 'refs';        
    delete ${$self->name . '::'}{$name};     
}

# ... these functions deal with stuff on the namespace level

sub has_package_symbol {
    my ($self, $variable) = @_;

    my ($name, $sigil, $type) = ref $variable eq 'HASH'
        ? @{$variable}{qw[name sigil type]}
        : $self->_deconstruct_variable_name($variable);
    
    my $namespace = $self->namespace;
    
    return 0 unless exists $namespace->{$name};   
    
    # FIXME:
    # For some really stupid reason 
    # a typeglob will have a default
    # value of \undef in the SCALAR 
    # slot, so we need to work around
    # this. Which of course means that 
    # if you put \undef in your scalar
    # then this is broken.

    if (ref($namespace->{$name}) eq 'SCALAR') {
        return ($type eq 'CODE');
    }
    elsif ($type eq 'SCALAR') {    
        my $val = *{$namespace->{$name}}{$type};
        return defined(${$val});
    }
    else {
        defined(*{$namespace->{$name}}{$type});
    }
}

sub get_package_symbol {
    my ($self, $variable) = @_;    

    my ($name, $sigil, $type) = ref $variable eq 'HASH'
        ? @{$variable}{qw[name sigil type]}
        : $self->_deconstruct_variable_name($variable);

    my $namespace = $self->namespace;

    $self->add_package_symbol($variable)
        unless exists $namespace->{$name};

    if (ref($namespace->{$name}) eq 'SCALAR') {
        if ($type eq 'CODE') {
            no strict 'refs';
            return \&{$self->name.'::'.$name};
        }
        else {
            return undef;
        }
    }
    else {
        return *{$namespace->{$name}}{$type};
    }
}

sub remove_package_symbol {
    my ($self, $variable) = @_;

    my ($name, $sigil, $type) = ref $variable eq 'HASH'
        ? @{$variable}{qw[name sigil type]}
        : $self->_deconstruct_variable_name($variable);

    # FIXME:
    # no doubt this is grossly inefficient and 
    # could be done much easier and faster in XS

    my ($scalar_desc, $array_desc, $hash_desc, $code_desc) = (
        { sigil => '$', type => 'SCALAR', name => $name },
        { sigil => '@', type => 'ARRAY',  name => $name },
        { sigil => '%', type => 'HASH',   name => $name },
        { sigil => '&', type => 'CODE',   name => $name },
    );

    my ($scalar, $array, $hash, $code);
    if ($type eq 'SCALAR') {
        $array  = $self->get_package_symbol($array_desc)  if $self->has_package_symbol($array_desc);
        $hash   = $self->get_package_symbol($hash_desc)   if $self->has_package_symbol($hash_desc);     
        $code   = $self->get_package_symbol($code_desc)   if $self->has_package_symbol($code_desc);     
    }
    elsif ($type eq 'ARRAY') {
        $scalar = $self->get_package_symbol($scalar_desc) if $self->has_package_symbol($scalar_desc);
        $hash   = $self->get_package_symbol($hash_desc)   if $self->has_package_symbol($hash_desc);     
        $code   = $self->get_package_symbol($code_desc)   if $self->has_package_symbol($code_desc);
    }
    elsif ($type eq 'HASH') {
        $scalar = $self->get_package_symbol($scalar_desc) if $self->has_package_symbol($scalar_desc);
        $array  = $self->get_package_symbol($array_desc)  if $self->has_package_symbol($array_desc);        
        $code   = $self->get_package_symbol($code_desc)   if $self->has_package_symbol($code_desc);      
    }
    elsif ($type eq 'CODE') {
        $scalar = $self->get_package_symbol($scalar_desc) if $self->has_package_symbol($scalar_desc);
        $array  = $self->get_package_symbol($array_desc)  if $self->has_package_symbol($array_desc);        
        $hash   = $self->get_package_symbol($hash_desc)   if $self->has_package_symbol($hash_desc);        
    }    
    else {
        confess "This should never ever ever happen";
    }
        
    $self->remove_package_glob($name);
    
    $self->add_package_symbol($scalar_desc => $scalar) if defined $scalar;      
    $self->add_package_symbol($array_desc  => $array)  if defined $array;    
    $self->add_package_symbol($hash_desc   => $hash)   if defined $hash;
    $self->add_package_symbol($code_desc   => $code)   if defined $code;            
}

sub list_all_package_symbols {
    my ($self, $type_filter) = @_;

    my $namespace = $self->namespace;
    return keys %{$namespace} unless defined $type_filter;
    
    # NOTE:
    # or we can filter based on 
    # type (SCALAR|ARRAY|HASH|CODE)
    if ( $type_filter eq 'CODE' ) {
        return grep { 
        (ref($namespace->{$_})
                ? (ref($namespace->{$_}) eq 'SCALAR')
                : (ref(\$namespace->{$_}) eq 'GLOB'
                   && defined(*{$namespace->{$_}}{CODE})));
        } keys %{$namespace};
    } else {
        return grep { *{$namespace->{$_}}{$type_filter} } keys %{$namespace};
    }
}

sub get_all_package_symbols {
    my ($self, $type_filter) = @_;

    die "Cannot call get_all_package_symbols as a class method"
        unless ref $self;

    my $namespace = $self->namespace;

    return %$namespace unless defined $type_filter;

    # for some reason this nasty impl is orders of magnitude faster than a clean version
    if ( $type_filter eq 'CODE' ) {
        my $pkg;
        no strict 'refs';
        return map {
            (ref($namespace->{$_})
                ? ( $_ => \&{$pkg ||= $self->name . "::$_"} )
                : ( ref \$namespace->{$_} eq 'GLOB' # don't use {CODE} unless it's really a glob to prevent stringification of stubs
                    && (*{$namespace->{$_}}{CODE})  # the extra parents prevent breakage on 5.8.2
                    ? ( $_ => *{$namespace->{$_}}{CODE} )
                    : (do {
                        my $sym = B::svref_2object(\$namespace->{$_});
                        my $svt = ref $sym if $sym;
                        ($sym && ($svt eq 'B::PV' || $svt eq 'B::IV'))
                            ? ($_ => ($pkg ||= $self->name)->can($_))
                            : () }) ) )
        } keys %$namespace;
    } else {
        return map {
            $_ => *{$namespace->{$_}}{$type_filter}
        } grep {
            !ref($namespace->{$_}) && *{$namespace->{$_}}{$type_filter}
        } keys %$namespace;
    }
}

1;

__END__

=pod

=head1 NAME 

Class::MOP::Package - Package Meta Object

=head1 DESCRIPTION

This is an abstraction of a Perl 5 package, it is a superclass of
L<Class::MOP::Class> and provides all of the symbol table 
introspection methods.

=head1 METHODS

=over 4

=item B<meta>

Returns a metaclass for this package.

=item B<initialize ($package_name)>

This will initialize a Class::MOP::Package instance which represents 
the package of C<$package_name>.

=item B<reinitialize ($package_name, %options)>

This removes the old metaclass, and creates a new one in it's place.
Do B<not> use this unless you really know what you are doing, it could
very easily make a very large mess of your program.

=item B<name>

This is a read-only attribute which returns the package name for the 
given instance.

=item B<namespace>

This returns a HASH reference to the symbol table. The keys of the 
HASH are the symbol names, and the values are typeglob references.

=item B<add_package_symbol ($variable_name, ?$initial_value)>

Given a C<$variable_name>, which must contain a leading sigil, this 
method will create that variable within the package which houses the 
class. It also takes an optional C<$initial_value>, which must be a 
reference of the same type as the sigil of the C<$variable_name> 
implies.

=item B<get_package_symbol ($variable_name)>

This will return a reference to the package variable in 
C<$variable_name>. 

=item B<has_package_symbol ($variable_name)>

Returns true (C<1>) if there is a package variable defined for 
C<$variable_name>, and false (C<0>) otherwise.

=item B<remove_package_symbol ($variable_name)>

This will attempt to remove the package variable at C<$variable_name>.

=item B<remove_package_glob ($glob_name)>

This will attempt to remove the entire typeglob associated with 
C<$glob_name> from the package. 

=item B<list_all_package_symbols (?$type_filter)>

This will list all the glob names associated with the current package. 
By inspecting the globs returned you can discern all the variables in 
the package.

By passing a C<$type_filter>, you can limit the list to only those 
which match the filter (either SCALAR, ARRAY, HASH or CODE).

=item B<get_all_package_symbols (?$type_filter)>

Works exactly like C<list_all_package_symbols> but returns a HASH of 
name => thing mapping instead of just an ARRAY of names.

=back

=head1 AUTHORS

Stevan Little E<lt>stevan@iinteractive.comE<gt>

=head1 COPYRIGHT AND LICENSE

Copyright 2006-2008 by Infinity Interactive, Inc.

L<http://www.iinteractive.com>

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.

=cut
Commit	Line	Data
2243a22b	1
	2	package Class::MOP::Package;
	3
	4	use strict;
	5	use warnings;
	6
b1cd37c2	7	use B;
2243a22b	8	use Scalar::Util 'blessed';
6d5355c3	9	use Carp 'confess';
2243a22b	10
34147f49	11	our $VERSION = '0.71_01';
d519662a	12	$VERSION = eval $VERSION;
f0480c45	13	our $AUTHORITY = 'cpan:STEVAN';
2243a22b	14
6e57504d	15	use base 'Class::MOP::Object';
6e57504d	16
6d5355c3	17	# creation ...
	18
	19	sub initialize {
3be6bc1c	20	my ( $class, @args ) = @_;
	21
	22	unshift @args, "package" if @args % 2;
	23
	24	my %options = @args;
	25	my $package_name = $options{package};
	26
	27
9d6dce77	28	# we hand-construct the class
9d6dce77	29	# until we can bootstrap it
a19fcb5b	30	if ( my $meta = Class::MOP::get_metaclass_by_name($package_name) ) {
973de492	31	return $meta;
a19fcb5b	32	} else {
973de492	33	my $meta = ( ref $class \|\| $class )->_new({
	34	'package' => $package_name,
	35	});
a19fcb5b	36
973de492	37	Class::MOP::store_metaclass_by_name($package_name, $meta);
a19fcb5b	38
973de492	39	return $meta;
a19fcb5b	40	}
	41	}
	42
	43	sub reinitialize {
3be6bc1c	44	my ( $class, @args ) = @_;
	45
	46	unshift @args, "package" if @args % 2;
	47
	48	my %options = @args;
3eda22f8	49	my $package_name = delete $options{package};
3be6bc1c	50
a19fcb5b	51	(defined $package_name && $package_name && !blessed($package_name))
a19fcb5b	52	\|\| confess "You must pass a package name and it cannot be blessed";
3be6bc1c	53
a19fcb5b	54	Class::MOP::remove_metaclass_by_name($package_name);
3be6bc1c	55
3eda22f8	56	$class->initialize($package_name, %options); # call with first arg form for compat
682655a3	57	}
	58
	59	sub _new {
0bfc85b8	60	my $class = shift;
0bfc85b8	61	my $options = @_ == 1 ? $_[0] : {@_};
682655a3	62
0bfc85b8	63	# NOTE:
	64	# because of issues with the Perl API
	65	# to the typeglob in some versions, we
	66	# need to just always grab a new
	67	# reference to the hash in the accessor.
	68	# Ideally we could just store a ref and
	69	# it would Just Work, but oh well :\
	70	$options->{namespace} \|\|= \undef;
	71
	72	bless $options, $class;
6d5355c3	73	}
	74
	75	# Attributes
	76
	77	# NOTE:
	78	# all these attribute readers will be bootstrapped
	79	# away in the Class::MOP bootstrap section
	80
8683db0e	81	sub name { $_[0]->{'package'} }
56dcfc1a	82	sub namespace {
	83	# NOTE:
	84	# because of issues with the Perl API
	85	# to the typeglob in some versions, we
	86	# need to just always grab a new
	87	# reference to the hash here. Ideally
	88	# we could just store a ref and it would
	89	# Just Work, but oh well :\
	90	no strict 'refs';
8683db0e	91	\%{$_[0]->{'package'} . '::'}
56dcfc1a	92	}
6d5355c3	93
a5e51f0b	94	# utility methods
6d5355c3	95
c0cbf4d9	96	{
	97	my %SIGIL_MAP = (
	98	'$' => 'SCALAR',
	99	'@' => 'ARRAY',
	100	'%' => 'HASH',
	101	'&' => 'CODE',
	102	);
6d5355c3	103
a5e51f0b	104	sub _deconstruct_variable_name {
	105	my ($self, $variable) = @_;
	106
c0cbf4d9	107	(defined $variable)
c0cbf4d9	108	\|\| confess "You must pass a variable name";
a5e51f0b	109
f430cfa4	110	my $sigil = substr($variable, 0, 1, '');
a5e51f0b	111
c0cbf4d9	112	(defined $sigil)
c0cbf4d9	113	\|\| confess "The variable name must include a sigil";
a5e51f0b	114
c0cbf4d9	115	(exists $SIGIL_MAP{$sigil})
a5e51f0b	116	\|\| confess "I do not recognize that sigil '$sigil'";
a5e51f0b	117
f430cfa4	118	return ($variable, $sigil, $SIGIL_MAP{$sigil});
c0cbf4d9	119	}
a5e51f0b	120	}
6d5355c3	121
a5e51f0b	122	# Class attributes
6d5355c3	123
c46b802b	124	# ... these functions have to touch the symbol table itself,.. yuk
c46b802b	125
a5e51f0b	126	sub add_package_symbol {
a5e51f0b	127	my ($self, $variable, $initial_value) = @_;
6d5355c3	128
8b49a472	129	my ($name, $sigil, $type) = ref $variable eq 'HASH'
	130	? @{$variable}{qw[name sigil type]}
	131	: $self->_deconstruct_variable_name($variable);
6d5355c3	132
8683db0e	133	my $pkg = $self->{'package'};
9a8bbfc9	134
a5e51f0b	135	no strict 'refs';
56dcfc1a	136	no warnings 'redefine', 'misc';
9a8bbfc9	137	*{$pkg . '::' . $name} = ref $initial_value ? $initial_value : \$initial_value;
c46b802b	138	}
	139
	140	sub remove_package_glob {
	141	my ($self, $name) = @_;
	142	no strict 'refs';
	143	delete ${$self->name . '::'}{$name};
a5e51f0b	144	}
6d5355c3	145
c46b802b	146	# ... these functions deal with stuff on the namespace level
c46b802b	147
a5e51f0b	148	sub has_package_symbol {
	149	my ($self, $variable) = @_;
	150
8b49a472	151	my ($name, $sigil, $type) = ref $variable eq 'HASH'
	152	? @{$variable}{qw[name sigil type]}
	153	: $self->_deconstruct_variable_name($variable);
56dcfc1a	154
ae234dc6	155	my $namespace = $self->namespace;
	156
	157	return 0 unless exists $namespace->{$name};
d852f4d2	158
	159	# FIXME:
	160	# For some really stupid reason
	161	# a typeglob will have a default
	162	# value of \undef in the SCALAR
	163	# slot, so we need to work around
	164	# this. Which of course means that
	165	# if you put \undef in your scalar
	166	# then this is broken.
92af7fdf	167
ae234dc6	168	if (ref($namespace->{$name}) eq 'SCALAR') {
b3fa93c7	169	return ($type eq 'CODE');
92af7fdf	170	}
92af7fdf	171	elsif ($type eq 'SCALAR') {
ae234dc6	172	my $val = *{$namespace->{$name}}{$type};
b3fa93c7	173	return defined(${$val});
d852f4d2	174	}
d852f4d2	175	else {
b3fa93c7	176	defined(*{$namespace->{$name}}{$type});
d852f4d2	177	}
a5e51f0b	178	}
	179
	180	sub get_package_symbol {
	181	my ($self, $variable) = @_;
	182
8b49a472	183	my ($name, $sigil, $type) = ref $variable eq 'HASH'
	184	? @{$variable}{qw[name sigil type]}
	185	: $self->_deconstruct_variable_name($variable);
a5e51f0b	186
ae234dc6	187	my $namespace = $self->namespace;
ae234dc6	188
c20522bd	189	$self->add_package_symbol($variable)
ae234dc6	190	unless exists $namespace->{$name};
92af7fdf	191
ae234dc6	192	if (ref($namespace->{$name}) eq 'SCALAR') {
92af7fdf	193	if ($type eq 'CODE') {
	194	no strict 'refs';
	195	return \&{$self->name.'::'.$name};
	196	}
	197	else {
	198	return undef;
	199	}
	200	}
	201	else {
ae234dc6	202	return *{$namespace->{$name}}{$type};
92af7fdf	203	}
a5e51f0b	204	}
	205
	206	sub remove_package_symbol {
	207	my ($self, $variable) = @_;
	208
8b49a472	209	my ($name, $sigil, $type) = ref $variable eq 'HASH'
	210	? @{$variable}{qw[name sigil type]}
	211	: $self->_deconstruct_variable_name($variable);
a5e51f0b	212
c46b802b	213	# FIXME:
	214	# no doubt this is grossly inefficient and
	215	# could be done much easier and faster in XS
	216
8b49a472	217	my ($scalar_desc, $array_desc, $hash_desc, $code_desc) = (
	218	{ sigil => '$', type => 'SCALAR', name => $name },
	219	{ sigil => '@', type => 'ARRAY', name => $name },
	220	{ sigil => '%', type => 'HASH', name => $name },
	221	{ sigil => '&', type => 'CODE', name => $name },
	222	);
	223
c46b802b	224	my ($scalar, $array, $hash, $code);
a5e51f0b	225	if ($type eq 'SCALAR') {
8b49a472	226	$array = $self->get_package_symbol($array_desc) if $self->has_package_symbol($array_desc);
	227	$hash = $self->get_package_symbol($hash_desc) if $self->has_package_symbol($hash_desc);
	228	$code = $self->get_package_symbol($code_desc) if $self->has_package_symbol($code_desc);
a5e51f0b	229	}
a5e51f0b	230	elsif ($type eq 'ARRAY') {
8b49a472	231	$scalar = $self->get_package_symbol($scalar_desc) if $self->has_package_symbol($scalar_desc);
	232	$hash = $self->get_package_symbol($hash_desc) if $self->has_package_symbol($hash_desc);
	233	$code = $self->get_package_symbol($code_desc) if $self->has_package_symbol($code_desc);
a5e51f0b	234	}
a5e51f0b	235	elsif ($type eq 'HASH') {
8b49a472	236	$scalar = $self->get_package_symbol($scalar_desc) if $self->has_package_symbol($scalar_desc);
	237	$array = $self->get_package_symbol($array_desc) if $self->has_package_symbol($array_desc);
	238	$code = $self->get_package_symbol($code_desc) if $self->has_package_symbol($code_desc);
a5e51f0b	239	}
a5e51f0b	240	elsif ($type eq 'CODE') {
8b49a472	241	$scalar = $self->get_package_symbol($scalar_desc) if $self->has_package_symbol($scalar_desc);
	242	$array = $self->get_package_symbol($array_desc) if $self->has_package_symbol($array_desc);
	243	$hash = $self->get_package_symbol($hash_desc) if $self->has_package_symbol($hash_desc);
a5e51f0b	244	}
	245	else {
	246	confess "This should never ever ever happen";
7f436b8c	247	}
c46b802b	248
	249	$self->remove_package_glob($name);
	250
8b49a472	251	$self->add_package_symbol($scalar_desc => $scalar) if defined $scalar;
	252	$self->add_package_symbol($array_desc => $array) if defined $array;
	253	$self->add_package_symbol($hash_desc => $hash) if defined $hash;
	254	$self->add_package_symbol($code_desc => $code) if defined $code;
9d6dce77	255	}
c0cbf4d9	256
9d6dce77	257	sub list_all_package_symbols {
92330ee2	258	my ($self, $type_filter) = @_;
a38e4d1a	259
	260	my $namespace = $self->namespace;
	261	return keys %{$namespace} unless defined $type_filter;
	262
91e0eb4a	263	# NOTE:
92330ee2	264	# or we can filter based on
92330ee2	265	# type (SCALAR\|ARRAY\|HASH\|CODE)
3609af79	266	if ( $type_filter eq 'CODE' ) {
3609af79	267	return grep {
92af7fdf	268	(ref($namespace->{$_})
3609af79	269	? (ref($namespace->{$_}) eq 'SCALAR')
	270	: (ref(\$namespace->{$_}) eq 'GLOB'
	271	&& defined(*{$namespace->{$_}}{CODE})));
	272	} keys %{$namespace};
	273	} else {
	274	return grep { *{$namespace->{$_}}{$type_filter} } keys %{$namespace};
	275	}
6d5355c3	276	}
6d5355c3	277
0531f510	278	sub get_all_package_symbols {
0531f510	279	my ($self, $type_filter) = @_;
87b69f58	280
	281	die "Cannot call get_all_package_symbols as a class method"
	282	unless ref $self;
	283
0531f510	284	my $namespace = $self->namespace;
15273f3c	285
0531f510	286	return %$namespace unless defined $type_filter;
0531f510	287
e5ebdca9	288	# for some reason this nasty impl is orders of magnitude faster than a clean version
0531f510	289	if ( $type_filter eq 'CODE' ) {
	290	my $pkg;
	291	no strict 'refs';
	292	return map {
	293	(ref($namespace->{$_})
	294	? ( $_ => \&{$pkg \|\|= $self->name . "::$_"} )
361c0e55	295	: ( ref \$namespace->{$_} eq 'GLOB' # don't use {CODE} unless it's really a glob to prevent stringification of stubs
361c0e55	296	&& (*{$namespace->{$_}}{CODE}) # the extra parents prevent breakage on 5.8.2
33f5d8ec	297	? ( $_ => *{$namespace->{$_}}{CODE} )
b1cd37c2	298	: (do {
	299	my $sym = B::svref_2object(\$namespace->{$_});
	300	my $svt = ref $sym if $sym;
361c0e55	301	($sym && ($svt eq 'B::PV' \|\| $svt eq 'B::IV'))
b1cd37c2	302	? ($_ => ($pkg \|\|= $self->name)->can($_))
b1cd37c2	303	: () }) ) )
0531f510	304	} keys %$namespace;
	305	} else {
	306	return map {
	307	$_ => *{$namespace->{$_}}{$type_filter}
	308	} grep {
	309	!ref($namespace->{$_}) && *{$namespace->{$_}}{$type_filter}
	310	} keys %$namespace;
	311	}
ae234dc6	312	}
ae234dc6	313
2243a22b	314	1;
	315
	316	__END__
	317
	318	=pod
	319
	320	=head1 NAME
	321
	322	Class::MOP::Package - Package Meta Object
	323
2243a22b	324	=head1 DESCRIPTION
2243a22b	325
127d39a7	326	This is an abstraction of a Perl 5 package, it is a superclass of
	327	L<Class::MOP::Class> and provides all of the symbol table
	328	introspection methods.
	329
2243a22b	330	=head1 METHODS
	331
	332	=over 4
	333
	334	=item B<meta>
	335
127d39a7	336	Returns a metaclass for this package.
127d39a7	337
b9d9fc0b	338	=item B<initialize ($package_name)>
6d5355c3	339
127d39a7	340	This will initialize a Class::MOP::Package instance which represents
	341	the package of C<$package_name>.
	342
a19fcb5b	343	=item B<reinitialize ($package_name, %options)>
	344
	345	This removes the old metaclass, and creates a new one in it's place.
	346	Do B<not> use this unless you really know what you are doing, it could
	347	very easily make a very large mess of your program.
	348
6d5355c3	349	=item B<name>
6d5355c3	350
b9d9fc0b	351	This is a read-only attribute which returns the package name for the
	352	given instance.
	353
a5e51f0b	354	=item B<namespace>
a5e51f0b	355
b9d9fc0b	356	This returns a HASH reference to the symbol table. The keys of the
	357	HASH are the symbol names, and the values are typeglob references.
	358
	359	=item B<add_package_symbol ($variable_name, ?$initial_value)>
	360
	361	Given a C<$variable_name>, which must contain a leading sigil, this
	362	method will create that variable within the package which houses the
	363	class. It also takes an optional C<$initial_value>, which must be a
	364	reference of the same type as the sigil of the C<$variable_name>
	365	implies.
	366
	367	=item B<get_package_symbol ($variable_name)>
6d5355c3	368
b9d9fc0b	369	This will return a reference to the package variable in
b9d9fc0b	370	C<$variable_name>.
6d5355c3	371
b9d9fc0b	372	=item B<has_package_symbol ($variable_name)>
6d5355c3	373
b9d9fc0b	374	Returns true (C<1>) if there is a package variable defined for
b9d9fc0b	375	C<$variable_name>, and false (C<0>) otherwise.
6d5355c3	376
b9d9fc0b	377	=item B<remove_package_symbol ($variable_name)>
	378
	379	This will attempt to remove the package variable at C<$variable_name>.
	380
	381	=item B<remove_package_glob ($glob_name)>
	382
	383	This will attempt to remove the entire typeglob associated with
	384	C<$glob_name> from the package.
c46b802b	385
92330ee2	386	=item B<list_all_package_symbols (?$type_filter)>
9d6dce77	387
b9d9fc0b	388	This will list all the glob names associated with the current package.
	389	By inspecting the globs returned you can discern all the variables in
	390	the package.
	391
92330ee2	392	By passing a C<$type_filter>, you can limit the list to only those
	393	which match the filter (either SCALAR, ARRAY, HASH or CODE).
	394
ae234dc6	395	=item B<get_all_package_symbols (?$type_filter)>
	396
	397	Works exactly like C<list_all_package_symbols> but returns a HASH of
	398	name => thing mapping instead of just an ARRAY of names.
	399
2243a22b	400	=back
2243a22b	401
1a09d9cc	402	=head1 AUTHORS
2243a22b	403
	404	Stevan Little E<lt>stevan@iinteractive.comE<gt>
	405
	406	=head1 COPYRIGHT AND LICENSE
	407
69e3ab0a	408	Copyright 2006-2008 by Infinity Interactive, Inc.
2243a22b	409
	410	L<http://www.iinteractive.com>
	411
	412	This library is free software; you can redistribute it and/or modify
	413	it under the same terms as Perl itself.
	414
92af7fdf	415	=cut