moose-class/exercises/t/lib/Test/TAP/Object.pm

   1 package TAP::Object;
   2
   3 use strict;
   4 use vars qw($VERSION);
   5
   6 =head1 NAME
   7
   8 TAP::Object - Base class that provides common functionality to all C<TAP::*> modules
   9
  10 =head1 VERSION
  11
  12 Version 3.17
  13
  14 =cut
  15
  16 $VERSION = '3.17';
  17
  18 =head1 SYNOPSIS
  19
  20     package TAP::Whatever;
  21
  22     use strict;
  23     use vars qw(@ISA);
  24
  25     use TAP::Object;
  26
  27     @ISA = qw(TAP::Object);
  28
  29     # new() implementation by TAP::Object
  30     sub _initialize {
  31         my ( $self, @args) = @_;
  32         # initialize your object
  33         return $self;
  34     }
  35
  36     # ... later ...
  37     my $obj = TAP::Whatever->new(@args);
  38
  39 =head1 DESCRIPTION
  40
  41 C<TAP::Object> provides a default constructor and exception model for all
  42 C<TAP::*> classes.  Exceptions are raised using L<Carp>.
  43
  44 =head1 METHODS
  45
  46 =head2 Class Methods
  47
  48 =head3 C<new>
  49
  50 Create a new object.  Any arguments passed to C<new> will be passed on to the
  51 L</_initialize> method.  Returns a new object.
  52
  53 =cut
  54
  55 sub new {
  56     my $class = shift;
  57     my $self = bless {}, $class;
  58     return $self->_initialize(@_);
  59 }
  60
  61 =head2 Instance Methods
  62
  63 =head3 C<_initialize>
  64
  65 Initializes a new object.  This method is a stub by default, you should override
  66 it as appropriate.
  67
  68 I<Note:> L</new> expects you to return C<$self> or raise an exception.  See
  69 L</_croak>, and L<Carp>.
  70
  71 =cut
  72
  73 sub _initialize {
  74     return $_[0];
  75 }
  76
  77 =head3 C<_croak>
  78
  79 Raise an exception using C<croak> from L<Carp>, eg:
  80
  81     $self->_croak( 'why me?', 'aaarrgh!' );
  82
  83 May also be called as a I<class> method.
  84
  85     $class->_croak( 'this works too' );
  86
  87 =cut
  88
  89 sub _croak {
  90     my $proto = shift;
  91     require Carp;
  92     Carp::croak(@_);
  93     return;
  94 }
  95
  96 =head3 C<_construct>
  97
  98 Create a new instance of the specified class.
  99
 100 =cut
 101
 102 sub _construct {
 103     my ( $self, $class, @args ) = @_;
 104
 105     $self->_croak("Bad module name $class")
 106       unless $class =~ /^ \w+ (?: :: \w+ ) *$/x;
 107
 108     unless ( $class->can('new') ) {
 109         local $@;
 110         eval "require $class";
 111         $self->_croak("Can't load $class") if $@;
 112     }
 113
 114     return $class->new(@args);
 115 }
 116
 117 =head3 C<mk_methods>
 118
 119 Create simple getter/setters.
 120
 121  __PACKAGE__->mk_methods(@method_names);
 122
 123 =cut
 124
 125 sub mk_methods {
 126     my ( $class, @methods ) = @_;
 127     foreach my $method_name (@methods) {
 128         my $method = "${class}::$method_name";
 129         no strict 'refs';
 130         *$method = sub {
 131             my $self = shift;
 132             $self->{$method_name} = shift if @_;
 133             return $self->{$method_name};
 134         };
 135     }
 136 }
 137
 138 1;
 139