File Coverage

blib/lib/Class/Wrapper.pm

Criterion	Covered	Total	%
statement	75	79	94.9
branch	11	18	61.1
condition	2	5	40.0
subroutine	17	17	100.0
pod	1	1	100.0
total	106	120	88.3

package Class::Wrapper;

#use 5.008;
use strict;
use warnings;
use Carp;
#use Switch;



our $VERSION = 0.22;
our $AUTOLOAD;

sub new {
  my ($class,$component) = @_;
  croak __PACKAGE__." constructor argument was not an object reference: ".($component || "UNDEF")
    unless ref($component);
    my $self = bless {
        _component => $component
	}, ref($class) || $class;
  return $self;
}

sub AUTOLOAD {
	my ($self,@args) = @_;
	return if $AUTOLOAD =~ /.*DESTROY$/;
	my ($method) = $self->_get_method_name();

	# Switch replaced by older foreach construct for compatibility
	# with Perl older than 5.8
	#switch ($method) {
	#    case /^get_(.+)/ {$self->_add_getter();}
	#    case /^set_(.+)/ {$self->_add_setter();}
	#    else {$self->_add_method();}
	#};

	foreach ($method) {
	    /^get_(.+)/ && do {$self->_add_getter();last;};
	    /^set_(.+)/ && do {$self->_add_setter();last;};
	    do {$self->_add_method();};
	}

	no strict 'refs';
	return $self->$method(@args);
}

sub _add_getter {
    my ($self) = @_;
    my $method = $self->_get_method_name();
    my $objComponent = $self->_get_component();
    my ($property) = $method =~ /^get_(.+)/;
    no strict 'refs';
    *{$AUTOLOAD} = sub {
        my ($self) = @_;
        my $result;
        eval {$result = $objComponent->{$property};};
        croak($@) if $@;
        return $result;
    };
}

sub _add_setter {
    my ($self) = @_;
    my $method = $self->_get_method_name();
    my $objComponent = $self->_get_component();
    my ($property) = $method =~ /^set_(.+)/;
    no strict 'refs';
    *{$AUTOLOAD} = sub {
        my ($self,$arg) = @_;
        eval{$objComponent->{$property} = $arg};
        croak($@) if $@;
    };
}

sub _add_method {
    my ($self) = @_;
    my $method = $self->_get_method_name();
    my $objComponent = $self->_get_component();
    no strict 'refs';
    *{$AUTOLOAD} = sub {
        my ($self,@args) = @_;
        my @retval;
        my $retval;
        if (wantarray) {
            eval{@retval = $objComponent->$method(@args);};
            croak($@) if $@;
            return @retval;
        } else {
            eval{$retval = $objComponent->$method(@args);};
            croak($@) if $@;
            return $retval;
        }
    };
}

sub _get_method_name {
    my ($method) = $AUTOLOAD =~ /^.*::(.*)$/;
    return $method;
}

sub _get_component {$_[0]->{_component}}


1;
__END__