weaken results from the CPAN

sv_release_COW|||
sv_release_IVX|||
sv_replace|||
sv_report_used|||
sv_reset|||
sv_rvweaken||5.006000|
sv_setiv_mg|5.006000||p
sv_setiv|||
sv_setnv_mg|5.006000||p
sv_setnv|||
sv_setpv_mg|5.006000||p

view all matches for this distribution

Devel-FindRef

6 results

FindRef.pm view on Meta::CPAN

      print Devel::FindRef::track \$var;
   }

   my $closure = sub {
      my $closure_var = \$_[0];
      Scalar::Util::weaken (my $weak_ref = \$var);
      testsub;
   };

   $closure->($var);

FindRef.pm view on Meta::CPAN

   @_ = ();

   my $buf = "";
   my %seen;

   Scalar::Util::weaken $ref;

   my $track; $track = sub {
      my ($refref, $depth, $indent) = @_;

      if ($depth) {

view all matches for this distribution

Devel-GC-Helper

2 results

sv_release_COW|||
sv_release_IVX|||
sv_replace|||
sv_report_used|||
sv_reset|||
sv_rvweaken||5.006000|
sv_setiv_mg|5.006000||p
sv_setiv|||
sv_setnv_mg|5.006000||p
sv_setnv|||
sv_setpv_mg|5.006000||p

view all matches for this distribution

Devel-GDB-Breakpoint

1 match

sv_reftype|||
sv_release_COW|||
sv_replace|||
sv_report_used|||
sv_reset|||
sv_rvweaken||5.006000|
sv_setiv_mg|5.004050||p
sv_setiv|||
sv_setnv_mg|5.006000||p
sv_setnv|||
sv_setpv_mg|5.004050||p

view all matches for this distribution

Devel-Gladiator

2 results

SvROK|5.003007|5.003007|
SvROK_off|5.003007|5.003007|
SvROK_on|5.003007|5.003007|
SvRV|5.003007|5.003007|
SvRV_set|5.009003|5.003007|p
sv_rvunweaken|5.027004|5.027004|
sv_rvweaken|5.006000|5.006000|
SvRX|5.009005|5.003007|p
SvRXOK|5.009005|5.003007|p
sv_sethek|5.015004||cViu
sv_setiv|5.003007|5.003007|
sv_setiv_mg|5.004005|5.003007|p

view all matches for this distribution

Devel-GlobalDestruction-XS

1 match

sv_reftype|||
sv_release_COW|||
sv_replace|||
sv_report_used|||
sv_reset|||
sv_rvweaken||5.006000|
sv_setiv_mg|5.004050||p
sv_setiv|||
sv_setnv_mg|5.006000||p
sv_setnv|||
sv_setpv_mg|5.004050||p

view all matches for this distribution

Devel-Hexdump

1 match

sv_reftype|||
sv_release_COW|||
sv_replace|||
sv_report_used|||
sv_reset|||
sv_rvweaken||5.006000|
sv_setiv_mg|5.004050||p
sv_setiv|||
sv_setnv_mg|5.006000||p
sv_setnv|||
sv_setpv_mg|5.004050||p

view all matches for this distribution

Devel-Hints

1 match

sv_reftype|||
sv_release_COW|||
sv_replace|||
sv_report_used|||
sv_reset|||
sv_rvweaken||5.006000|
sv_setiv_mg|5.004050||p
sv_setiv|||
sv_setnv_mg|5.006000||p
sv_setnv|||
sv_setpv_mg|5.004050||p

view all matches for this distribution

Devel-Leak-Cb

1 match

lib/Devel/Leak/Cb.pm view on Meta::CPAN

	You may call C<Devel::Leak::Cb::COUNT()> Manually to check state. All leaked callbacks will be warned. Noop without C<$ENV{DEBUG_CB}>

=cut

use Devel::Declare ();
use Scalar::Util 'weaken';

our @CARP_NOT = qw(Devel::Declare);
our %DEF;

BEGIN {

lib/Devel/Leak/Cb.pm view on Meta::CPAN

	return 1;
}

sub wrapper (&) {
	$DEF{int $_[0]} = [ $_[0], (caller)[0..2], $LASTNAME ];
	weaken($DEF{int $_[0]}[0]);
	subname($DEF{int $_[0]}[1].'::cb.'.$LASTNAME => $_[0]) if $LASTNAME;
	$LASTNAME = undef;
	return bless $_[0],'__cb__';
}

view all matches for this distribution

Devel-LeakGuard-Object

1 match

lib/Devel/LeakGuard/Object.pm view on Meta::CPAN

use strict;
use warnings;

use Carp;
use Data::Dumper;
use Scalar::Util qw( blessed refaddr weaken );

use Devel::LeakGuard::Object::State;

use base qw( Exporter );

view all matches for this distribution

Devel-MAT

5 results

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


use v5.14;
use warnings;

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

=head1 NAME

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

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

   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;

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

   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;

view all matches for this distribution

Devel-Mallinfo

6 results

t/MyTestHelpers.pm view on Meta::CPAN

  } else {
    MyTestHelpers::diag ("Devel::FindRef not available -- ", $@);
  }
}

