view release on metacpan or  search on metacpan

lib/Devel/MAT/Context.pm  view on Meta::CPAN

#  You may distribute under the terms of either the GNU General Public License
#  or the Artistic License (the same terms as Perl itself)
#
#  (C) Paul Evans, 2013-2024 -- leonerd@leonerd.org.uk

package Devel::MAT::Context 0.54;

use v5.14;
use warnings;

use Carp;
use Scalar::Util qw( weaken );

=head1 NAME

C<Devel::MAT::Context> - represent a single call context state

=head1 DESCRIPTION

Objects in this class represent a single level of state from the call context.
These contexts represent function calls between perl functions.

=cut

my %types;
sub register_type
{
   $types{$_[1]} = $_[0];
   # generate the ->type constant method
   ( my $typename = $_[0] ) =~ s/^Devel::MAT::Context:://;
   no strict 'refs';
   *{"$_[0]::type"} = sub () { $typename };
}

sub new
{
   shift;
   my ( $type, $df, $bytes, undef, $strs ) = @_;

   $types{$type} or croak "Cannot load unknown CTX type $type";

   my $self = bless {}, $types{$type};
   weaken( $self->{df} = $df );

   ( $self->{gimme}, $self->{line} ) = unpack "C $df->{uint_fmt}", $bytes;
   ( $self->{file} ) = @$strs;

   return $self;
}

sub load_v0_1
{
   my $class = shift;
   my ( $type, $df ) = @_;

   $types{$type} or croak "Cannot load unknown CTX type $type";

   my $self = bless {}, $types{$type};
   weaken( $self->{df} = $df );

   # Standard fields all Contexts have
   $self->{gimme} = $df->_read_u8;
   $self->{file}  = $df->_read_str;
   $self->{line}  = $df->_read_uint;

   $self->_load_v0_1( $df );

   return $self;
}

=head1 COMMON METHODS

=cut

=head2 gimme

   $gimme = $ctx->gimme;

Returns the gimme value of the call context.

=cut

my @GIMMES = ( undef, qw( void scalar array ) );
sub gimme
{
   my $self = shift;
   return $GIMMES[ $self->{gimme} ];
}

=head2 file

=head2 line

=head2 location

   $file = $ctx->file;

   $line = $ctx->line;

   $location = $ctx->location;

Returns the file, line or location as (C<FILE line LINE>).

=cut

sub file  { my $self = shift; return $self->{file} }
sub line  { my $self = shift; return $self->{line} }

sub location
{
   my $self = shift;
   return "$self->{file} line $self->{line}";
}

package Devel::MAT::Context::SUB 0.54;
use base qw( Devel::MAT::Context );
__PACKAGE__->register_type( 1 );

=head1 Devel::MAT::Context::SUB