diff options
author | Norbert Preining <norbert@preining.info> | 2024-03-15 03:06:35 +0000 |
---|---|---|
committer | Norbert Preining <norbert@preining.info> | 2024-03-15 03:06:35 +0000 |
commit | 12679ab7d3c2a210f4123163671b532b8b55d5f9 (patch) | |
tree | 0060d13467186ad977f4e73488ee20dd6c0017ab /systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Object.pm | |
parent | 62170822e034fdd3f81de7274835d0d3b0467100 (diff) |
CTAN sync 202403150306
Diffstat (limited to 'systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Object.pm')
-rwxr-xr-x | systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Object.pm | 155 |
1 files changed, 155 insertions, 0 deletions
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Object.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Object.pm new file mode 100755 index 0000000000..a012b98a6c --- /dev/null +++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Object.pm @@ -0,0 +1,155 @@ +package TAP::Object; + +use strict; +use warnings; + +=head1 NAME + +TAP::Object - Base class that provides common functionality to all C<TAP::*> modules + +=head1 VERSION + +Version 3.48 + +=cut + +our $VERSION = '3.48'; + +=head1 SYNOPSIS + + package TAP::Whatever; + + use strict; + + use base 'TAP::Object'; + + # new() implementation by TAP::Object + sub _initialize { + my ( $self, @args) = @_; + # initialize your object + return $self; + } + + # ... later ... + my $obj = TAP::Whatever->new(@args); + +=head1 DESCRIPTION + +C<TAP::Object> provides a default constructor and exception model for all +C<TAP::*> classes. Exceptions are raised using L<Carp>. + +=head1 METHODS + +=head2 Class Methods + +=head3 C<new> + +Create a new object. Any arguments passed to C<new> will be passed on to the +L</_initialize> method. Returns a new object. + +=cut + +sub new { + my $class = shift; + my $self = bless {}, $class; + return $self->_initialize(@_); +} + +=head2 Instance Methods + +=head3 C<_initialize> + +Initializes a new object. This method is a stub by default, you should override +it as appropriate. + +I<Note:> L</new> expects you to return C<$self> or raise an exception. See +L</_croak>, and L<Carp>. + +=cut + +sub _initialize { + return $_[0]; +} + +=head3 C<_croak> + +Raise an exception using C<croak> from L<Carp>, eg: + + $self->_croak( 'why me?', 'aaarrgh!' ); + +May also be called as a I<class> method. + + $class->_croak( 'this works too' ); + +=cut + +sub _croak { + my $proto = shift; + require Carp; + Carp::croak(@_); + return; +} + +=head3 C<_confess> + +Raise an exception using C<confess> from L<Carp>, eg: + + $self->_confess( 'why me?', 'aaarrgh!' ); + +May also be called as a I<class> method. + + $class->_confess( 'this works too' ); + +=cut + +sub _confess { + my $proto = shift; + require Carp; + Carp::confess(@_); + return; +} + +=head3 C<_construct> + +Create a new instance of the specified class. + +=cut + +sub _construct { + my ( $self, $class, @args ) = @_; + + $self->_croak("Bad module name $class") + unless $class =~ /^ \w+ (?: :: \w+ ) *$/x; + + unless ( $class->can('new') ) { + local $@; + eval "require $class"; + $self->_croak("Can't load $class: $@") if $@; + } + + return $class->new(@args); +} + +=head3 C<mk_methods> + +Create simple getter/setters. + + __PACKAGE__->mk_methods(@method_names); + +=cut + +sub mk_methods { + my ( $class, @methods ) = @_; + for my $method_name (@methods) { + my $method = "${class}::$method_name"; + no strict 'refs'; + *$method = sub { + my $self = shift; + $self->{$method_name} = shift if @_; + return $self->{$method_name}; + }; + } +} + +1; + |