sub test_weaken_show_leaks {
  my ($leaks) = @_;
  $leaks || return;

  my $unfreed = $leaks->unfreed_proberefs;
  my $unfreed_count = scalar(@$unfreed);

view all matches for this distribution

Devel-Monitor

2 results

sub printCircularRef {
    my $varRef = shift;
    my $hideWeakenedCircRef = shift; #Boolean
    my $source = shift;
    my $trace = shift; #A array container containing the current trace
    my $weakenedRef = shift; #A array containing the trace to the weakened ref it any
    my $origRef = shift; #Contains original reference to verify circular references
    my $seenRef = shift;
    my $circRefTypesRef = shift;
           
    #print STDERR "###############################################################\n";
    #print STDERR "VARIABLE : ".$varRef."\n";
    #print STDERR "TYPE     : ".ref($varRef)."\n";
    my $isFirst = (!$origRef);    
    $trace = Devel::Monitor::Trace->new() if not $trace;
    $weakenedRef = [] if not $weakenedRef;
    $seenRef = {} if not $seenRef;
    $circRefTypesRef = [] if not $circRefTypesRef;

    return undef if not $varRef;

        #print STDERR "DEREFERING $varRef ($$varRef)\n";
        #print STDERR "Current variable : $varRef from ".\$varRef."\n";
        if (isweak($$varRef)) {
            $isWeak = 1;
            #print STDERR "WEAK for $$varRef\n";            
            push(@$weakenedRef, $$varRef);
        }
        _addSeenRef($varRef,$simpleSeenRef);
        #Exceptional case : $a = \$a or $a = \$b = \$c
        #TODO : This "if" should not be handled as an exception (At least, we should try)     
        if (exists($simpleSeenRef->{$varRef}) && ($simpleSeenRef->{$varRef} > 1)) {

    }
    $trace->push($varRef,$source);
    _addSeenRef($varRef,$seenRef) if $origRef; #We skip the first item which is $origRef
    #print STDERR "--------------------------------------------\n";
    #print STDERR "Current variable : $varRef from ".\$varRef."\n";    
    my $circRefType = _checkCircularRef($varRef,$hideWeakenedCircRef,$trace,$weakenedRef,$origRef,$seenRef);
    #print STDERR "\$circRefType : $circRefType\n";
    if ($circRefType) {
        $trace->pop();
        push(@$circRefTypesRef, $circRefType);
        return undef; #Don't go any further because we loop

        $origRef = $varRef;
        _printCircularRefHeader($origRef);
    }    
    
    #print STDERR 'Current trace : '.$trace->getCircularPath()."\n";
    _printCircularRef($varRef,$hideWeakenedCircRef,$source,$trace,$weakenedRef,$origRef,$seenRef,$circRefTypesRef);
    
    #We go into another branch
    $trace->pop();
    pop(@$weakenedRef) if $isWeak; # Remove weakened item 
    delete($seenRef->{$varRef});  # Remove varRef from "seen" hash
    
    _printCircularRefResults($origRef,$circRefTypesRef) if $isFirst;
    
    return undef;

sub _printCircularRef {
    my $varRef = shift;
    my $hideWeakenedCircRef = shift;
    my $source = shift;
    my $trace = shift;
    my $weakenedRef = shift;
    my $origRef = shift;
    my $seenRef = shift;
    my $circRefTypesRef = shift;
      
    if ($varRef =~ /HASH/ ) {  #An object or an hash
        HASH_ITEM:
        Devel::Monitor::Common::printMsg('Object '.$trace->getCircularPath().' = '.$varRef." is tied. Untie it to check circular references for this object.\n") if tied(%$varRef);          
        foreach my $item (keys %$varRef) {
            my $ref = _getVarRef(\($varRef->{$item}));
            printCircularRef($ref,$hideWeakenedCircRef,'{'.$item.'}',$trace,$weakenedRef,$origRef,$seenRef,$circRefTypesRef);
        }
    }
    elsif ($varRef =~ /SCALAR|CODE/) {
        #No circular references are possible here, so we don't do anything
    }

        for (my $i=0; $i<scalar(@$varRef); $i++) {
            #print STDERR "CURRENT VAR  : ".\($varRef->[$i])." ::: ".$varRef->[$i]."\n";
            my $ref = _getVarRef(\($varRef->[$i]));
            #Devel::Monitor::Common::printMsg('Object at '.$trace->getCircularPath().'['.$i.']'.
            #" is ARRAY ARRAY ARRAY tied. We cannot check circular references for this object.\n") if $ref =~ /SCALAR/;            
            printCircularRef($ref,$hideWeakenedCircRef,'['.$i.']',$trace,$weakenedRef,$origRef,$seenRef,$circRefTypesRef);
        }
    } else {
        #Other objects
        my $runPatch = 0;
        try {


sub _checkCircularRef {
    my $varRef = shift;
    my $hideWeakenedCircRef = shift;
    my $trace = shift;
    my $weakenedRef = shift;
    my $origRef = shift;
    my $seenRef = shift;
    if ($varRef) {
        #print STDERR "\$varRef  : $varRef\n";
        #print STDERR "\$origRef : $origRef\n";

            my $isCircRef = ($varRef eq $origRef);
            #If we found a reference more than one time, it means we loop infinitely
            my $isInternalCircRef = (exists($seenRef->{$varRef}) && ($seenRef->{$varRef} > 1));
            
            if ($isCircRef || $isInternalCircRef) {
                my $weakenedInCircRefRef = _getWeakenedInCircRef($trace,$weakenedRef);
                my $isWeakenedItems = (scalar(@$weakenedInCircRefRef) > 0);
                if (!$hideWeakenedCircRef ||  #If we show everything
                    ($hideWeakenedCircRef && !$isWeakenedItems)) {  #Otherwise, if there is no weak reference
                    
                    Devel::Monitor::Common::printMsg("-------------------------------------------------------------------------------\n");
                    if ($isCircRef) {

                    }
                    elsif ($isInternalCircRef) {
                        Devel::Monitor::Common::printMsg('Internal circular reference found : '.$trace->getCircularPath()." on $varRef\n");    
                    }                
                    if ($isWeakenedItems) {
                        Devel::Monitor::Common::printMsg('with weakened reference on : '.join(', ', @$weakenedInCircRefRef)."\n");
                    }
                    $trace->dump();
                    Devel::Monitor::Common::printMsg("-------------------------------------------------------------------------------\n");
                    return CRT_WEAK_CIRC_REF()     if $isWeakenedItems;
                    return CRT_CIRC_REF()          if $isCircRef;

    return $ref;
}

sub _getWeakenedInCircRef {
    my $trace = shift;
    my $weakenedRef = shift;

    my @weakenedInCircRef;
    my $traceItemsRef = $trace->getTraceItems;
    #The last item represent the circular reference    
    my $traceItemCircRef = $traceItemsRef->[$#$traceItemsRef];
    #for my $i (($#$traceItemsRef-1)..0) {
    for (my $i=($#$traceItemsRef-1); $i>=0; $i--) {
        #Get the current item
        my $traceItem = $traceItemsRef->[$i];
        #print STDERR "traceItem ".$traceItem->getVarRef()."\n";
        #We verify that the item is a weaken reference or not
        foreach my $weakened (@$weakenedRef) {
            #print STDERR "weakened ".$weakened."\n";
            if ($traceItem->getVarRef() eq $weakened) {
                #print STDERR "push\n";
                push(@weakenedInCircRef, $weakened);   
            }
        }
        #We finish when we end the circular reference
        last if ($traceItem->getVarRef() eq $traceItemCircRef->getVarRef());
    }
    #print STDERR "RETURN ".join(', ', @weakenedInCircRef)."\n";
    return \@weakenedInCircRef;
}
 
1;

__END__

    #--------------------------------------------------------------------
     
    package ClassA;
    use strict;
    use warnings;
    use Scalar::Util qw(weaken isweak);
     
    sub new {
        my ($class) = @_;
        my $self = {};
        bless($self => $class);

    #--------------------------------------------------------------------
     
    package ClassB;
    use strict;
    use warnings;
    use Scalar::Util qw(weaken isweak);
     
    sub new {
        my ($class, $classA) = @_;
        my $self = {};
        bless($self => $class);

     
    #------------------------------------------------------------------------------+
    #
    # We see that the object reference by $b isn't destroyed when leaving the scope
    # because $a->{_classB} still use it. So, we got a circular reference here. We must
    # weaken one side of the circular reference to help Perl disallocate memory.
    #
    #------------------------------------------------------------------------------+
    #------------------------------------------------------------------------------+
    # Wrong way to break circular references
    #------------------------------------------------------------------------------+
    sub getClassB {
        my $self = shift;
        $self->{_classB} = ClassB->new($self);  #$self->{_classB} is the only
                                                #reference to the objects
        weaken($self->{_classB});               #we weaken the only reference,
                                                #so, $self->{_classB} is DESTROYED HERE,
                                                #which is very bad
        print "\$self->{_classB} is now weaken\n" if isweak($self->{_classB});
        return $self->{_classB};
    }
    #------------------------------------------------------------------------------+
    # Good way
    #------------------------------------------------------------------------------+
    sub getClassB {
        my $self = shift;
        my $b = ClassB->new($self);
        $self->{_classB} = $b;                  #we create a second reference to the object
        weaken($self->{_classB});               #we weaken this reference, which is not deleted
                                                #because thre is another reference
        print "\$self->{_classB} is now weaken\n" if isweak($self->{_classB});
        return $self->{_classB};
    }
    #------------------------------------------------------------------------------+
    # Be careful ! With this code, it won't work
    #------------------------------------------------------------------------------+
    sub getClassB {
        my $self = shift;
        {
            my $b = ClassB->new($self);
            $self->{_classB} = $b;                  #we create a second reference to the object
            weaken($self->{_classB});               #we weaken this reference, which is not deleted
                                                    #because thre is another reference
            print "\$self->{_classB} is now weaken\n" if isweak($self->{_classB});
        } #$b is destroyed here, and the other reference $self->{_classB} is a weak reference,
          #so the ClassB instance is destroyed, $self->{_classB} now equal undef
        return $self->{_classB};
    }
    #------------------------------------------------------------------------------+

        my $self = shift;
        my $b;
        {
            $b = ClassB->new($self);
            $self->{_classB} = $b;                  #we create a second reference to the object
            weaken($self->{_classB});               #we weaken this reference, which is not deleted
                                                    #because thre is another reference
            print "\$self->{_classB} is now weaken\n" if isweak($self->{_classB});
        } #$b is still not destroyed, so we didn't lose our not weak reference
        return $self->{_classB}; #We return the object, someone on the other side will now keep
                                 #the reference, so we don't care if $b lose the reference.
                                 #Our job is done !
    }

    #
    # The output (Using the good way) will be
    #
    #------------------------------------------------------------------------------+
     
    $self->{_classB} is now weaken
    MONITOR HASH : $b
    Something
    Leaving scope
    DESTROY HASH : $b
    Scope left

    #
    #------------------------------------------------------------------------------+
     
    #------------------------------------------------------------------------------+
    #
    # IMPORTANT : Always weaken the caller's reference because someone may use the
    # child objects (ClassB) this way. Let's see what can happen if you don't.
    #
    # If we get the following code
    #
    #------------------------------------------------------------------------------+

    #
    #------------------------------------------------------------------------------+
    sub setClassA {
        my ($self, $classA) = @_;
        $self->{_classA} = $classA;
        weaken($self->{_classA});
        print "\$self->{_classA} is now weaken\n" if isweak($self->{_classA});
    }
     
    #------------------------------------------------------------------------------+
    #
    # You'll get this error
    #
    #------------------------------------------------------------------------------+
    MONITOR HASH : $a
    $self->{_classA} is now weaken
    Something
    Leaving scope
    DESTROY HASH : $a
    Scope left
    Can't call method "printSomething" on an undefined value at test3.pl line 29.
     
    #------------------------------------------------------------------------------+
    #
    # $a is destroyed when leaving the scope, and the other reference to this variable
    # is weaken, so this one is destroyed too. This clearly demonstrate that you must
    # weaken the caller's reference.
    #
    #------------------------------------------------------------------------------+
    
=head1 THINGS YOU SHOULD BE AWARE OF

    +----------------------+
    Hash keys refering 1 and 2 can't be the same reference. But we see the
    opposite on these small examples. It seems like tied objects reuse memory space
    instead of refering to the original value from the untied object.
    
=head3 You cannot weaken a tied object

This is actually an unhandled reference by Perl (Verified with 5.9.2-). It means
that if you monitor (or tie explicitly) an object, any weaken references into
this one will simply be ignored.

=head4 Proof 01 : Basic test

    +----------------------+
    | Code                 |
    +----------------------+
    #!/usr/bin/perl
    
    use Scalar::Util qw(weaken isweak);
    my (@a, @b);
    tie @a, 'Monitor::TestArray';
    tie @b, 'Monitor::TestArray';
    $a[0] = \@b;
    $b[0] = \@a;
    weaken($b[0]);
    if (isweak($a[0])) {
       print "\$a[0] is weak\n";
    } else {
       print "\$a[0] is not weak\n";
    }

    | test.pl    |
    +------------+
    #!/usr/bin/perl
    use strict;
    use warnings;
    use Scalar::Util qw(weaken);
    use Devel::Monitor qw(:all);
    use Util::Junk;
    
    my (@a, $b);
    #tie @a, 'Devel::Monitor::TestArray';
    $a[0] = \$b;
    $b = \@a;
    $a[1] = Util::Junk::_20M();
    weaken($a[0]);
    
    +------------+
    | Util::Junk |
    +------------+
    package Util::Junk;

    However, if you uncomment the tie call in test.pl, you'll see your memory being filled to death and
    every page loaded will be as long as at the beginning 
    
=head4 Proof 03 : Final assault
    
    Firstly, we must be sure that the methods Scalar::Util::weaken and Scalar::Util::isweak
    doesn't contain bugs. The code for these method follows : 
    
    void
    weaken(sv)
       SV *sv
    PROTOTYPE: $
    CODE:
    #ifdef SvWEAKREF
       sv_rvweaken(sv);
    #else
       croak("weak references are not implemented in this release of perl");
    #endif
    
    void

    #!/usr/bin/perl
    use strict;
    use warnings;
    use Devel::Monitor qw(:all);
     
    use Scalar::Util qw(weaken);
    use Devel::Peek;
    {
        my (@a);
        $a[0] = \@a;
        #tie @a, 'TestArray';
        Dump($a[0],1);
        weaken($a[0]);
        Dump($a[0],1);
        print "Leaving scope\n";
    }
    print "Scope left\n";

    Absolutely nothing has changed before and after. IT IS A PROBLEM ! So, I debugged
    the perl source code to verify what happen with a tied variable. The method goes
    like this :
    
    /*
    =for apidoc sv_rvweaken
     
    Weaken a reference: set the C<SvWEAKREF> flag on this RV; give the
    referred-to SV C<PERL_MAGIC_backref> magic if it hasn't already; and
    push a back-reference to this RV onto the array of backreferences
    associated with that magic.
     
    =cut
    */
     
    SV *
    Perl_sv_rvweaken(pTHX_ SV *sv)
    {
        SV *tsv;
        if (!SvOK(sv))  /* let undefs pass */
            return sv;
        if (!SvROK(sv))
            Perl_croak(aTHX_ "Can't weaken a nonreference");
        else if (SvWEAKREF(sv)) {
            if (ckWARN(WARN_MISC))
                Perl_warner(aTHX_ packWARN(WARN_MISC), "Reference is already weak");
            return sv;
        }


    This bug has been submitted and is unanswered for now. (See http://rt.perl.org/rt3/Ticket/Display.html?id=34524)

=head4 Conclusion

    It is actually impossible to weaken a tied variable

=head1 TRICKS

=head2 Checking modules syntax

view all matches for this distribution

Devel-Mortality

1 match

sv_reftype|||
sv_release_COW|||
sv_replace|||
sv_report_used|||
sv_reset|||
sv_rvweaken||5.006000|
sv_setiv_mg|5.004050||p
sv_setiv|||
sv_setnv_mg|5.006000||p
sv_setnv|||
sv_setpv_mg|5.004050||p

view all matches for this distribution

Devel-NYTProf

3 results

lib/Devel/NYTProf/Data.pm view on Meta::CPAN


    my $fid_fileinfo = $profile->{fid_fileinfo};
    my $sub_subinfo  = $profile->{sub_subinfo};

    # add profile ref so fidinfo & subinfo objects
    # XXX circular ref, add weaken
    for (@$fid_fileinfo) { $_ and $_->[7] = $profile; }
    $_->[7] = $profile for values %$sub_subinfo;

    # bless sub_subinfo data
    (my $sub_class = $class) =~ s/\w+$/SubInfo/;

view all matches for this distribution

Devel-Nopeep

1 match

sv_reftype|||
sv_release_COW|||
sv_replace|||
sv_report_used|||
sv_reset|||
sv_rvweaken||5.006000|
sv_setiv_mg|5.004050||p
sv_setiv|||
sv_setnv_mg|5.006000||p
sv_setnv|||
sv_setpv_mg|5.004050||p

view all matches for this distribution

Devel-PPPort

6 results

PPPort.pm view on Meta::CPAN

  HAS_OPENAT
  HAS_RENAMEAT
  HAS_UNLINKAT
  mg_freeext
  Perl_langinfo
  sv_rvunweaken

=item perl 5.27.3

  cv_get_call_checker_flags
  PL_sv_zero

PPPort.pm view on Meta::CPAN

  SvPVutf8
  SvPVutf8_force
  SvPVutf8_nolen
  SvPVutf8x
  SvPVutf8x_force
  sv_rvweaken
  SvUOK
  sv_utf8_decode
  sv_utf8_downgrade
  sv_utf8_encode
  SvUTF8_off

PPPort.pm view on Meta::CPAN

SvROK_off|5.003007|5.003007|
SvROK_on|5.003007|5.003007|
SvRV|5.003007|5.003007|
SvRV_const|5.010001||Viu
SvRV_set|5.009003|5.003007|p
sv_rvunweaken|5.027004|5.027004|
sv_rvweaken|5.006000|5.006000|
SvRVx|5.003007||Viu
SvRX|5.009005|5.003007|p
SvRXOK|5.009005|5.003007|p
SV_SAVED_COPY|5.009005||Viu
SvSCREAM|5.003007||Viu

view all matches for this distribution

Devel-PatchPerl-Plugin-Legacy

1 match

inc/Spiffy.pm view on Meta::CPAN

      "  return \$_[0]->{%s} = do { my \$self = \$_[0]; %s }\n" .
      "    unless \$#_ > 0 or defined \$_[0]->{%s};\n",
    weak_init =>
      "  return do {\n" .
      "    \$_[0]->{%s} = do { my \$self = \$_[0]; %s };\n" .
      "    Scalar::Util::weaken(\$_[0]->{%s}) if ref \$_[0]->{%s};\n" .
      "    \$_[0]->{%s};\n" .
      "  } unless \$#_ > 0 or defined \$_[0]->{%s};\n",
    return_if_get => 
      "  return \$_[0]->{%s} unless \$#_ > 0;\n",
    set => 
      "  \$_[0]->{%s} = \$_[1];\n",
    weaken => 
      "  Scalar::Util::weaken(\$_[0]->{%s}) if ref \$_[0]->{%s};\n",
    sub_end => 
      "  return \$_[0]->{%s};\n}\n",
);

sub field {

inc/Spiffy.pm view on Meta::CPAN

        local *paired_arguments = sub { (qw(-package -init)) };
        Spiffy->parse_arguments(@_);
    };
    my ($field, $default) = @values;
    $package = $args->{-package} if defined $args->{-package};
    die "Cannot have a default for a weakened field ($field)"
        if defined $default && $args->{-weak};
    return if defined &{"${package}::$field"};
    require Scalar::Util if $args->{-weak};
    my $default_string =
        ( ref($default) eq 'ARRAY' and not @$default )

inc/Spiffy.pm view on Meta::CPAN

    }
    $code .= sprintf $code{set_default}, $field, $default_string, $field
      if defined $default;
    $code .= sprintf $code{return_if_get}, $field;
    $code .= sprintf $code{set}, $field;
    $code .= sprintf $code{weaken}, $field, $field 
      if $args->{-weak};
    $code .= sprintf $code{sub_end}, $field;

    my $sub = eval $code;
    die $@ if $@;

view all matches for this distribution

Devel-Pragma

1 match

sv_ref||5.015004|
sv_replace|||
sv_report_used|||
sv_resetpvn|||
sv_reset|||
sv_rvweaken||5.006000|
sv_sethek|||
sv_setiv_mg|5.004050||p
sv_setiv|||
sv_setnv_mg|5.006000||p
sv_setnv|||

view all matches for this distribution

Devel-Probe

1 match

sv_ref||5.015004|
sv_replace|||
sv_report_used|||
sv_resetpvn|||
sv_reset|||
sv_rvweaken||5.006000|
sv_sethek|||
sv_setiv_mg|5.004050||p
sv_setiv|||
sv_setnv_mg|5.006000||p
sv_setnv|||

view all matches for this distribution

Devel-QuickCover

1 match

sv_ref||5.015004|
sv_replace|||
sv_report_used|||
sv_resetpvn|||
sv_reset|||
sv_rvunweaken|||
sv_rvweaken||5.006000|
sv_set_undef|||
sv_sethek|||
sv_setiv_mg|5.004050||p
sv_setiv|||
sv_setnv_mg|5.006000||p

view all matches for this distribution

Devel-REPL-InProcess

3 results

lib/Devel/REPL/Client/AnyEvent.pm view on Meta::CPAN

use warnings;

use Devel::REPL::Client::AnyEvent::Connection;

use AnyEvent::Socket;
use Scalar::Util qw(weaken);
use Term::ReadKey;

use constant {
    EOT     => "\x04",
};

lib/Devel/REPL/Client/AnyEvent.pm view on Meta::CPAN


sub listen {
    my ($self) = @_;

    my $weak_self = $self;
    weaken($weak_self);
    my $cb = sub { $weak_self->_new_connection($_[0]) };
    my $prepare = ($self->{path} && defined $self->{mode}) ? sub {
        chmod $weak_self->{mode}, $weak_self->{path}
            or die "Unable to change file mode for socket: $!";
    } : undef;

view all matches for this distribution

Devel-REPL

2 results

lib/Devel/REPL/Plugin/Commands.pm view on Meta::CPAN

# ABSTRACT: Generic command creation plugin using injected functions

our $VERSION = '1.003029';

use Devel::REPL::Plugin;
use Scalar::Util qw(weaken);
use namespace::autoclean;

our $COMMAND_INSTALLER;

has 'command_set' => (

lib/Devel/REPL/Plugin/Commands.pm view on Meta::CPAN

  $self->setup_commands;
}

after 'setup_commands' => sub {
  my ($self) = @_;
  weaken($self);
  $self->command_set->{load_plugin} = sub {
    my $self = shift;
    sub { $self->load_plugin(@_); };
  };
};

view all matches for this distribution

Devel-Refcount

1 match

lib/Devel/Refcount.pm view on Meta::CPAN

   *refcount = \&_refcount_pp;
   require B;
}

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

=head1 NAME

C<Devel::Refcount> - obtain the REFCNT value of a referent

lib/Devel/Refcount.pm view on Meta::CPAN

=cut

sub assert_oneref
{
   my $object = shift;
   weaken $object;

   my $refcount = refcount( $object );
   return if $refcount == 1;

   my $message = Carp::shortmess( "Expected $object to have only one reference, found $refcount" );

view all matches for this distribution

Devel-STDERR-Indent

1 match

lib/Devel/STDERR/Indent.pm view on Meta::CPAN

package Devel::STDERR::Indent;
use Moose;

no warnings 'recursion';

use Scalar::Util qw(weaken);

use namespace::clean -except => "meta";

use Sub::Exporter -setup => {
	exports => [qw(indent)],

lib/Devel/STDERR/Indent.pm view on Meta::CPAN


sub install {
	my $self = shift;

	my $weak = $self;
	weaken($weak);

	if ( my $prev = $SIG{__WARN__} ) {
		$self->_previous_hook($prev);
	}

view all matches for this distribution

Devel-Size-Report

4 results

example/size.pl view on Meta::CPAN

  {
  use lib '../lib';
  chdir 'example' if -d 'example';
  }
use Devel::Size::Report qw(report_size);
use Scalar::Util qw/weaken/;

use IO::File;
use Math::BigFloat;

my $a = [ 8, 9, 7, [ 1,2,3, { a => 'b', size => 12.2, h => ['a'] }, 'rrr' ] ];

example/size.pl view on Meta::CPAN


print report_size( IO::File->new(), { total => '' } ), "\n";

print report_size( "a scalar", { total => '' } ), "\n";
print report_size( \"a scalar", {  } ), "\n";
my $x = \"a scalar"; weaken($x);
print report_size( $x, {  } ), "\n";

# these tw0 are actually different in size as Devel::Peek shows:
$a = [ 1,2 ];
print report_size( $a ), "\n";

view all matches for this distribution

Devel-Size

2 results

sv_reftype|||
sv_release_COW|||
sv_replace|||
sv_report_used|||
sv_reset|||
sv_rvweaken||5.006000|
sv_setiv_mg|5.004050||p
sv_setiv|||
sv_setnv_mg|5.006000||p
sv_setnv|||
sv_setpv_mg|5.004050||p

view all matches for this distribution

Devel-SizeMe

2 results

sv_reftype|||
sv_release_COW|||
sv_replace|||
sv_report_used|||
sv_reset|||
sv_rvweaken||5.006000|
sv_setiv_mg|5.004050||p
sv_setiv|||
sv_setnv_mg|5.006000||p
sv_setnv|||
sv_setpv_mg|5.004050||p

view all matches for this distribution

Devel-SlowBless

1 match

sv_reftype|||
sv_release_COW|||
sv_replace|||
sv_report_used|||
sv_reset|||
sv_rvweaken||5.006000|
sv_setiv_mg|5.004050||p
sv_setiv|||
sv_setnv_mg|5.006000||p
sv_setnv|||
sv_setpv_mg|5.004050||p

view all matches for this distribution

Devel-StackBlech

1 match