File Coverage

blib/lib/Class/Member.pm

Criterion	Covered	Total	%
statement	76	77	98.7
branch	14	16	87.5
condition			n/a
subroutine	16	16	100.0
pod			n/a
total	106	109	97.2

package Class::Member;

use 5.008_000;
use strict;
our $VERSION='1.6';

use Carp 'confess';

sub import {
  my $pack=shift;
  ($pack)=caller;

  my $getset_hash=sub : lvalue {
    my $I=shift;
    my $what=shift;
    unless( UNIVERSAL::isa( $I, 'HASH' ) ) {
      confess "$pack\::$what must be called as instance method\n";
    }
    $what=$pack.'::'.$what;
    if( $#_>=0 ) {
      $I->{$what}=shift;
    }
    $I->{$what};
  };

  my $getset_glob=sub : lvalue {
    my $I=shift;
    my $what=shift;
    unless( UNIVERSAL::isa( $I, 'GLOB' ) ) {
      confess "$pack\::$what must be called as instance method\n";
    }
    $what=$pack.'::'.$what;
    if( $#_>=0 ) {
      ${*$I}{$what}=shift;
    }
    ${*$I}{$what};
  };

  my $getset=sub : lvalue {
    my $I=shift;
    my $name=shift;

    if( UNIVERSAL::isa( $I, 'HASH' ) ) {
      no strict 'refs';
      no warnings 'redefine';
      *{$pack.'::'.$name}=sub:lvalue {
	my $I=shift;
	&{$getset_hash}( $I, $name, @_ );
      };
    } elsif( UNIVERSAL::isa( $I, 'GLOB' ) ) {
      no strict 'refs';
      no warnings 'redefine';
      *{$pack.'::'.$name}=sub:lvalue {
	my $I=shift;
	&{$getset_glob}( $I, $name, @_ );
      };
    } else {
      confess "$pack\::$name must be called as instance method\n";
    }
    $I->$name(@_);
  };

  foreach my $name (@_) {
    if( $name=~/^-(.*)/ ) {	# reserved name, aka option
      if( $1 eq 'CLASS_MEMBERS' ) {
	local $_;
	no strict 'refs';
	*{$pack.'::CLASS_MEMBERS'}=[grep {!/^-/} @_];
      }
    } else {
      no strict 'refs';
      *{$pack.'::'.$name}=sub:lvalue {
	my $I=shift;
	&{$getset}( $I, $name, @_ );
      };
    }
  }
}

1;				# make require fail

__END__