# # My/Wrapper.pm # use strict; use warnings; package My::Wrapper; sub new { my $class = shift; my $self = bless {}, $class; if (@_) { $self->{orig_obj} = $_[0]; } return $self; } sub wrapper_get { my $self = shift; my ($k) = @_; $k ||= q{orig_obj}; return $self->{$k}; } sub wrapper_set { my $self = shift; my ( $k, $v ) = @_; if ( defined($v) ) { $self->{$k} = $v; } else { delete( $self->{$k} ); } } sub get_original_object { my $self = shift; # return $self->{orig_obj}; return $self->wrapper_get('orig_obj'); } sub set_original_object { my $self = shift; # $self->{orig_obj} = $_[0]; $self->wrapper_set( 'orig_obj', $_[0] ); } # Test::AC1 - get_, set_ # Exam::ATC - get_value, set_value sub get { my $self = shift; my $wrapped_obj = $self->get_original_object; if ( $wrapped_obj->can('get_') ) { return $wrapped_obj->get_(@_); } elsif ( $wrapped_obj->can('get_value') ) { return $wrapped_obj->get_value(@_); } else { warn("Wrapped object supports neither get_ nor get_value methods.\n"); } } sub set { my $self = shift; my $wrapped_obj = $self->get_original_object; if ( $wrapped_obj->can('set_') ) { return $wrapped_obj->set_(@_); } elsif ( $wrapped_obj->can('set_value') ) { return $wrapped_obj->set_value(@_); } else { warn("Wrapped object supports neither set_ nor set_value methods.\n"); } } 1;