/usr/share/perl5/Sub/Defer.pm is in libmoo-perl 0.009013-1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 | package Sub::Defer;
use strictures 1;
use base qw(Exporter);
use Moo::_Utils;
our @EXPORT = qw(defer_sub undefer_sub);
our %DEFERRED;
sub undefer_sub {
my ($deferred) = @_;
my ($target, $maker, $undeferred_ref) = @{
$DEFERRED{$deferred}||return $deferred
};
${$undeferred_ref} = my $made = $maker->();
# make sure the method slot has not changed since deferral time
if (defined($target) && $deferred eq *{_getglob($target)}{CODE}||'') {
no warnings 'redefine';
*{_getglob($target)} = $made;
}
push @{$DEFERRED{$made} = $DEFERRED{$deferred}}, $made;
return $made;
}
sub defer_info {
my ($deferred) = @_;
$DEFERRED{$deferred||''};
}
sub defer_sub {
my ($target, $maker) = @_;
my $undeferred;
my $deferred_string;
my $deferred = sub {
goto &{$undeferred ||= undefer_sub($deferred_string)};
};
$deferred_string = "$deferred";
$DEFERRED{$deferred} = [ $target, $maker, \$undeferred ];
*{_getglob $target} = $deferred if defined($target);
return $deferred;
}
1;
=head1 NAME
Sub::Defer - defer generation of subroutines until they are first called
=head1 SYNOPSIS
use Sub::Defer;
my $deferred = defer_sub 'Logger::time_since_first_log' => sub {
my $t = time;
sub { time - $t };
};
Logger->time_since_first_log; # returns 0 and replaces itself
Logger->time_since_first_log; # returns time - $t
=head1 DESCRIPTION
These subroutines provide the user with a convenient way to defer creation of
subroutines and methods until they are first called.
=head1 SUBROUTINES
=head2 defer_sub
my $coderef = defer_sub $name => sub { ... };
This subroutine returns a coderef that encapsulates the provided sub - when
it is first called, the provided sub is called and is -itself- expected to
return a subroutine which will be goto'ed to on subsequent calls.
If a name is provided, this also installs the sub as that name - and when
the subroutine is undeferred will re-install the final version for speed.
=head2 undefer_sub
my $coderef = undefer_sub \&Foo::name;
If the passed coderef has been L<deferred|/defer_sub> this will "undefer" it.
If the passed coderef has not been deferred, this will just return it.
If this is confusing, take a look at the example in the L</SYNOPSIS>.
|