local-lib5/lib/perl5/Test/Object/Test.pm

   1 package Test::Object::Test;
   2
   3 use strict;
   4 use Carp         ();
   5 use Scalar::Util ();
   6
   7 use vars qw{$VERSION};
   8 BEGIN {
   9         $VERSION = '0.07';
  10 }
  11
  12
  13
  14
  15
  16 #####################################################################
  17 # Constructor and Accessors
  18
  19 sub new {
  20         my $class = shift;
  21         my $self  = bless { @_ }, $class;
  22
  23         # Check params
  24         unless ( _CLASS($self->class) ) {
  25                 Carp::croak("Did not provide a valid test class");
  26         }
  27         unless ( _CODELIKE($self->code) ) {
  28                 Carp::croak("Did not provide a valid CODE or callable object");
  29         }
  30
  31         $self;
  32 }
  33
  34 sub class {
  35         $_[0]->{class};
  36 }
  37
  38 sub tests {
  39         $_[0]->{tests};
  40 }
  41
  42 sub code {
  43         $_[0]->{code};
  44 }
  45
  46
  47
  48
  49
  50 #####################################################################
  51 # Main Methods
  52
  53 sub run {
  54         $_[0]->code->( $_[1] );
  55 }
  56
  57
  58
  59
  60
  61 #####################################################################
  62 # Support Functions
  63
  64 # Stolen from Params::Util to avoid adding a dependency needlessly
  65
  66 sub _CLASS ($) {
  67         (defined $_[0] and ! ref $_[0] and $_[0] =~ m/^[^\W\d]\w*(?:::\w+)*$/s) ? $_[0] : undef;
  68 }
  69
  70 sub _CODELIKE {
  71         (Scalar::Util::reftype($_[0])||'') eq 'CODE'
  72         or
  73         Scalar::Util::blessed($_[0]) and overload::Method($_[0],'&{}')
  74         ? $_[0] : undef;
  75 }
  76
  77 1;