File Coverage

blib/lib/Package/Subroutine/Namespace.pm

Criterion	Covered	Total	%
statement	36	40	90.0
branch	4	6	66.6
condition			n/a
subroutine	6	6	100.0
pod	2	2	100.0
total	48	54	88.8

  package Package::Subroutine::Namespace;
# ***************************************
  use strict; use warnings;
  our $VERSION='0.10';
# ********************

; use Carp ()
; use Perl6::Junction ()

; our $ROOT = \%::
; our %namespace

; sub list_namespaces
    { my ($self,$package) = @_
    ; local %namespace = %$ROOT
    ; $package =~ s/::$//
    ; my @path = split /::/, $package
    ; while(my $pkg = shift @path)
        { if(exists $namespace{"${pkg}::"})
            { %namespace = %{$namespace{$pkg."::"}}
            }
          else
            { Carp::carp("Package \"$package\" not available.")
            ; return ()
            }
        }
    ; map { s/::$// ; $_ } ## no critic
      grep { /::$/ } keys %namespace
    }

; sub delete_namespaces
    { my ($self,$package,@keep) = @_
    ; $package =~ s/::$//
    ; my @path = split /::/, $package
    ; my @children = $self->list_namespaces($package)
    ; my $namespace = $ROOT
    ; while(my $pkg = shift @path)
        { if(exists $namespace->{"${pkg}::"})
            { $namespace = \%{$namespace->{"${pkg}::"}}
            }
          else
            { Carp::carp("Package \"$package\" not found.")
            ; return
            }
        }
    ; for my $chld (@children)
        { next if $chld eq Perl6::Junction::any(@keep)
        ; delete $namespace->{"${chld}::"}
        }
    }

; 1

__END__