Make get_all_package_symbols return a hashref in scalar context.
Florian Ragwitz [Fri, 5 Dec 2008 06:20:10 +0000 (06:20 +0000)]
Also deprecate usage in list context with a warning.

MOP.xs
lib/Class/MOP/Class.pm
lib/Class/MOP/Package.pm
t/080_meta_package.t
t/304_constant_codeinfo.t

diff --git a/MOP.xs b/MOP.xs
index 4499227..bf5b6a4 100644 (file)
--- a/MOP.xs
+++ b/MOP.xs
@@ -329,10 +329,6 @@ get_all_package_symbols(self, filter=TYPE_FILTER_NONE)
             XSRETURN_EMPTY;
         }
 
-        switch (GIMME_V) {
-            case G_VOID: return; break;
-            case G_SCALAR: ST(0) = &PL_sv_undef; return; break;
-        }
 
         PUTBACK;
 
@@ -342,15 +338,31 @@ get_all_package_symbols(self, filter=TYPE_FILTER_NONE)
 
 
         if (!stash) {
-            XSRETURN_EMPTY;
+            switch (GIMME_V) {
+                case G_SCALAR: XSRETURN_UNDEF; break;
+                case G_ARRAY:  XSRETURN_EMPTY; break;
+            }
         }
 
         symbols = get_all_package_symbols(stash, filter);
 
-        EXTEND(SP, HvKEYS(symbols) * 2);
-        while ((he = hv_iternext(symbols))) {
-            PUSHs(hv_iterkeysv(he));
-            PUSHs(sv_2mortal(SvREFCNT_inc(HeVAL(he))));
+        switch (GIMME_V) {
+            case G_SCALAR:
+                PUSHs(sv_2mortal(newRV_inc((SV *)symbols)));
+                break;
+            case G_ARRAY:
+                warn("Class::MOP::Package::get_all_package_symbols in list context is deprecated. use scalar context instead.");
+
+                EXTEND(SP, HvKEYS(symbols) * 2);
+
+                while ((he = hv_iternext(symbols))) {
+                    PUSHs(hv_iterkeysv(he));
+                    PUSHs(sv_2mortal(SvREFCNT_inc(HeVAL(he))));
+                }
+
+                break;
+            default:
+                break;
         }
 
         SvREFCNT_dec((SV *)symbols);
index bc392a6..26c81ad 100644 (file)
@@ -330,10 +330,10 @@ sub get_method_map {
 
     my $method_metaclass = $self->method_metaclass;
 
-    my %all_code = $self->get_all_package_symbols('CODE');
+    my $all_code = $self->get_all_package_symbols('CODE');
 
-    foreach my $symbol (keys %all_code) {
-        my $code = $all_code{$symbol};
+    foreach my $symbol (keys %{ $all_code }) {
+        my $code = $all_code->{$symbol};
 
         next if exists  $map->{$symbol} &&
                 defined $map->{$symbol} &&
index 96ad798..de1f99d 100644 (file)
@@ -283,13 +283,18 @@ sub get_all_package_symbols {
 
     my $namespace = $self->namespace;
 
-    return %$namespace unless defined $type_filter;
+    if (wantarray) {
+        warn 'Class::MOP::Package::get_all_package_symbols in list context is deprecated. use scalar context instead.';
+    }
+
+    return (wantarray ? %$namespace : $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';
-        return map {
+        %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
@@ -303,12 +308,14 @@ sub get_all_package_symbols {
                             : () }) ) )
         } keys %$namespace;
     } else {
-        return map {
+        %ret = map {
             $_ => *{$namespace->{$_}}{$type_filter}
         } grep {
             !ref($namespace->{$_}) && *{$namespace->{$_}}{$type_filter}
         } keys %$namespace;
     }
+
+    return wantarray ? %ret : \%ret;
 }
 
 1;
index 4a8b03e..4ef0554 100644 (file)
@@ -234,46 +234,46 @@ is(Foo->meta->get_package_symbol('@foo'), $ARRAY, '... got the right values for
 # get_all_package_symbols
 
 {
-    my %syms = Foo->meta->get_all_package_symbols;
+    my $syms = Foo->meta->get_all_package_symbols;
     is_deeply(
-        [ sort keys %syms ],
+        [ sort keys %{ $syms } ],
         [ sort Foo->meta->list_all_package_symbols ],
         '... the fetched symbols are the same as the listed ones'
     ); 
 }
 
 {
-    my %syms = Foo->meta->get_all_package_symbols('CODE');
+    my $syms = Foo->meta->get_all_package_symbols('CODE');
 
     is_deeply(
-        [ sort keys %syms ],
+        [ sort keys %{ $syms } ],
         [ sort Foo->meta->list_all_package_symbols('CODE') ],
         '... the fetched symbols are the same as the listed ones'
     );
     
-    foreach my $symbol (keys %syms) {
-        is($syms{$symbol}, Foo->meta->get_package_symbol('&' . $symbol), '... got the right symbol');
+    foreach my $symbol (keys %{ $syms }) {
+        is($syms->{$symbol}, Foo->meta->get_package_symbol('&' . $symbol), '... got the right symbol');
     } 
 }
 
 {
     Foo->meta->add_package_symbol('%zork');
 
-    my %syms = Foo->meta->get_all_package_symbols('HASH');
+    my $syms = Foo->meta->get_all_package_symbols('HASH');
 
     is_deeply(
-        [ sort keys %syms ],
+        [ sort keys %{ $syms } ],
         [ sort Foo->meta->list_all_package_symbols('HASH') ],
         '... the fetched symbols are the same as the listed ones'
     );
 
-    foreach my $symbol (keys %syms) {
-        is($syms{$symbol}, Foo->meta->get_package_symbol('%' . $symbol), '... got the right symbol');
+    foreach my $symbol (keys %{ $syms }) {
+        is($syms->{$symbol}, Foo->meta->get_package_symbol('%' . $symbol), '... got the right symbol');
     }
 
     no warnings 'once';
     is_deeply(
-        \%syms,
+        $syms,
         { zork => \%Foo::zork },
         "got the right ones",
     );
index eae71e5..463b4ca 100644 (file)
@@ -13,10 +13,10 @@ use Class::MOP;
 
 my $meta = Class::MOP::Class->initialize('Foo');
 
-my %syms = $meta->get_all_package_symbols('CODE');
-is(ref $syms{FOO}, 'CODE', 'get constant symbol');
+my $syms = $meta->get_all_package_symbols('CODE');
+is(ref $syms->{FOO}, 'CODE', 'get constant symbol');
 
-undef %syms;
+undef $syms;
 
-%syms = $meta->get_all_package_symbols('CODE');
-is(ref $syms{FOO}, 'CODE', 'constant symbol still there, although we dropped our reference');
+$syms = $meta->get_all_package_symbols('CODE');
+is(ref $syms->{FOO}, 'CODE', 'constant symbol still there, although we dropped our reference');