package ClassExample;

use strict;
use warnings;
use fields qw/color texture/;

my $prop = fields::phash(
	[qw/color texture/], 
	[\&color_prop, \&texture_prop]
);

sub create {
	my $class = shift;
	my $self = fields::new($class) unless ref($class);
	return $self;
}

sub property {
	my $self = shift;
	my ($propname, @params) = @_;
	$self->{$propname} = &{ $prop->{$propname} }(@params) if @params;
	return $self->{$propname};
}

# these subroutines could be isolated in another module and imported
# PRIVATE!!! keep out!
sub color_prop {
	my %colors = @_;
	my $ok = 0;
	for (qw/red green blue/) {
		if (exists $colors{$_}) {
			next if $colors{$_} < 0;
			next if $colors{$_} > 0xff;
			$ok++;
		}
	}
	die "@_ is not a red/green/blue color ref" unless $ok == 3;
	return sprintf('%02X%02X%02X', $colors{red}, $colors{green}, $colors{blue});
}

sub texture_prop {
	my $texture = shift;
	my $ok = 0;
	for (qw/rough smooth crinkly/) {
		if ($texture eq $_) {
			$ok = 1;
			last;
		}
	}
	die "$texture is not rough/smooth/crinkly texture value" unless $ok;
	return $texture;
}

1;


#  text_example.pl
#!/usr/local/bin/perl

use strict;
use warnings;
use ClassExample;

my $clex = ClassExample->create();
$clex->property('color', 'green', 0xde, 'red', 255, 'blue', 1);
$clex->property('texture', 'rough');

my $printthing = <<"end_of_print";
Properties of %s:
Texture: %s
Color:   %s

end_of_print
print "\n";
printf ($printthing, '$clex', $clex->property('texture'), $clex->property('color'));

my $texture = $clex->property('texture', 'smooth');
my $colorref = $clex->property('color',
                               red=>0x52,
                               green=>0x20,
                               blue=>0x11);

printf ($printthing, '$clex', $texture, $colorref);