view release on metacpan or  search on metacpan

lib/Devel/MAT/SV.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::SV 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 );

use Syntax::Keyword::Match;

# Load XS code
require Devel::MAT;

use constant immortal => 0;

use List::Util qw( first );

use Struct::Dumb 0.07 qw( readonly_struct );
readonly_struct Reference => [qw( name strength sv )];

=head1 NAME

C<Devel::MAT::SV> - represent a single SV from a heap dump

=head1 DESCRIPTION

Objects in this class represent individual SV variables found in the arena
during a heap dump. Actual types of SV are represented by subclasses, which
are documented below.

=cut

my $CONSTANTS;
BEGIN {
   $CONSTANTS = {
      STRENGTH_STRONG   => (1 << 0),
      STRENGTH_WEAK     => (1 << 1),
      STRENGTH_INDIRECT => (1 << 2),
      STRENGTH_INFERRED => (1 << 3),
   };
   $CONSTANTS->{STRENGTH_DIRECT} = $CONSTANTS->{STRENGTH_STRONG}|$CONSTANTS->{STRENGTH_WEAK};
   $CONSTANTS->{STRENGTH_ALL}    = $CONSTANTS->{STRENGTH_STRONG}|$CONSTANTS->{STRENGTH_WEAK}|$CONSTANTS->{STRENGTH_INDIRECT}|$CONSTANTS->{STRENGTH_INFERRED};
}
use constant $CONSTANTS;

my %types;
sub register_type ( $pkg, $type_id )
{
   $types{$type_id} = $pkg;
   # generate the ->type constant method
   ( my $typename = $pkg ) =~ s/^Devel::MAT::SV:://;
   no strict 'refs';
   *{"${pkg}::type"} = sub ($) { $typename } unless defined *{"${pkg}::type"}{CODE};
}

sub new ( $, $type, $df, $header, $ptrs, $strs )
{
   my $class = $types{$type} or croak "Cannot load unknown SV type $type";

   my $self = bless {}, $class;

   $self->_set_core_fields(
      $type, $df,
      ( unpack "$df->{ptr_fmt} $df->{u32_fmt} $df->{uint_fmt}", $header ),
      $ptrs->[0],
   );

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

sub _set_shared_hek_at ( $self, $hek_at )
{
   $self->{shared_hek_at} = $hek_at;
}

sub shared_hek ( $self ) { return $self->{shared_hek_at}; }

sub _outrefs ( $self, $match, $no_desc )
{
   my @outrefs;

   if( $match & STRENGTH_STRONG and my $ourstash = $self->ourstash ) {
      push @outrefs, $no_desc ? ( strong => $ourstash ) :
         Devel::MAT::SV::Reference( "the our stash", strong => $ourstash );
   }

   return @outrefs;
}

package Devel::MAT::SV::REF 0.56;
use base qw( Devel::MAT::SV );
__PACKAGE__->register_type( 3 );
use constant $CONSTANTS;
use constant basetype => "SV";

=head1 Devel::MAT::SV::REF

Represents a referential scalar; any SCALAR-type SV with the C<SvROK> flag
set.

=cut

sub load ( $self, $header, $ptrs, $strs )
{
   ( my $flags ) =
      unpack "C", $header;

   $self->_set_ref_fields(
      @{$ptrs}[0,1], # RV, OURSTASH
      $flags & 0x01, # RV_IS_WEAK
   );

   $flags &= ~0x01;
   $flags and die sprintf "Unrecognised REF flags %02x\n", $flags;
}

=head2 rv

   $svrv = $sv->rv;

Returns the SV referred to by the reference.

=cut

sub rv ( $self ) { $self->df->sv_at( $self->rv_at ) }

=head2 is_weak

   $weak = $sv->is_weak;

Returns true if the SV is a weakened RV reference.

=cut

# XS accessor

=head2 ourstash

   $stash = $sv->ourstash;

Returns the stash of the SCALAR, if it is an 'C<our>' variable.

=cut

sub ourstash ( $self ) { $self->df->sv_at( $self->ourstash_at ) }

sub desc ( $self )
{
   return sprintf "REF(%s)", $self->is_weak ? "W" : "";
}

*symname = \&Devel::MAT::SV::SCALAR::symname;

sub _outrefs ( $self, $match, $no_desc )
{
   my @outrefs;

   my $is_weak = $self->is_weak;
   if( $match & ( $is_weak ? STRENGTH_WEAK : STRENGTH_STRONG ) and my $rv = $self->rv ) {
      my $strength = $is_weak ? "weak" : "strong";
      push @outrefs, $no_desc ? ( $strength => $rv ) :
         Devel::MAT::SV::Reference( "the referrant", $strength => $rv );
   }

   if( $match & STRENGTH_STRONG and my $ourstash = $self->ourstash ) {
      push @outrefs, $no_desc ? ( strong => $ourstash ) :
         Devel::MAT::SV::Reference( "the our stash", strong => $ourstash );
   }

   return @outrefs;
}

package Devel::MAT::SV::BOOL 0.56;
use base qw( Devel::MAT::SV::SCALAR );

sub type ( $ ) { return "BOOL" }

sub desc ( $self )
{
   return "BOOL(YES)" if $self->uv;
   return "BOOL(NO)";
}

package Devel::MAT::SV::ARRAY 0.56;
use base qw( Devel::MAT::SV );
__PACKAGE__->register_type( 4 );
use constant $CONSTANTS;
use constant basetype => "AV";

=head1 Devel::MAT::SV::ARRAY