lib/Class/Abstract.pm

        start → end → jump
        

    1: package Class::Abstract;
    2: 
    3: # Minimum required Perl version: 5.8.
    4: use 5.008;
    5: use strict;
    6: use warnings;
    7: use Carp         qw(croak);
    8: use Readonly;
    9: use Scalar::Util qw(blessed);
   10: use Return::Set  qw(set_return);
   11: 
   12: =head1 NAME
   13: 
   14: Class::Abstract - Enforce abstract (non-instantiable) base classes for plain-Perl OO
   15: 
   16: =head1 VERSION
   17: 
   18: Version 0.02
   19: 
   20: =cut
   21: 
   22: our $VERSION = '0.02';
   23: 
   24: # ---------------------------------------------------------------------------
   25: # Constants
   26: # ---------------------------------------------------------------------------
   27: 
   28: # Self-referential constant: the canonical name of this package.
   29: Readonly::Scalar my $SELF => __PACKAGE__;
   30: 
   31: # Error message emitted when direct instantiation of an abstract class is
   32: # attempted.  Kept as a constant so tests can match against it exactly.
   33: Readonly::Scalar my $ERR_ABSTRACT =>
   34: 	'Cannot instantiate abstract class %s directly';
   35: 
   36: # ---------------------------------------------------------------------------
   37: # Public variables
   38: # ---------------------------------------------------------------------------
   39: 
   40: # Set to a true value to suppress all abstract-class croaks globally.
   41: # Always use 'local' in tests to prevent state from bleeding between cases.
   42: our $BYPASS = 0;
   43: 
   44: # Runtime tunables.  Modify $config{harness_bypass} to control whether
   45: # HARNESS_ACTIVE suppresses enforcement.
   46: our %config = (
   47: 	harness_bypass => 1,    # 1 = suppress croaks when HARNESS_ACTIVE is set
   48: );
   49: 
   50: # ---------------------------------------------------------------------------
   51: # PUBLIC INTERFACE
   52: # ---------------------------------------------------------------------------
   53: 
   54: =head1 SYNOPSIS
   55: 
   56:     # ---- Preferred: use parent -------------------------------------------
   57:     package Animal;
   58:     use parent 'Class::Abstract';
   59: 
   60:     # ---- Alternative: use Class::Abstract --------------------------------
   61:     package Vehicle;
   62:     use Class::Abstract;    # equivalent: adds Class::Abstract to @ISA
   63: 
   64:     # ---- Combine with Sub::Abstract for method contracts -----------------
   65:     package Animal;
   66:     use parent 'Class::Abstract';
   67:     use Sub::Abstract qw(speak eat);   # subclasses must implement these
   68: 
   69:     # ---- Concrete subclass -----------------------------------------------
   70:     package Dog;
   71:     use parent 'Animal';
   72: 
   73:     sub new {
   74:         my ($class, %args) = @_;
   75:         my $self = $class->SUPER::new;  # delegates through Animal to here
   76:         $self->{name} = $args{name};
   77:         return $self;
   78:     }
   79:     sub speak { 'Woof' }
   80:     sub eat   { 'Nom'  }
   81: 
   82:     # ---- If Animal defines its own new(), call check_abstract() first ----
   83:     package Animal;
   84:     use parent 'Class::Abstract';
   85: 
   86:     sub new {
   87:         my $class = shift;
   88:         Class::Abstract::check_abstract($class);  # enforces abstract contract
   89:         return bless { a => 'default' }, $class;
   90:     }
   91: 
   92:     # ---- Runtime behaviour -----------------------------------------------
   93:     Animal->new;             # croaks: Cannot instantiate abstract class Animal directly
   94:     Dog->new(name => 'Rex'); # returns a blessed Dog hashref
   95:     Animal->is_abstract;     # 1
   96:     Dog->is_abstract;        # 0
   97: 
   98: =head1 DESCRIPTION
   99: 
  100: Prevents direct instantiation of a class while still allowing concrete
  101: subclasses to call C<$class-E<gt>SUPER::new(...)> through the normal
  102: inheritance chain.
  103: 
  104: A class becomes abstract by listing C<Class::Abstract> as a direct parent:
  105: 
  106:     package Animal;
  107:     use parent 'Class::Abstract';   # Animal is abstract
  108: 
  109: or equivalently via C<use>:
  110: 
  111:     use Class::Abstract;            # also adds to @ISA
  112: 
  113: Only the class that has C<Class::Abstract> directly in its C<@ISA> is
  114: abstract.  Subclasses of that class are B<not> automatically abstract; each
  115: abstract class in a hierarchy must opt in explicitly.
  116: 
  117: The enforcement check is performed at runtime inside C<new()>.  When a
  118: concrete subclass calls C<$class-E<gt>SUPER::new(...)>, C<$class> is the
  119: concrete subclass, not the abstract base, so the check passes.
  120: 
  121: =head2 Usage forms
  122: 
  123: =over 4
  124: 
  125: =item Inheritance form (preferred)
  126: 
  127:     package Animal;
  128:     use parent 'Class::Abstract';
  129: 
  130: C<parent.pm> adds C<Class::Abstract> to C<@Animal::ISA>, making
  131: C<Class::Abstract::new> available via MRO.  No C<import()> call is made.
  132: C<Animal->new> will croak; C<Dog->new> (where Dog inherits Animal) will not.
  133: 
  134: =item Import form
  135: 
  136:     package Vehicle;
  137:     use Class::Abstract;
  138: 
  139: Calls C<import()>, which pushes C<Class::Abstract> onto C<@Vehicle::ISA>
  140: if not already present.  Functionally identical to the inheritance form.
  141: 
  142: =back
  143: 
  144: =head2 Multiple abstract levels in a hierarchy
  145: 
  146: Each abstract class must opt in:
  147: 
  148:     package Animal;   use parent 'Class::Abstract';      # abstract
  149:     package Mammal;   use parent 'Class::Abstract', 'Animal'; # also abstract
  150:     package Dog;      use parent 'Mammal';               # concrete
  151: 
  152: =head2 Integration with Sub::Abstract
  153: 
  154: The two modules complement each other:
  155: 
  156:     use parent 'Class::Abstract';          # cannot instantiate directly
  157:     use Sub::Abstract qw(speak eat);       # subclasses must implement speak + eat
  158: 
  159: =head2 Bypass for testing
  160: 
  161: Either condition alone (OR logic) suppresses the croak:
  162: 
  163: =over 4
  164: 
  165: =item * C<$Class::Abstract::BYPASS> set to a true value.  Use C<local> in tests.
  166: Checked first; short-circuits the second condition.
  167: 
  168: =item * C<$ENV{HARNESS_ACTIVE}> set (the convention used by L<Test::Harness>/prove)
  169: B<and> C<$config{harness_bypass}> is truthy (the default).
  170: 
  171: =back
  172: 
  173: B<Important:> C<$BYPASS> takes full precedence.  Setting
  174: C<harness_bypass = 0> does not re-enable enforcement when C<$BYPASS> is
  175: truthy.  To test enforcement inside a harness:
  176: 
  177:     local $Class::Abstract::BYPASS = 0;
  178:     local $Class::Abstract::config{harness_bypass} = 0;
  179: 
  180: =head2 Error message format
  181: 
  182:     Cannot instantiate abstract class Animal directly
  183: 
  184: =head1 METHODS/SUBROUTINES
  185: 
  186: =head2 import
  187: 
  188:     use Class::Abstract;
  189: 
  190: Called automatically by C<use Class::Abstract>.  Adds C<Class::Abstract>
  191: to the calling package's C<@ISA> (if not already present), making the
  192: calling package abstract in the same way as C<use parent 'Class::Abstract'>.
  193: 
  194: Has no effect when called on C<Class::Abstract> itself (no self-registration).
  195: 
  196: =head3 Arguments
  197: 
  198: =over 4
  199: 
  200: =item C<$class> (required, implicit)
  201: 
  202: Always C<'Class::Abstract'> in normal usage.
  203: 
  204: =back
  205: 
  206: =head3 Returns
  207: 
  208: The class name (C<'Class::Abstract'>) as a plain string.
  209: 
  210: =head3 Example
  211: 
  212:     package Vehicle;
  213:     use Class::Abstract;   # Vehicle is now abstract; Class::Abstract in @ISA
  214: 
  215: =head3 API SPECIFICATION
  216: 
  217: =head4 Input
  218: 
  219:     # No named-parameter schema: import() takes only the implicit $class.
  220: 
  221: =head4 Output
  222: 
  223:     { type => 'string' }    # always returns 'Class::Abstract'
  224: 
  225: =cut
  226: 
  227: sub import {
  228: 	my ($class) = @_;
  229: 	my $caller  = caller;
  230: 
  231: 	# Guard: unusual contexts (e.g. BEGIN{} inside string eval) can produce an
  232: 	# empty-string caller; pushing onto @{"::ISA"} would silently mutate @main::ISA.
  233: 	return set_return($class, { type => 'string' })
  234: 		unless defined($caller) && length($caller);
  235: 
  236: 	# Do not modify Class::Abstract's own @ISA -- that would be circular.
  237: 	return set_return($class, { type => 'string' }) if $caller eq $SELF;
  238: 
  239: 	# Add Class::Abstract to the caller's @ISA unless already present.
  240: 	# This is the same effect as: use parent 'Class::Abstract';
  241: 	{
  242: 		no strict 'refs';
  243: 		push @{"${caller}::ISA"}, $SELF
  244: 			unless _is_direct_abstract($caller);
  245: 	}
  246: 
  247: 	return set_return($class, { type => 'string' });
  248: }
  249: 
  250: =head2 new
  251: 
  252:     my $obj = ConcreteChild->new;
  253:     my $obj = ConcreteChild->new(%initial_attrs);
  254: 
  255: Base constructor with abstract-class enforcement.  When called on an
  256: abstract class (one with C<Class::Abstract> directly in its C<@ISA>), it
  257: croaks.  When called on a concrete subclass -- including via
  258: C<$class-E<gt>SUPER::new(...)> from a child's own C<new()> -- it succeeds
  259: and returns a blessed empty hashref.
  260: 
  261: The check is performed on the B<original invocant> (C<$class>), not on
  262: the package where C<new()> is defined.  This means C<SUPER::new> works
  263: correctly: C<$class> is the concrete subclass, so the abstract-class check
  264: passes.
  265: 
  266: =head3 Arguments
  267: 
  268: =over 4
  269: 
  270: =item C<$class> (required)
  271: 
  272: The invocant -- either a class name or a blessed object (to support
  273: C<ref($obj)->new>-style calls).
  274: 
  275: =item C<%initial_attrs> (optional, ignored)
  276: 
  277: Any additional arguments are accepted but not used by this base constructor.
  278: They are silently discarded so that subclass C<new()> methods can pass
  279: arguments through C<SUPER::new> without errors.  Subclasses should
  280: populate object attributes themselves after calling C<SUPER::new>.
  281: 
  282: =back
  283: 
  284: =head3 Returns
  285: 
  286: A new blessed empty hashref of class C<$class>.
  287: 
  288: =head3 Example
  289: 
  290:     package Dog;
  291:     our @ISA = ('Animal');   # Animal is abstract via Class::Abstract
  292: 
  293:     sub new {
  294:         my ($class, %args) = @_;
  295:         my $self = $class->SUPER::new;   # delegates to Class::Abstract::new
  296:         $self->{name} = $args{name};     # populate after SUPER
  297:         return $self;
  298:     }
  299: 
  300:     # Dog->new(name => 'Rex') works; Animal->new croaks.
  301: 
  302: =head3 API SPECIFICATION
  303: 
  304: =head4 Input
  305: 
  306:     # Positional: ($class, @ignored_args)
  307:     # $class must be a defined non-reference scalar (package name or blessed ref).
  308: 
  309: =head4 Output
  310: 
  311:     { type => 'object', isa => $class }    # a blessed hashref of the given class
  312: 
  313: =head3 PSEUDOCODE
  314: 
  315:     new($class, @args):
  316:         class <- ref($class) if blessed, else $class
  317:         UNLESS bypass is active
  318:             IF class is directly abstract
  319:                 CROAK "Cannot instantiate abstract class CLASS directly"
  320:         END UNLESS
  321:         RETURN bless({}, class)
  322: 
  323: =head3 MESSAGES
  324: 
  325:     Message                                              Meaning / Action
  326:     -------                                              ----------------
  327:     Cannot instantiate abstract class CLASS directly     CLASS has Class::Abstract
  328:                                                          directly in its @ISA (or IS
  329:                                                          Class::Abstract).  You are
  330:                                                          trying to instantiate an
  331:                                                          abstract class.  Action:
  332:                                                          instantiate a concrete
  333:                                                          subclass of CLASS instead.
  334: 
  335: =cut
  336: 
  337: sub new {
●338 → 342 → 348●338 → 342 → 0  338: 	my ($class) = @_;
  339: 
  340: 	# Accept blessed objects as invocants (e.g. $obj->new style), but reject
  341: 	# plain (unblessed) references such as arrayrefs or coderefs.
  342: 	if (ref $class) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
  343: 		croak sprintf('new() invocant must be a class name or blessed object, got %s', ref $class)
  344: 			unless blessed($class);
  345: 		$class = ref($class);
  346: 	}
  347: 
