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-2026 -- leonerd@leonerd.org.uk

package Devel::MAT::Context 0.56;

use v5.20;
use warnings;

use feature qw( postderef signatures );
no warnings qw( experimental::postderef experimental::signatures );

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 ( $pkg, $id )
{
   $types{$id} = $pkg;
   # generate the ->type constant method
   ( my $typename = $pkg ) =~ s/^Devel::MAT::Context:://;
   no strict 'refs';
   *{"${pkg}::type"} = sub (@) { $typename };
}

sub new ( $class, $type, $df, $bytes, $, $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 ( $class, $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

=for highlighter language=perl

=cut

=head2 gimme

   $gimme = $ctx->gimme;

Returns the gimme value of the call context.

=cut

my @GIMMES = ( undef, qw( void scalar array ) );
sub gimme ( $self )
{
   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 ( $self ) { return $self->{file} }
sub line ( $self ) { return $self->{line} }

sub location ( $self )
{
   return "$self->{file} line $self->{line}";
}

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

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