Perl6-Caller-0.100000755000765000765 011266610155 13004 5ustar00ovidovid000000000000Build.PL000444000765000765 70511266610155 14340 0ustar00ovidovid000000000000Perl6-Caller-0.100use strict; use warnings; use Module::Build; my $builder = Module::Build->new( module_name => 'Perl6::Caller', license => 'perl', dist_author => 'Curtis "Ovid" Poe ', dist_version_from => 'lib/Perl6/Caller.pm', requires => { 'Test::More' => 0, }, add_to_cleanup => [ 'Perl6-Caller-*' ], create_makefile_pl => 'traditional', ); $builder->create_build_script(); Changes000444000765000765 114511266610155 14356 0ustar00ovidovid000000000000Perl6-Caller-0.100Revision history for Perl6-Caller 0.100 October 18, 2009 - Move author tests out of the way. 0.04 April 21, 2007 - Got rid of the alternate package altogether. 0.03 April 21, 2007 - Had to rename the 'caller' package to '_caller' because FindBin::libs has a 'package caller' declaration and thus the author now owns that namespace. 0.02 April 21, 2007 - First public release. - I lied. This is the second public release, but I fixed a few doc nits. 0.01 Date/time First version, released on an unsuspecting world. Makefile.PL000444000765000765 62711266610155 15021 0ustar00ovidovid000000000000Perl6-Caller-0.100# Note: this file was auto-generated by Module::Build::Compat version 0.35 use ExtUtils::MakeMaker; WriteMakefile ( 'NAME' => 'Perl6::Caller', 'VERSION_FROM' => 'lib/Perl6/Caller.pm', 'PREREQ_PM' => { 'Test::More' => 0 }, 'INSTALLDIRS' => 'site', 'EXE_FILES' => [], 'PL_FILES' => {} ) ; MANIFEST000444000765000765 24011266610155 14167 0ustar00ovidovid000000000000Perl6-Caller-0.100Build.PL Changes MANIFEST META.yml # Will be created by "make dist" README lib/Perl6/Caller.pm t/00-load.t t/10-caller.t xt/pod-coverage.t xt/pod.t Makefile.PL META.yml000444000765000765 71511266610155 14316 0ustar00ovidovid000000000000Perl6-Caller-0.100--- name: Perl6-Caller version: 0.100 author: - 'Curtis "Ovid" Poe ' abstract: OO C interface license: perl resources: license: http://dev.perl.org/licenses/ requires: Test::More: 0 configure_requires: Module::Build: 0.35 provides: Perl6::Caller: file: lib/Perl6/Caller.pm version: 0.100 generated_by: Module::Build version 0.35 meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 README000444000765000765 50011266610155 13715 0ustar00ovidovid000000000000Perl6-Caller-0.100Perl6-Caller INSTALLATION To install this module, run the following commands: perl Build.PL ./Build ./Build test ./Build install COPYRIGHT AND LICENCE Copyright (C) 2007 Curtis "Ovid" Poe This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. lib000755000765000765 011266610155 13473 5ustar00ovidovid000000000000Perl6-Caller-0.100Perl6000755000765000765 011266610155 14463 5ustar00ovidovid000000000000Perl6-Caller-0.100/libCaller.pm000444000765000765 1265211266610155 16406 0ustar00ovidovid000000000000Perl6-Caller-0.100/lib/Perl6package Perl6::Caller; use warnings; use strict; our $VERSION = '0.100'; $VERSION = eval $VERSION; use overload '""' => \&package, fallback => 1; sub import { my ($class) = @_; my $callpack = caller; no strict 'refs'; *{"$callpack\::caller"} = \&caller; } sub caller { my $thing = shift || 0; my $frame = __PACKAGE__ eq $thing ? ( shift || 0 ) : $thing; return __PACKAGE__->new($frame); } my @methods; BEGIN { @methods = qw/package filename line subroutine hasargs wantarray evaltext is_require/; foreach my $method (@methods) { no strict 'refs'; *$method = sub { my ( $self, $frame ) = @_; return $self->{$method}; }; } } sub new { my $class = shift; my $frame = @_ ? (shift || 0) : -1; $frame += 2; my $self = bless {} => __PACKAGE__; my @caller = CORE::caller($frame); return @caller if CORE::wantarray; @$self{@methods} = @caller; return $self; } 1; __END__ =head1 NAME Perl6::Caller - OO C interface =head1 VERSION Version 0.04 =cut =head1 SYNOPSIS use Perl6::Caller; my $sub = caller->subroutine; my $line_number = caller->line; my $is_require = caller(3)->is_require; =head1 EXPORT =head1 C # standard usage print "In ", caller->subroutine, " called from ", caller->file, " line ", caller->line; # get a caller object my $caller = caller; my $caller = caller(); # same thing # get a caller object for a different stack from my $caller = caller(2); # two stack frames up print $caller->package; # prints the package name # enjoy the original flavor my @caller = caller; # original caller behavior print $caller[0], # prints the package name =head1 DESCRIPTION This module is experimental. It's also alpha. Bug reports and patches welcome. By default, this module exports the C function. This automatically returns a new C object. An optional argument specifies how many stack frames back to skip, just like the C function. This lets you do things like this: print "In ", caller->subroutine, " called from ", caller->file, " line ", caller->line; If you do not wish the C function imported, specify an empty import list and instantiate a new C object. use Perl6::Caller (); my $caller = Perl6::Caller->new; print $caller->line; B: if the results from the module seem strange, please read S carefully. It has stranger behavior than you might be aware. =head1 METHODS The following methods are available on the C object. They return the same values as documented in S. There are no C and C methods because those are documented as for internal use only. =over 4 =item * C =item * C =item * C =item * C =item * C =item * C =item * C =item * C =back Note that each of these values will report correctly for when the caller object was created. For example, the following will probably print different line numbers: print caller->line; foo(); sub foo { print caller->line; } However, the following will print the I line numbers: my $caller = Perl6::Caller->new; # everything is relative to here print $caller->line; foo($caller); sub foo { my $caller = shift; print $caller->line; } =cut =head1 CAVEATS Most of the time, this package should I and not interfere with anything else. =over 4 =item * C<$hints>, C<$bitmask> 'hints' and 'bitmask' are not available. They are documented to be for internal use only and should not be relied upon. Further, the bitmask caused strange test failures, so I opted not to include them. =item * Subclassing Don't. =item * Perl 6 I'm not entirely comfortable with the namespace. The S caller actually does considerably more, but for me to have a hope of working that in, I need proper introspection and I don't have that. Thus, I've settled for simply having a caller object. =item * C<*CORE::GLOBAL::caller> I didn't implement this, though I was tempted. It turns out to be a bit tricky in spots and I'm very concerned about globally overriding behavior. I might change my mind in the future if there's enough demand. =item * Overloading In string context, this returns the package name. This is to support the original C behavior. =item * List Context In list context, we simply default to the original behavior of C. However, this I assumes we've called caller with an argument. Calling C and C are identical with this module. It's difficult to avoid since the stack frame changes. =back =head1 AUTHOR Curtis "Ovid" Poe, C<< >> =head1 ACKNOWLEDGEMENTS Thanks to C for helping me revisit a bad design issue with this. =head1 BUGS Please report any bugs or feature requests to C, or through the web interface at L. I will be notified, and then you'll automatically be notified of progress on your bug as I make changes. =head1 ACKNOWLEDGEMENTS =head1 COPYRIGHT & LICENSE Copyright 2007 Curtis "Ovid" Poe, all rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. t000755000765000765 011266610155 13170 5ustar00ovidovid000000000000Perl6-Caller-0.10000-load.t000444000765000765 22511266610155 14625 0ustar00ovidovid000000000000Perl6-Caller-0.100/t#!perl -T use Test::More tests => 1; BEGIN { use_ok( 'Perl6::Caller' ); } diag( "Testing Perl6::Caller $Perl6::Caller::VERSION, Perl $], $^X" ); 10-caller.t000444000765000765 477211266610155 15204 0ustar00ovidovid000000000000Perl6-Caller-0.100/t#!/usr/bin/perl use strict; use warnings; use Test::More tests => 92; use lib 'lib'; use Perl6::Caller; my @methods = qw/package filename line subroutine hasargs wantarray evaltext is_require/; my %pos_for; foreach my $i ( 0 .. $#methods ) { $pos_for{ $methods[$i] } = $i; } can_ok 'Perl6::Caller', 'new'; my $caller = Perl6::Caller->new; isa_ok $caller, 'Perl6::Caller', '... and the object it returns'; is $caller->package, undef, '... and it should return the correct package name when asked'; is $caller->package, scalar CORE::caller, '... and match what CORE::caller says'; $caller = caller; isa_ok $caller, 'Perl6::Caller', '... and the object it returns'; is $caller->package, undef, '... and it should return the correct package name when asked'; my $line1 = $caller->line; my $line2 = $caller->line; is $line1, $line2, '... calling methods on the same object respect original caller position'; run_frame1_tests(); eval { for ( 0 .. 2 ) { my @caller = caller($_); foreach my $method (@methods) { is_deeply caller($_)->$method, $caller[ $pos_for{$method} ], "eval {} Caller should have the correct frame ($_) result for '$method'"; } } }; sub run_frame1_tests { my @caller = caller(0); foreach my $method (@methods) { is( caller->$method, $caller[ $pos_for{$method} ], "Caller should have the correct result for '$method'" ); } for ( 0 .. 2 ) { my @caller = caller($_); foreach my $method (@methods) { is_deeply caller($_)->$method, $caller[ $pos_for{$method} ], "Caller should have the correct frame ($_) result for '$method'"; } } { package Frame2; ::run_frame2_tests(3); } } sub run_frame2_tests { my $caller = Perl6::Caller->new; isa_ok $caller, 'Perl6::Caller', '... and the object it returns'; is $caller->package, 'Frame2', '... and it should return the correct package name when asked'; is $caller->package, scalar CORE::caller, '... and match what CORE::caller says'; $caller = caller; isa_ok $caller, 'Perl6::Caller', '... and the object it returns'; is $caller->package, 'Frame2', '... and it should return the correct package name when asked'; for ( 0 .. 2 ) { my @caller = caller($_); foreach my $method (@methods) { is_deeply caller($_)->$method, $caller[ $pos_for{$method} ], "Caller should have the correct frame ($_) result for '$method'"; } } } xt000755000765000765 011266610155 13360 5ustar00ovidovid000000000000Perl6-Caller-0.100pod-coverage.t000444000765000765 35611266610155 16241 0ustar00ovidovid000000000000Perl6-Caller-0.100/xt#!perl -T use Test::More tests => 1; eval "use Test::Pod::Coverage 1.04"; plan skip_all => "Test::Pod::Coverage 1.04 required for testing POD coverage" if $@; pod_coverage_ok( "Perl6::Caller", { also_private => [qr/^new|caller$/] } ); pod.t000444000765000765 21411266610155 14441 0ustar00ovidovid000000000000Perl6-Caller-0.100/xt#!perl -T use Test::More; eval "use Test::Pod 1.14"; plan skip_all => "Test::Pod 1.14 required for testing POD" if $@; all_pod_files_ok();