●348 → 352 → 357●348 → 352 → 0  348: 	croak 'new() requires a defined class name as invocant'
  349: 		unless defined($class) && length($class);
  350: 
  351: 	# Enforce the abstract-class contract unless bypass is active.
  352: 	unless ($BYPASS || ($config{harness_bypass} && $ENV{HARNESS_ACTIVE})) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
  353: 		croak sprintf($ERR_ABSTRACT, $class)
  354: 			if _is_direct_abstract($class);
  355: 	}
  356: 
●357 → 357 → 0  357: 	return bless {}, $class;
  358: }
  359: 
  360: =head2 check_abstract
  361: 
  362:     Class::Abstract::check_abstract($class);
  363:     $class->Class::Abstract::check_abstract;
  364: 
  365: Enforces the abstract-class contract from within a user-defined C<new()>.
  366: Call this at the top of an abstract class's own C<new()> when that class
  367: overrides C<new()> directly rather than delegating to C<SUPER::new()>.
  368: Croaks if C<$class> is directly abstract and no bypass is active; returns
  369: normally otherwise.
  370: 
  371: B<When to use:> If your abstract class defines its own C<new()> and that
  372: C<new()> creates the object directly (via C<bless>) rather than calling
  373: C<$class-E<gt>SUPER::new>, you must call C<check_abstract()> first -- otherwise
  374: the enforcement in C<Class::Abstract::new> is never reached.
  375: 
  376:     package Animal;
  377:     use parent 'Class::Abstract';
  378: 
  379:     sub new {
  380:         my $class = shift;
  381:         Class::Abstract::check_abstract($class);  # croaks if $class is Animal
  382:         return bless { a => 'default' }, $class;  # only reaches here for subclasses
  383:     }
  384: 
  385: =head3 Arguments
  386: 
  387: =over 4
  388: 
  389: =item C<$class> (required)
  390: 
  391: A class name string or a blessed object.  Unblessed references are rejected.
  392: 
  393: =back
  394: 
  395: =head3 Returns
  396: 
  397: C<undef> on success (i.e. C<$class> is concrete or bypass is active).
  398: Croaks on failure.
  399: 
  400: =head3 MESSAGES
  401: 
  402:     Message                                              Meaning / Action
  403:     -------                                              ----------------
  404:     Cannot instantiate abstract class CLASS directly     Same as new() -- see above.
  405:     check_abstract() requires a class name or           Invocant was an unblessed ref.
  406:       blessed object
  407:     check_abstract() requires a defined class name      Invocant was undef or empty string.
  408: 
  409: =cut
  410: 
  411: sub check_abstract {
●412 → 414 → 420●412 → 414 → 0  412: 	my ($class) = @_;
  413: 
  414: 	if (ref $class) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
  415: 		croak 'check_abstract() requires a class name or blessed object'
  416: 			unless blessed($class);
  417: 		$class = ref($class);
  418: 	}
  419: 
