use strict;
use utf8;
use 5.010_001;
use Cwd ();
our $BASE_DIR = Cwd::getcwd();
our %FILECACHE;
sub package { shift->{package} }
sub filename { shift->{filename} }
sub line { shift->{line} }
sub code { shift->{code} }
sub new {
my $class = shift;
my $level = shift || 0;
my $binmode = shift || '<:encoding(utf-8)';
my ($package, $filename, $line) = caller($level+1);
return unless defined($package);
my $code = sub {
undef $filename if $filename eq '-e';
if (defined $filename) {
my $abs_filename = File::Spec->rel2abs($filename, $BASE_DIR);
my $file = $FILECACHE{$abs_filename} ||= [
do {
# Do not die if we can't open the file
open my $fh, $binmode, $abs_filename
or return '';
<$fh>
}
];
my $code = $file->[ $line - 1 ];
$code =~ s{^\s+|\s+$}{}g;
$code;
} else {
"";
}
}->();
return bless +{
package => $package,
filename => $filename,
line => $line,
code => $code,
}, $class;
}
1;
__END__
=head1 NAME
Test::Kantan::Caller - Kantan caller
=head1 SYNOPSIS
my $caller = Test::Kantan::Caller->new();
=head1 DESCRIPTION
This is the caller object for Test::Kantan.
=head1 METHODS
=over 4
=item C<< my $caller = Test::Kantan::Caller->new([$level=0[, $binmode="<:encoding(utf-8)"]) >>
Create new C<Test::Kantan::Caller> object from the caller information.
I<$level>: Caller level.
I<$binmode>: Binmode for reading source code.
I<Return Value>: New object. If there is no caller, return C<()> or undef.
=back
=head1 ATTRIBUTES
=over 4
=item package
The caller package name
=item filename
The caller file name.
=item line
The caller line number.
=item code
The source code at caller file at line number.
=back