lib/Sub/Private.pm

Structural Coverage (Approximate)

TER1 (Statement): 100.00%
TER2 (Branch): 100.00%
TER3 (LCSAJ): 66.7% (6/9)
Approximate LCSAJ segments: 33

LCSAJ Legend

Covered — this LCSAJ path was executed during testing.

Not covered — this LCSAJ path was never executed. These are the paths to focus on.

Multiple dots on a line indicate that multiple control-flow paths begin at that line. Hovering over any dot shows:

        start → end → jump
        

Uncovered paths show [NOT COVERED] in the tooltip.

Mutant Testing Legend

Survived (tests missed this) Killed (tests detected this) No mutation
    1: package Sub::Private;
    2: 
    3: # Minimum Perl version: 5.8 (Attribute::Handlers became core in 5.8)
    4: use 5.008;
    5: use strict;
    6: use warnings;
    7: use autodie qw(:all);
    8: 
    9: use Attribute::Handlers;
   10: use Carp              qw(croak carp);
   11: use Readonly;
   12: use Params::Validate::Strict 0.33 qw(validate_strict);
   13: use Return::Set       qw(set_return);
   14: use Sub::Identify     qw(get_code_info);
   15: 
   16: # namespace::clean is used as a class method only; import nothing.
   17: use namespace::clean qw();
   18: 
   19: =head1 NAME
   20: 
   21: Sub::Private - Private subroutines and methods
   22: 
   23: =head1 VERSION
   24: 
   25: Version 0.05
   26: 
   27: =cut
   28: 
   29: our $VERSION = '0.05';
   30: 
   31: # ---------------------------------------------------------------------------
   32: # Mode-name constants.  Using Readonly prevents accidental overwriting.
   33: # ---------------------------------------------------------------------------
   34: 
   35: Readonly::Scalar my $MODE_NAMESPACE => 'namespace';
   36: Readonly::Scalar my $MODE_ENFORCE   => 'enforce';
   37: 
   38: # Config-key constants -- avoids bare magic strings in %config lookups.
   39: Readonly::Scalar my $KEY_MODE           => 'mode';
   40: Readonly::Scalar my $KEY_HARNESS_BYPASS => 'harness_bypass';
   41: 
   42: # Self-referential constant: the canonical name of this package.
   43: Readonly::Scalar my $SELF => __PACKAGE__;
   44: 
   45: # Validation schema for a single Perl sub name passed to import().
   46: Readonly::Scalar my $SUB_NAME_SCHEMA => {
   47: 	name => {
   48: 		type  => 'string',
   49: 		regex => qr/\A[_a-zA-Z]\w*\z/,
   50: 	}
   51: };
   52: 
   53: =head1 SYNOPSIS
   54: 
   55:     package Foo;
   56:     use Sub::Private;
   57: 
   58:     sub foo { return 42 }
   59: 
   60:     sub bar :Private {
   61:         return foo() + 1;
   62:     }
   63: 
   64:     sub baz {
   65:         return bar() + 1;
   66:     }
   67: 
   68: =head1 DESCRIPTION
   69: 
   70: Enforces strictly private access on subroutines.  A subroutine decorated
   71: with C<:Private> (or named in C<use Sub::Private qw(...)> when in enforce
   72: mode) may only be called from within its defining package.  Subclasses do
   73: not inherit access: private means I<this package only>.
   74: 
   75: =head2 Two enforcement modes
   76: 
   77: =over 4
   78: 
   79: =item C<namespace> mode (default, backward-compatible)
   80: 
   81: Removes the subroutine from the package symbol table using
   82: L<namespace::clean>.  Direct (non-method) function calls compiled before
   83: cleanup still work because Perl optimises them to direct opcode references.
   84: OO method dispatch (C<$self->name>) does not work for private subs in this
   85: mode because method lookup uses the symbol table at runtime.
   86: 
   87: This is the default mode and is backward-compatible with all existing code.
   88: 
   89: =item C<enforce> mode (OO-safe, opt-in)
   90: 
   91: Replaces the subroutine with a wrapper closure that checks C<caller> at
   92: call time and either delegates (owner package) or croaks (anyone else).
   93: Works correctly with OO dispatch (C<$self->_helper>).
   94: 
   95: Enable before declaring your first private sub:
   96: 
   97:     BEGIN { $Sub::Private::config{mode} = 'enforce' }
   98:     package MyClass;
   99:     use Sub::Private;
  100:     sub _helper :Private { ... }
  101: 
  102: =back
  103: 
  104: =head2 Bypass for testing
  105: 
  106: Either condition alone (OR logic) disables all access checks in enforce
  107: mode:
  108: 
  109: =over 4
  110: 
  111: =item * C<$Sub::Private::BYPASS> set to a true value.  Use C<local> in
  112: tests.
  113: 
  114: =item * C<$ENV{HARNESS_ACTIVE}> set (the convention used by
  115: L<Test::Harness>/prove).
  116: 
  117: =back
  118: 
  119: C<$Sub::Private::BYPASS> is the recommended form for new test code.
  120: The C<HARNESS_ACTIVE> bypass can be disabled:
  121: 
  122:     $Sub::Private::config{harness_bypass} = 0;
  123: 
  124: =head2 Configuration
  125: 
  126:     $Sub::Private::config{mode}            -- 'namespace' (default) or 'enforce'
  127:     $Sub::Private::config{harness_bypass}  -- 1 (default); set to 0 to test enforcement
  128: 
  129: =head2 Error message format (enforce mode)
  130: 
  131:     bar() is a private subroutine of Foo and cannot be called from Bar
  132: 
  133: =cut
  134: 
  135: # Public bypass flag.  Use C<local $Sub::Private::BYPASS = 1> in test code.
  136: our $BYPASS = 0;
  137: 
  138: # Module configuration.  //= preserves any value a caller set in a BEGIN
  139: # block before this module body runs.
  140: our %config;
  141: $config{$KEY_MODE}           //= $MODE_NAMESPACE;
  142: $config{$KEY_HARNESS_BYPASS} //= 1;
  143: 
  144: # Pending (owner_pkg, sub_name) pairs to be wrapped at CHECK time.
  145: # Populated by import(); consumed and cleared by the CHECK block.
  146: my @_pending;
  147: 
  148: # Set to 1 once the CHECK block fires so import() can wrap immediately.
  149: my $_post_check = 0;
  150: 
  151: # -------------------------------------------------------------------
  152: # ATTRIBUTE HANDLER
  153: # -------------------------------------------------------------------
  154: 
  155: # Install :Private in UNIVERSAL so every package can use it after a
  156: # single "use Sub::Private", with no per-package setup required.
  157: # ATTR(CODE,CHECK) fires at CHECK time, after all subs are compiled.
  158: sub UNIVERSAL::Private :ATTR(CODE,CHECK) {
[NOT COVERED] 159 → 165 → 175[NOT COVERED] 159 → 165 → 0  159: 	my ($package, $symbol, $referent, $attr, $data) = @_;
  160: 	my $sub_name = *{$symbol}{NAME};
  161: 
  162: 	# Reject unrecognised mode values early rather than silently misbehaving.
  163: 	_assert_known_mode($config{$KEY_MODE});
  164: 
  165: 	if ($config{$KEY_MODE} eq $MODE_ENFORCE) {

Mutants (Total: 1, Killed: 1, Survived: 0)

166: # Enforce mode: replace the stash entry with an access-checking wrapper. 167: no warnings 'redefine'; 168: *{$symbol} = _wrap($package, $sub_name, $referent); 169: } else { 170: # Namespace mode: remove the sub from the stash entirely. 171: # on_scope_end does NOT work from a CHECK-phase callback, so we call 172: # clean_subroutines() directly here. 173: namespace::clean->clean_subroutines( get_code_info($referent) ); 174: } [NOT COVERED] 175 → 175 → 0 175: return; 176: } 177: 178: # ------------------------------------------------------------------- 179: # PUBLIC INTERFACE 180: # ------------------------------------------------------------------- 181: 182: =head1 PUBLIC INTERFACE 183: 184: =head2 import 185: 186: use Sub::Private; # attribute form -- no arguments 187: use Sub::Private qw(_a _b _c); # declarative form (enforce mode only) 188: 189: =head3 Purpose 190: 191: Called automatically by C<use Sub::Private>. 192: 193: With B<no arguments>: makes the C<:Private> attribute globally available 194: via C<UNIVERSAL>. No other action is taken. 195: 196: With B<one or more sub names>: registers those named subs in the calling 197: package for access-enforcement wrapping at C<CHECK> time. If C<CHECK> 198: has already fired (e.g., when calling from a test), wrapping is applied 199: immediately. Requires C<$Sub::Private::config{mode}> to equal 200: C<'enforce'>; croaks otherwise. 201: 202: =head3 Arguments 203: 204: =over 4 205: 206: =item C<@subs> (optional) 207: 208: Zero or more Perl sub names. Each must be a defined, non-reference scalar 209: matching C</\A[_a-zA-Z]\w*\z/>. C<undef>, references, empty strings, and 210: names starting with a digit or containing hyphens are all rejected. 211: 212: =back 213: 214: =head3 Returns 215: 216: The class name (C<'Sub::Private'>) as a plain string in all cases. 217: 218: =head3 Side effects 219: 220: =over 4 221: 222: =item * Pre-CHECK: appends C<[$owner_pkg, $sub_name]> pairs to the 223: internal C<@_pending> list. 224: 225: =item * Post-CHECK: installs wrapper closures directly in the calling 226: package's stash. 227: 228: =back 229: 230: =head3 Example 231: 232: BEGIN { $Sub::Private::config{mode} = 'enforce' } 233: package MyClass; 234: use Sub::Private qw(_helper _init); 235: 236: sub new { bless {}, shift } 237: sub _helper { ... } # wrapped at CHECK time 238: sub _init { ... } # wrapped at CHECK time 239: sub run { my $s = shift; $s->_helper; $s->_init } 240: 241: =head3 API specification 242: 243: =head4 Input 244: 245: # No-argument form: always valid. 246: Sub::Private->import(); 247: 248: # Declarative form (enforce mode only): 249: { 250: subs => { 251: type => 'array', 252: optional => 1, 253: element => { 254: type => 'string', 255: regex => qr/\A[_a-zA-Z]\w*\z/, 256: }, 257: } 258: } 259: 260: =head4 Output 261: 262: { type => 'string' } # returns the class name 'Sub::Private' 263: 264: =head3 MESSAGES 265: 266: Message Meaning / Action 267: --------------------------------------------------- ----------------------------------------------- 268: "Sub::Private->import: declarative form requires use Sub::Private qw(...) was called while 269: mode => 'enforce'" $config{mode} is not 'enforce'. Set 270: $config{mode} = 'enforce' in a BEGIN block 271: before "use Sub::Private". 272: 273: "Sub::Private->import: 'NAME' is not a valid The sub name failed the identifier regex. 274: Perl identifier" Check for typos, hyphens, leading digits, 275: undef, or reference values in the import list. 276: 277: "Sub::Private: PKG::NAME is not defined" The named sub was not found in the stash at 278: wrap time. Define the sub before import() 279: runs, or before CHECK fires. 280: 281: =cut 282: 283: sub import { 284 → 294 → 307284 → 294 → 0 284: my ($class, @subs) = @_; 285: 286: # No sub names: the :Private attribute is always available via UNIVERSAL. 287: return set_return($class, { type => 'string' }) unless @subs; 288: 289: # Declarative form is only meaningful in enforce mode. 290: croak "$SELF->import: declarative form requires mode => '$MODE_ENFORCE'" 291: if $config{$KEY_MODE} ne $MODE_ENFORCE; 292: 293: # Validate every name before touching the stash (fail-fast, all-or-nothing). 294: for my $sub_name (@subs) { 295: # Coerce invalid types (undef, ref) to empty string before schema check. 296: my $check = (defined $sub_name && !ref $sub_name) ? $sub_name : q{}; 297: eval { 298: validate_strict( 299: schema => $SUB_NAME_SCHEMA, 300: input => { name => $check }, 301: ); 302: }; 303: croak "$SELF->import: '$check' is not a valid Perl identifier" if $@; 304: } 305: 306: # Schedule or immediately apply wrapping depending on compile phase. 307 → 308 → 314307 → 308 → 0 307: my $owner_pkg = caller; 308: if ($_post_check) {

Mutants (Total: 1, Killed: 1, Survived: 0)

309: _process_one($owner_pkg, $_) for @subs; 310: } else { 311: push @_pending, [ $owner_pkg, $_ ] for @subs; 312: } 313: 314 → 314 → 0 314: return set_return($class, { type => 'string' }); 315: } 316: 317: # ------------------------------------------------------------------- 318: # CHECK-TIME PROCESSING 319: # ------------------------------------------------------------------- 320: 321: # Process all declarative wraps queued during import(). 322: # After this fires, $_post_check=1 so future import() calls wrap immediately. 323: CHECK { 324: $_post_check = 1; 325: _process_one(@$_) for @_pending; 326: @_pending = (); 327: } 328: 329: # ------------------------------------------------------------------- 330: # PRIVATE SUBROUTINES 331: # ------------------------------------------------------------------- 332: 333: # _assert_known_mode 334: # Purpose : Validate that $config{mode} is a recognised string. 335: # Entry : $mode -- the value to validate 336: # Exit status : Returns normally for 'namespace' or 'enforce'; croaks 337: # with a descriptive message for any other value. 338: sub _assert_known_mode { 339: my ($mode) = @_; 340: return if $mode eq $MODE_NAMESPACE || $mode eq $MODE_ENFORCE; 341: croak "$SELF: unknown mode '$mode'" 342: . " -- use '$MODE_NAMESPACE' or '$MODE_ENFORCE'"; 343: } 344: 345: # _process_one 346: # Purpose : Look up a named sub in a package stash and install a wrapper. 347: # Entry : $owner_pkg -- the package that declared the sub 348: # $sub_name -- the unqualified sub name to wrap 349: # Exit status : Returns normally; the stash entry is replaced with a wrapper. 350: # Side effects : Modifies the package stash for $owner_pkg. 351: # Notes : Guarded by _assert_private_caller -- external calls croak. 352: sub _process_one { 353: my ($owner_pkg, $sub_name) = @_; 354: 355: # Guard: only Sub::Private itself may call this. 356: _assert_private_caller('_process_one') 357: unless $BYPASS || ($config{$KEY_HARNESS_BYPASS} && $ENV{HARNESS_ACTIVE}); 358: 359: no strict 'refs'; 360: 361: # Ensure the target sub exists in the stash before wrapping. 362: croak "$SELF: ${owner_pkg}::${sub_name} is not defined" 363: unless defined &{"${owner_pkg}::${sub_name}"}; 364: 365: my $code = \&{"${owner_pkg}::${sub_name}"}; 366: 367: # Replace the stash entry with the enforcement wrapper. 368: no warnings 'redefine'; 369: *{"${owner_pkg}::${sub_name}"} = _wrap($owner_pkg, $sub_name, $code); 370: return; 371: } 372: 373: # _wrap 374: # Purpose : Build an enforcement wrapper closure around a coderef. 375: # Entry : $owner_pkg -- the package that owns the private sub 376: # $sub_name -- the unqualified sub name (for error messages) 377: # $code -- the original coderef to delegate to 378: # Exit status : Returns a new coderef that enforces the private-access rule. 379: # Side effects : none (variables captured by closure) 380: # Notes : goto &$code is used rather than $code->(@_) so that caller() 381: # inside the private sub sees the real caller, not Sub::Private. 382: # This is load-bearing: removing it breaks tests that inspect 383: # caller() inside a private sub. Guarded by _assert_private_caller. 384: sub _wrap { 385: my ($owner_pkg, $sub_name, $code) = @_; 386: 387: # Guard: only Sub::Private itself may call this. 388: _assert_private_caller('_wrap') 389: unless $BYPASS || ($config{$KEY_HARNESS_BYPASS} && $ENV{HARNESS_ACTIVE}); 390: 391: # Capture the three args in the closure; the wrapper has no mutable state. 392: return sub { 393: Sub::Private::_check_access($owner_pkg, $sub_name); 394: goto &$code; ## no critic (ControlStructures::ProhibitGoto) 395: }; 396: } 397: 398: # _check_access 399: # Purpose : Enforce the private-access invariant at call time. 400: # Entry : $owner_pkg -- the package that owns the private sub 401: # $sub_name -- unqualified sub name (for error messages) 402: # Exit status : Returns normally if the immediate non-Sub::Private caller is 403: # the owner package. Croaks if any other package is found first. 404: # Notes : Unlike Sub::Protected there is NO ->isa check. Private means 405: # the owner package ONLY; subclasses are blocked. 406: # The stack walk skips Sub::Private frames so the wrapper is 407: # transparent to the check. 408: sub _check_access { 409 → 417 → 0 409: my ($owner_pkg, $sub_name) = @_; 410: 411: # Fast bypass paths: either condition alone disables all checks (OR logic). 412: return if $BYPASS; 413: return if $config{$KEY_HARNESS_BYPASS} && $ENV{HARNESS_ACTIVE}; 414: 415: # Walk the call stack, skipping Sub::Private wrapper frames. 416: my $frame = 0; 417: while (1) { 418: my $pkg = (caller($frame))[0]; 419: 420: # Reached the bottom of the stack with no valid caller found. 421: if (!defined $pkg) {