●420 → 423 → 427●420 → 423 → 0  420: 	croak 'check_abstract() requires a defined class name'
  421: 		unless defined($class) && length($class);
  422: 
  423: 	unless ($BYPASS || ($config{harness_bypass} && $ENV{HARNESS_ACTIVE})) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
  424: 		croak sprintf($ERR_ABSTRACT, $class)
  425: 			if _is_direct_abstract($class);
  426: 	}
●427 → 427 → 0  427: 	return;
  428: }
  429: 
  430: =head2 is_abstract
  431: 
  432:     my $bool = SomeClass->is_abstract;
  433:     my $bool = $obj->is_abstract;
  434:     my $bool = Class::Abstract->is_abstract('SomeClass');
  435: 
  436: Returns C<1> if the invocant (or named class) is a B<directly> abstract class
  437: (i.e. has C<Class::Abstract> in its own C<@ISA>, or is C<Class::Abstract>
  438: itself).  Returns C<0> for concrete subclasses even if they transitively
  439: inherit from an abstract base.
  440: 
  441: Inheritable via MRO: any class that has C<Class::Abstract> in its ancestry
  442: can call this as a class method or an instance method.
  443: 
  444: =head3 Arguments
  445: 
  446: =over 4
  447: 
  448: =item C<$self_or_class> (required)
  449: 
  450: The invocant -- a class name, a blessed object, or C<Class::Abstract>
  451: itself.  When a class name is passed, C<is_abstract> is checked on that
  452: class.  When a blessed object is passed, the object's class is used.
  453: 
  454: =item C<$class_name> (optional)
  455: 
  456: When provided, check this class name instead of resolving from the invocant.
  457: Intended for the explicit form C<Class::Abstract->is_abstract('SomeClass')>.
  458: 
  459: =back
  460: 
  461: =head3 Returns
  462: 
  463: C<1> if directly abstract, C<0> otherwise, as a plain integer.
  464: 
  465: =head3 Example
  466: 
  467:     Animal->is_abstract;    # 1 (Animal has Class::Abstract in @ISA)
  468:     Dog->is_abstract;       # 0 (Dog's @ISA contains Animal, not Class::Abstract)
  469: 
  470:     my $dog = Dog->new(name => 'Rex');
  471:     $dog->is_abstract;      # 0 (checks ref($dog) = 'Dog')
  472: 
  473: =head3 API SPECIFICATION
  474: 
  475: =head4 Input
  476: 
  477:     # Positional: ($self_or_class)
  478:     # Must be a defined value (class name string or blessed ref).
  479: 
  480: =head4 Output
  481: 
  482:     { type => 'integer', values => [0, 1] }
  483: 
  484: =cut
  485: 
  486: sub is_abstract {
  487: 	my ($self, $class_arg) = @_;
  488: 
  489: 	# Three-argument form: Class::Abstract->is_abstract('SomeClass') -- use the arg.
  490: 	# Two-argument form: SomeClass->is_abstract or $obj->is_abstract -- use invocant.
  491: 	my $class = defined($class_arg) ? $class_arg : (ref($self) || $self);
  492: 
  493: 	croak 'is_abstract() requires a class name or object invocant'
  494: 		unless defined($class) && length($class);
  495: 
  496: 	return _is_direct_abstract($class);
  497: }
  498: 
  499: # ---------------------------------------------------------------------------
  500: # PRIVATE SUBROUTINES
  501: # ---------------------------------------------------------------------------
  502: 
  503: # _is_direct_abstract
  504: # Determine whether a class is directly abstract, meaning
  505: #        Class::Abstract appears in its own @ISA (not transitively).
  506: # Entry        : $class -- the package name to check (plain string)
  507: # Exit status  : Returns 1 if directly abstract, 0 (empty string) if not.
  508: # Notes        : Class::Abstract itself is treated as abstract (the module
  509: #                cannot be instantiated directly).
  510: #                This check is intentionally shallow: only the immediate @ISA
  511: #                is inspected.  Concrete subclasses that inherit transitively
  512: #                from an abstract class are NOT considered abstract by this
  513: #                predicate, which is the correct behaviour.
  514: sub _is_direct_abstract {
  515: 	my ($class) = @_;
  516: 
  517: 	return 0 unless defined $class;
  Mutants (Total: 2, Killed: 2, Survived: 0)
  518: 
  519: 	# Class::Abstract itself must not be instantiable.
  520: 	return 1 if $class eq $SELF;
  Mutants (Total: 2, Killed: 2, Survived: 0)
  521: 
  522: 	# Check if Class::Abstract appears directly in the class's own @ISA.
  523: 	no strict 'refs';
  524: 	return (grep { $_ eq $SELF } @{"${class}::ISA"}) ? 1 : 0;
  525: }
  526: 
  527: 1;
  528: 
  529: __END__
  530: 
  531: =head1 KNOWN LIMITATIONS
  532: 
  533: =over 4
  534: 
  535: =item Only direct @ISA is checked
  536: 
  537: C<_is_direct_abstract> looks only at the immediate C<@ISA> of the invocant.
  538: If C<Class::Abstract> appears higher in the MRO (e.g. C<Dog> inherits
  539: C<Animal> which is abstract), C<Dog> is B<not> considered abstract -- which
  540: is the intended behaviour.  However this also means that making a subclass
  541: abstract requires an explicit opt-in:
  542: 
  543:     package Mammal;
  544:     use parent 'Class::Abstract', 'Animal';   # both in @ISA; Mammal is abstract
  545: 
  546: =item C<isa()> cannot distinguish abstract from concrete
  547: 
  548: C<Dog-E<gt>isa('Class::Abstract')> returns true (Dog inherits Class::Abstract
  549: transitively).  Use C<is_abstract()> to distinguish direct-abstract from
  550: merely-related-to-abstract.
  551: 
  552: =item C<can('new')> returns the croak-stub
  553: 
  554: C<< Animal->can('new') >> returns C<Class::Abstract::new> (a truthy CODE ref),
  555: suggesting the method is callable.  It is callable -- it will just croak.
  556: 
  557: =item new() discards constructor arguments
  558: 
  559: The base constructor ignores all arguments beyond C<$class> and returns an
  560: empty blessed hashref.  Subclasses must populate their own attributes after
  561: calling C<SUPER::new>.  If you need a smarter base constructor (e.g. one
  562: that accepts named parameters and validates them), override C<new()> in
  563: your abstract base class.
  564: 
  565: =item Bypass precedence
  566: 
  567: The bypass guard is C<$BYPASS || ($config{harness_bypass} &&
  568: $ENV{HARNESS_ACTIVE})>.  C<$BYPASS> short-circuits the C<||>, so setting
  569: C<$config{harness_bypass} = 0> does B<not> re-enable enforcement when
  570: C<$BYPASS> is truthy.  Both must be cleared to test enforcement in a harness:
  571: 
  572:     local $Class::Abstract::BYPASS = 0;
  573:     local $Class::Abstract::config{harness_bypass} = 0;
  574: 
  575: =item Thread safety
  576: 
  577: No shared mutable state is used beyond C<$BYPASS> and C<%config> (both
  578: read-only in normal operation).  C<import()> modifies caller's C<@ISA>
  579: at compile time; this is safe as long as modules are not C<require>d
  580: concurrently from multiple threads.
  581: 
  582: =item DESTROY and Perl 5.42+
  583: 
  584: If a class marks C<DESTROY> as abstract via C<Sub::Abstract>, exceptions
  585: thrown inside C<DESTROY> are silently discarded on Perl 5.42+ (emitted to
  586: STDERR instead).  Test with C<lives_ok> for C<DESTROY> paths.
  587: 
  588: =item Not for Moo/Moose
  589: 
  590: Moo's C<requires> and Moose's C<abstract> provide similar guarantees within
  591: their own object systems.  This module is for plain-Perl OO only.
  592: 
  593: =back
  594: 
  595: =head1 FORMAL SPECIFICATION
  596: 
  597: The following schemas formally specify the module's behaviour.
  598: 
  599:     -- Type abbreviations
  600:     Package  == seq CHAR    -- Perl package name string
  601: 
  602:     -- System state
  603:     +-Registry--------------------------------------------+
  604:     | bypass    : BOOL                                    |
  605:     | config    : { harness_bypass : BOOL }               |
  606:     +-----------------------------------------------------+
  607: 
  608:     -- Initial state
  609:     +-InitRegistry----------------------------------------+
  610:     | Registry                                            |
  611:     |-----------------------------------------------------|
  612:     | bypass    = false                                   |
  613:     | config    = { harness_bypass |-> true }             |
  614:     +-----------------------------------------------------+
  615: 
  616:     -- Bypass predicate
  617:     bypass_active(R) <=>
  618:         R.bypass
  619:         or (R.config.harness_bypass and HARNESS_ACTIVE)
  620: 
  621:     -- Directly-abstract predicate
  622:     is_direct_abstract(c) <=>
  623:         c = 'Class::Abstract'
  624:         \/ 'Class::Abstract' in direct_ISA(c)
  625: 
  626:     -- AbstractNew (success): concrete class or bypass active
  627:     +-AbstractNew-----------------------------------------+
  628:     | class?   : Package                                  |
  629:     | result!  : class? (blessed hashref)                |
  630:     |-----------------------------------------------------|
  631:     | (not is_direct_abstract(class?))                    |
  632:     | \/ bypass_active                                   |
  633:     | result! = bless({}, class?)                        |
  634:     +-----------------------------------------------------+
  635: 
  636:     -- AbstractNew (failure): abstract class, no bypass
  637:     +-AbstractNewFail--------------------------------------+
  638:     | class?   : Package                                  |
  639:     |-----------------------------------------------------|
  640:     | is_direct_abstract(class?) /\ not bypass_active     |
  641:     | croak("Cannot instantiate abstract class "          |
  642:     |        ++ class? ++ " directly")                    |
  643:     +-----------------------------------------------------+
  644: 
  645:     -- Key properties:
  646:     --   When Dog->SUPER::new is called, $class = 'Dog'.
  647:     --   is_direct_abstract('Dog') is false (Dog's @ISA = ('Animal')).
  648:     --   Enforcement never fires for concrete subclasses via SUPER::new.
  649: 
  650: =head1 DEPENDENCIES
  651: 
  652: L<Carp> (core),
  653: L<Scalar::Util> (core),
  654: L<Readonly>,
  655: L<Return::Set>.
  656: 
  657: =head1 SEE ALSO
  658: 
  659: =over 4
  660: 
  661: =item * L<Test Dashboard|https://nigelhorne.github.io/Class-Abstract/coverage/>
  662: 
  663: =item * L<Sub::Abstract>
  664: 
  665: Sister module: enforces abstract (pure-virtual) method contracts.
  666: Pair with C<Class::Abstract> to create fully enforced abstract base classes.
  667: 
  668: =item * L<Sub::Private>
  669: 
  670: Sister module: enforces strictly private (owner-only) access.
  671: 
  672: =item * L<Sub::Protected>
  673: 
  674: Sister module: enforces protected (owner + subclass) access.
  675: 
  676: =back
  677: 
  678: =head1 PUBLIC VARIABLES
  679: 
  680: =head2 C<$BYPASS>
  681: 
  682: Set to a true value to disable the abstract-class croak.  Use C<local>:
  683: 
  684:     local $Class::Abstract::BYPASS = 1;
  685: 
  686: B<Warning:> any truthy value (including C<"false">, C<"0E0">) enables bypass.
  687: 
  688: =head2 C<%config>
  689: 
  690: =over 4
  691: 
  692: =item C<harness_bypass> (default: 1)
  693: 
  694: When true, the abstract-class croak is suppressed whenever
  695: C<$ENV{HARNESS_ACTIVE}> is set.  Set to 0 to test enforcement in a harness.
  696: Note C<$BYPASS> takes precedence (see L</Bypass precedence>).
  697: 
  698: =back
  699: 
  700: =head1 FORMAL SPECIFICATION
  701: 
  702: =head2 import
  703: 
  704:     -- Type abbreviations
  705:     Package == seq CHAR    -- Perl package name string
  706: 
  707:     -- Pre-condition
  708:     caller? : Package
  709:     caller? /= 'Class::Abstract'
  710: 
  711:     -- Post-condition
  712:     'Class::Abstract' in ISA(caller?)
  713: 
  714:     -- Effect on ISA
  715:     ISA(caller?)' = ISA(caller?) union {'Class::Abstract'}
  716:                     if 'Class::Abstract' not in ISA(caller?),
  717:                     ISA(caller?) otherwise
  718: 
  719: =head2 new
  720: 
  721:     -- bypass_active predicate (OR; $BYPASS checked first)
  722:     bypass_active <=>
  723:         $BYPASS
  724:         or ($config{harness_bypass} and HARNESS_ACTIVE)
  725: 
  726:     -- Successful construction
  727:     +-- New (success) ----------------------------------------+
  728:     | class?   : Package                                      |
  729:     | result!  : blessed hashref                             |
  730:     |---------------------------------------------------------|
  731:     | not is_direct_abstract(class?) \/ bypass_active        |
  732:     | result! = bless({}, class?)                            |
  733:     +---------------------------------------------------------+
  734: 
  735:     -- Failed construction
  736:     +-- New (failure) ----------------------------------------+
  737:     | class?   : Package                                      |
  738:     |---------------------------------------------------------|
  739:     | is_direct_abstract(class?) /\ not bypass_active        |
  740:     | croak("Cannot instantiate abstract class "             |
  741:     |        ++ class? ++ " directly")                       |
  742:     +---------------------------------------------------------+
  743: 
  744: =head2 is_abstract
  745: 
  746:     -- is_abstract predicate
  747:     +-- IsAbstract -------------------------------------------+
  748:     | self?   : Package | blessed ref                         |
  749:     | result! : B                                             |
  750:     |---------------------------------------------------------|
  751:     | let c = ref(self?) if blessed, else self?               |
  752:     | result! = is_direct_abstract(c)                         |
  753:     +---------------------------------------------------------+
  754: 
  755:     -- is_direct_abstract predicate
  756:     is_direct_abstract(c) <=>
  757:         c = 'Class::Abstract'
  758:         \/ 'Class::Abstract' in direct_ISA(c)
  759: 
  760: =head1 AUTHOR
  761: 
  762: Nigel Horne, C<< <njh at nigelhorne.com> >>
  763: 
  764: =head1 LICENCE AND COPYRIGHT
  765: 
  766: Copyright 2026 Nigel Horne.
  767: 
  768: Usage is subject to the GPL2 licence terms.
  769: If you use it, please let me know.
  770: 
  771: =cut