File Coverage

blib/lib/HO/abstract.pm

Criterion	Covered	Total	%
statement	32	34	94.1
branch	10	12	83.3
condition			n/a
subroutine	9	9	100.0
pod	2	2	100.0
total	53	57	92.9

  package HO::abstract
# *********************
; use strict; use warnings;
our $VERSION='0.02';

; use Package::Subroutine ()
; use Carp ()

; our $METHOD_DIE = sub
    { my ($method) = @_
    ; return sub
        { my $pkg = $_[0];
		; if(ref($_[0]))
            { $pkg = ref($_[0])
		    }
		; Carp::croak("Class '$pkg' does not override ${method}()")
        }
    }

; our $CLASS_DIE = sub
    { my ($class) = @_
    ; return sub
        { my $instanceof = ref($_[0])
        ; if($instanceof eq $class)
            { Carp::croak("Abstract class '$class' should not be instantiated.")
            }
          else
            { Carp::croak("Class '$instanceof' should overwrite method init from abstract class '$class'.")
            }
        }
    }

; { our $target

  ; sub abstract_method
      { my @methods = @_
      ; unless(defined($target))
	  { Carp::croak("No target class defined!")
	  }
      ; foreach my $method (@methods)
          { install Package::Subroutine::
              $target => $method => $METHOD_DIE->($method)
          }
      }

  ; sub abstract_class
      { my (@classes) = @_ ? @_ : ($target)
      ; foreach my $class (@classes)
          { install Package::Subroutine::
                     $class => 'init' => $CLASS_DIE->($class)
          }
      }

  ; sub import
      { my ($self,$action,@params) = @_
      ; return unless defined $action
      ; local $target = caller

      ; my $perform =
              { 'method' => \&abstract_method
              , 'class' => \&abstract_class
              }->{$action}
      ; die "Unknown action '$action' in use of HO::abstract." unless $perform

      ; $perform->(@params)
      }
  }

; 1

__END__