[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.77';
$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,
            %options,
        });

        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;

    my %ret;
    # 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';
        %ret = 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 {
        %ret = map {
            $_ => *{$namespace->{$_}}{$type_filter}
        } grep {
            !ref($namespace->{$_}) && *{$namespace->{$_}}{$type_filter}
        } keys %$namespace;
    }

    return \%ret;
}

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 INHERITANCE

B<Class::MOP::Package> is a subclass of L<Class::MOP::Object>

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