Mutants (Total: 1, Killed: 1, Survived: 0)

422: croak "${sub_name}() is a private subroutine of ${owner_pkg}" 423: . ' and cannot be called from outside any package'; 424: } 425: 426: # Skip any Sub::Private frames (e.g., the wrapper closure itself). 427: $frame++, next if $pkg eq $SELF; 428: 429: # The first non-Sub::Private caller must be the owner; everyone else 430: # is blocked -- no isa allowance, unlike Sub::Protected. 431: return if $pkg eq $owner_pkg; 432: croak "${sub_name}() is a private subroutine of ${owner_pkg}" 433: . " and cannot be called from ${pkg}"; 434: } 435: } 436: 437: # _assert_private_caller 438: # Purpose : Croak if a guarded private method was called from outside 439: # Sub::Private. 440: # Entry : $method_name -- the guarded method name (for error messages) 441: # Exit status : Returns normally if caller(1) is Sub::Private; croaks 442: # otherwise with a descriptive message. 443: # Notes : caller(1) is the package that called the guarded method, 444: # which in turn called this function. 445: sub _assert_private_caller { 446: my ($method_name) = @_; 447: 448: # caller(1): the package one frame above the guarded method. 449: my $caller = (caller(1))[0] // q{}; 450: 451: # Only calls originating within Sub::Private itself are permitted. 452: return if $caller eq $SELF; 453: 454: croak "${method_name}() is a private method of $SELF" 455: . " and cannot be called from ${caller}"; 456: } 457: 458: 1; 459: 460: __END__ 461: 462: =head1 PUBLIC VARIABLES 463: 464: =head2 C<$BYPASS> 465: 466: Set to a true value to disable all access checks (enforce mode only). 467: Use C<local> in tests; see L</Bypass for testing>. 468: 469: =head2 C<%config> 470: 471: Module-level configuration hash. Supported keys: 472: 473: =over 4 474: 475: =item C<mode> 476: 477: C<'namespace'> (default) or C<'enforce'>. Must be set in a C<BEGIN> 478: block before C<use Sub::Private> to take effect at C<CHECK> time. 479: 480: =item C<harness_bypass> 481: 482: When true (default), access checks are skipped whenever 483: C<$ENV{HARNESS_ACTIVE}> is set. Set to 0 to test enforcement under 484: C<prove>. 485: 486: =back 487: 488: =head1 KNOWN LIMITATIONS 489: 490: =over 4 491: 492: =item C<namespace> mode: OO dispatch fails for private subs 493: 494: C<$self->_helper> from within the owner package fails because method 495: dispatch uses the symbol table at runtime, which no longer contains the 496: entry. Use C<enforce> mode for OO classes. 497: 498: =item C<enforce> mode: runtime-only 499: 500: Checks are runtime only; there is no compile-time enforcement. 501: 502: =item C<enforce> mode: raw coderef bypass 503: 504: A raw code reference obtained B<before> wrapping (via C<can()> or 505: C<\&Foo::_helper>) bypasses the check. The attribute form prevents this 506: because wrapping happens at CHECK time. 507: 508: =item C<enforce> mode: C<can()> leaks private method existence 509: 510: In C<enforce> mode the original sub is replaced by a wrapper closure, so 511: C<< ->can('_helper') >> returns the wrapper (truthy) even to callers outside 512: the owner package. In C<namespace> mode the stash entry is deleted entirely, 513: so C<< ->can >> correctly returns C<undef>. A future release may inject a 514: caller-aware C<can()> override into each class that uses C<enforce> mode, 515: returning the coderef only when the caller is the owner package and C<undef> 516: for everyone else. 517: 518: =item UNIVERSAL namespace pollution 519: 520: The C<:Private> attribute is installed in C<UNIVERSAL>, which is 521: intentional (any package can use it after a single C<use>), but it does 522: introduce C<UNIVERSAL::Private> into the global namespace. 523: 524: =back 525: 526: =head1 DEPENDENCIES 527: 528: L<Carp> (core), 529: L<Attribute::Handlers> (core since 5.8), 530: L<Readonly>, 531: L<Params::Validate::Strict>, 532: L<Return::Set>, 533: L<namespace::clean>, 534: L<Sub::Identify>. 535: 536: =head1 SEE ALSO 537: 538: =over 4 539: 540: =item * L<Test Dashboard|https://nigelhorne.github.io/Sub-Private/coverage/> 541: 542: =item * L<Sub::Protected> 543: 544: Sister module enforcing protected (owner + subclass) rather than strictly private access 545: 546: =item * L<Sub::Abstract> 547: 548: Sister module enforcing abstract (virtual) methods 549: 550: =item * L<namespace::clean> 551: 552: =back 553: 554: =head1 FORMAL SPECIFICATION 555: 556: The following Z-notation schemas formally specify the C<CheckAccess> 557: operation. 558: 559: -- Type abbreviations 560: Package == seq CHAR -- a non-empty Perl package name string 561: SubName == seq CHAR -- a Perl identifier string 562: 563: -- Private-access predicate (strictly owner only -- no isa expansion) 564: permitted : Package x Package -> BOOL 565: forall caller, owner : Package . 566: permitted(caller, owner) <=> caller = owner 567: 568: -- System state 569: +-Registry-------------------------------------------+ 570: | private : P (Package x SubName) | 571: | bypass : BOOL | 572: | config : { mode : seq CHAR, | 573: | harness_bypass : BOOL } | 574: +----------------------------------------------------+ 575: 576: -- Initial state 577: +-InitRegistry---------------------------------------+ 578: | Registry | 579: |----------------------------------------------------| 580: | private = {} | 581: | bypass = false | 582: | config = { mode |-> 'namespace', | 583: | harness_bypass |-> true } | 584: +----------------------------------------------------+ 585: 586: -- Bypass predicate 587: bypass_active(R) <=> 588: R.bypass or (R.config.harness_bypass and HARNESS_ACTIVE) 589: 590: -- Access check: no state change 591: +-CheckAccess----------------------------------------+ 592: | Xi-Registry | 593: | caller? : Package | 594: | owner? : Package | 595: | name? : SubName | 596: | ok! : BOOL | 597: |----------------------------------------------------| 598: | (owner?, name?) in private | 599: | ok! <=> bypass_active or permitted(caller?, owner?)| 600: +----------------------------------------------------+ 601: 602: -- Violation (croak case): 603: -- not ok! => 604: -- croak("name?()" ++ " is a private subroutine of " ++ owner? 605: -- ++ " and cannot be called from " ++ caller?) 606: 607: -- Key difference from Sub::Protected: 608: -- permitted(caller, owner) <=> caller = owner (identity only) 609: -- vs Sub::Protected: 610: -- permitted(caller, owner) <=> owner in anc(caller) (ISA chain) 611: 612: =head1 AUTHOR 613: 614: Original Author: 615: Peter Makholm, C<< <peter at makholm.net> >> 616: 617: Current maintainer: 618: Nigel Horne, C<< <njh at nigelhorne.com> >> 619: 620: =head1 BUGS 621: 622: Please report any bugs or feature requests to C<bug-sub-private at rt.cpan.org>, 623: or through the web interface at 624: L<https://rt.cpan.org/NoAuth/ReportBug.html?Queue=Sub-Private>. 625: 626: =head1 SUPPORT 627: 628: perldoc Sub::Private 629: 630: =over 4 631: 632: =item * RT: CPAN's request tracker 633: 634: L<https://rt.cpan.org/NoAuth/Bugs.html?Dist=Sub-Private> 635: 636: =item * Search CPAN 637: 638: L<https://search.cpan.org/dist/Sub-Private> 639: 640: =back 641: 642: =head2 FORMAL SPECIFICATION 643: 644: =head3 import 645: 646: -- Type abbreviations 647: SubName == seq CHAR -- non-empty Perl identifier string 648: 649: -- Valid identifier predicate 650: valid_id : SubName -> BOOL 651: valid_id(n) <=> n =~ /\A[_a-zA-Z]\w*\z/ 652: 653: -- Pre-condition (declarative form) 654: +-ImportPre-----------------------------------------+ 655: | config.mode = 'enforce' | 656: | forall n in subs . valid_id(n) | 657: | forall n in subs . defined(&{caller + '::' + n}) | 658: +---------------------------------------------------+ 659: 660: -- Post-condition (pre-CHECK path) 661: +-ImportPost_PreCheck-------------------------------+ 662: | @_pending' = @_pending | 663: | union { (caller, n) | n in subs } | 664: +---------------------------------------------------+ 665: 666: -- Post-condition (post-CHECK path) 667: +-ImportPost_PostCheck------------------------------+ 668: | forall n in subs . | 669: | stash(caller, n) = wrapper_closure(caller, n) | 670: +---------------------------------------------------+ 671: 672: =head1 COPYRIGHT & LICENSE 673: 674: Copyright 2009 Peter Makholm, all rights reserved. 675: Portions copyright 2024-2026 Nigel Horne. 676: 677: This program is free software; you can redistribute it and/or modify it 678: under the same terms as Perl itself. 679: 680: =cut