diff options
Diffstat (limited to 'cpan/Test-Simple/lib/Test/Stream/PackageUtil.pm')
| -rw-r--r-- | cpan/Test-Simple/lib/Test/Stream/PackageUtil.pm | 210 |
1 files changed, 0 insertions, 210 deletions
diff --git a/cpan/Test-Simple/lib/Test/Stream/PackageUtil.pm b/cpan/Test-Simple/lib/Test/Stream/PackageUtil.pm deleted file mode 100644 index 03a82487f2..0000000000 --- a/cpan/Test-Simple/lib/Test/Stream/PackageUtil.pm +++ /dev/null @@ -1,210 +0,0 @@ -package Test::Stream::PackageUtil; -use strict; -use warnings; - -sub confess { require Carp; goto &Carp::confess } - -my @SLOTS = qw/HASH SCALAR ARRAY IO FORMAT CODE/; -my %SLOTS = map {($_ => 1)} @SLOTS; - -my %SIGMAP = ( - '&' => 'CODE', - '%' => 'HASH', - '$' => 'SCALAR', - '*' => 'IO', -); - -sub import { - my $caller = caller; - no strict 'refs'; - *{"$caller\::package_sym"} = \&package_sym; - *{"$caller\::package_purge_sym"} = \&package_purge_sym; - 1; -} - -sub package_sym { - my ($pkg, @parts) = @_; - confess "you must specify a package" unless $pkg; - - my ($slot, $name); - - if (@parts > 1) { - ($slot, $name) = @parts; - } - elsif (@parts) { - my $sig; - ($sig, $name) = $parts[0] =~ m/^(\W)?(\w+)$/; - $slot = $SIGMAP{$sig || '&'}; - } - - confess "you must specify a symbol type" unless $slot; - confess "you must specify a symbol name" unless $name; - - confess "'$slot' is not a valid symbol type! Valid: " . join(", ", @SLOTS) - unless $SLOTS{$slot}; - - no warnings 'once'; - no strict 'refs'; - return *{"$pkg\::$name"}{$slot}; -} - -sub package_purge_sym { - my ($pkg, @pairs) = @_; - - for(my $i = 0; $i < @pairs; $i += 2) { - my $purge = $pairs[$i]; - my $name = $pairs[$i + 1]; - - confess "'$purge' is not a valid symbol type! Valid: " . join(", ", @SLOTS) - unless $SLOTS{$purge}; - - no strict 'refs'; - local *GLOBCLONE = *{"$pkg\::$name"}; - my $stash = \%{"${pkg}\::"}; - delete $stash->{$name}; - for my $slot (@SLOTS) { - next if $slot eq $purge; - *{"$pkg\::$name"} = *GLOBCLONE{$slot} if defined *GLOBCLONE{$slot}; - } - } -} - -1; - -__END__ - -=pod - -=encoding UTF-8 - -=head1 NAME - -Test::Stream::PackageUtil - Utils for manipulating package symbol tables. - -=head1 DESCRIPTION - -Collection of utilities L<Test::Stream> and friends use to manipulate package -symbol tables. This is primarily useful when trackign things like C<$TODO> -vars. It is also used for exporting and meta-construction of object methods. - -=head1 EXPORTS - -Both exports are exported by default, you cannot pick and choose. These work -equally well as functions and class-methods. These will not work as object -methods. - -=over 4 - -=item $ref = package_sym($PACKAGE, $SLOT => $NAME) - -Get the reference to a symbol in the package. C<$PACKAGE> should be the package -name. C<$SLOT> should be a valid typeglob slot (Supported slots: HASH SCALAR ARRAY -IO FORMAT CODE). C<$NAME> should be the name of the symbol. - -=item package_purge_sym($PACKAGE, $SLOT => $NAME, $SLOT2 => $NAME2, ...) - -This is used to remove symbols from a package. The first argument, C<$PACKAGE>, -should be the name of the package. The remaining arguments should be key/value -pairs. The key in each pair should be the typeglob slot to clear (Supported -slots: HASH SCALAR ARRAY IO FORMAT CODE). The value in the pair should be the -name of the symbol to remove. - -=back - -=head1 SOURCE - -The source code repository for Test::More can be found at -F<http://github.com/Test-More/test-more/>. - -=head1 MAINTAINER - -=over 4 - -=item Chad Granum E<lt>exodist@cpan.orgE<gt> - -=back - -=head1 AUTHORS - -The following people have all contributed to the Test-More dist (sorted using -VIM's sort function). - -=over 4 - -=item Chad Granum E<lt>exodist@cpan.orgE<gt> - -=item Fergal Daly E<lt>fergal@esatclear.ie>E<gt> - -=item Mark Fowler E<lt>mark@twoshortplanks.comE<gt> - -=item Michael G Schwern E<lt>schwern@pobox.comE<gt> - -=item 唐鳳 - -=back - -=head1 COPYRIGHT - -There has been a lot of code migration between modules, -here are all the original copyrights together: - -=over 4 - -=item Test::Stream - -=item Test::Stream::Tester - -Copyright 2014 Chad Granum E<lt>exodist7@gmail.comE<gt>. - -This program is free software; you can redistribute it and/or -modify it under the same terms as Perl itself. - -See F<http://www.perl.com/perl/misc/Artistic.html> - -=item Test::Simple - -=item Test::More - -=item Test::Builder - -Originally authored by Michael G Schwern E<lt>schwern@pobox.comE<gt> with much -inspiration from Joshua Pritikin's Test module and lots of help from Barrie -Slaymaker, Tony Bowden, blackstar.co.uk, chromatic, Fergal Daly and the perl-qa -gang. - -Idea by Tony Bowden and Paul Johnson, code by Michael G Schwern -E<lt>schwern@pobox.comE<gt>, wardrobe by Calvin Klein. - -Copyright 2001-2008 by Michael G Schwern E<lt>schwern@pobox.comE<gt>. - -This program is free software; you can redistribute it and/or -modify it under the same terms as Perl itself. - -See F<http://www.perl.com/perl/misc/Artistic.html> - -=item Test::use::ok - -To the extent possible under law, 唐鳳 has waived all copyright and related -or neighboring rights to L<Test-use-ok>. - -This work is published from Taiwan. - -L<http://creativecommons.org/publicdomain/zero/1.0> - -=item Test::Tester - -This module is copyright 2005 Fergal Daly <fergal@esatclear.ie>, some parts -are based on other people's work. - -Under the same license as Perl itself - -See http://www.perl.com/perl/misc/Artistic.html - -=item Test::Builder::Tester - -Copyright Mark Fowler E<lt>mark@twoshortplanks.comE<gt> 2002, 2004. - -This program is free software; you can redistribute it -and/or modify it under the same terms as Perl itself. - -=back |