This is rather simplistic, and may look somewhat complex, but note that 1/3rd of the lines are data which could be in a DB or a config file; and half of the code is simply used to generate some test data.
The entire thing is data-driven. Hand code some more attribute types into the __AE__ section (or add some values in the arrays in GenData package and uncomment the first line of main) and nothing else need to change apart from adding event handlers to suit any new events.
The event handlers become class data for the widget class. The attribute-event table becomes class data for the attribute class. The rest, hopefully, is self-explanatory.
#! perl -slw
use strict;
use Inline::Files;
use Data::Dumper;
package Widget;
my %handlers = (
email => sub{ print "Sending email to $_[ 0 ]" },
phone => sub{ print "Phoning $_[ 0 ]" },
fax => sub{ print "Faxing $_[ 0 ]" },
);
sub new {
my( $class, %attribs ) = @_;
return bless {
map{ $_ => Attribute->new( $_, $attribs{ $_ } ) } keys %attrib
+s
}, $_[ 0 ];
}
sub do_events {
my $self = shift;
map{
my( $event, $parameter ) = split '=', $_;
$handlers{ $event }->( $parameter );
} $self->{ $_ }->events for keys %$self;
}
1;
package Attribute;
my %AttrEvents;
my( $type, $value, $events );
push @{ $AttrEvents{ $type }{ $value } }, split ',', $events
while ( $type, $value, $events ) = split ' ', <main::AE>;
#print Data::Dumper::Dumper \%AttrEvents;
sub new {
my( $class, $type, $value ) = @_;
return bless {
type => $type,
value=> $value,
}, $class;
}
sub value{ $_[ 0 ]->{value}; }
sub events{
my $self = shift;
my $AERef = $AttrEvents{ $self->{type} }{ $self->{ value } };
wantarray ? @$AERef : $AERef;
}
1;
package GenData; ## This package is ONLY used to generate test data.
use List::Util qw[shuffle];
our @colors = qw[ red orange yellow green blue indigo violet ];
our @sizes = 10 .. 20;
our @weights = map{ 250 * $_ } 1 .. 10;
our @materials = qw[ plastic wood steel bronze ];
our %edata = (
email=>'@somewhere.com',
phone=>'0800-CALL-',
fax=>'0800-FAX-',
);
our %attrs = (
color => \@colors,
size => \@sizes,
weight => \@weights,
material => \@materials,
);
our @events = qw[ email phone fax ];
our @types = map{ "type$_" } 'A' .. 'Z';
sub init{
my @lines;
while( @colors or @sizes or @weights or @materials ) {
for my $attr ( ( keys %attrs )[ rand keys %attrs ] ) {
next unless @{ $attrs{ $attr } };
my $value = splice( @{ $attrs{ $attr } }, int( rand @{ $at
+trs{ $attr } } ), 1 );
my @events = ( shuffle @events )[ 0 .. rand @events ];
push @lines,
"$attr\t"
. $value
. "\t" . join( ',', map{
$_ eq 'email'
? "$_=${value}$edata{$_}"
: "$_=$edata{$_}\U$value"
} @events
);
}
}
print main::AE "$_\n" for sort @lines;
}
1;
package main;
# GenData::init;
my $widget = Widget->new(
color => $GenData::colors [ rand @GenData::colors ],
size => $GenData::sizes [ rand @GenData::sizes ],
weight => $GenData::weights [ rand @GenData::weights ],
material => $GenData::materials[ rand @GenData::materials ],
);
print Data::Dumper::Dumper $widget;
$widget->do_events;
__END__
__AE__
color blue fax=0800-FAX-BLUE
color green email=green@somewhere.com
color indigo phone=0800-CALL-INDIGO
color orange email=orange@somewhere.com,phone=0800-CALL-ORAN
+GE
color red email=red@somewhere.com,phone=0800-CALL-RED,fa
+x=0800-FAX-RED
color violet email=violet@somewhere.com,fax=0800-FAX-VIOLET
color yellow phone=0800-CALL-YELLOW,fax=0800-FAX-YELLOW,emai
+l=yellow@somewhere.com
material bronze phone=0800-CALL-BRONZE
material plastic email=plastic@somewhere.com
material steel phone=0800-CALL-STEEL,fax=0800-FAX-STEEL,email=st
+eel@somewhere.com
material wood fax=0800-FAX-WOOD
size 10 fax=0800-FAX-10,email=10@somewhere.com,phone=080
+0-CALL-10
size 11 phone=0800-CALL-11
size 12 fax=0800-FAX-12,email=12@somewhere.com,phone=080
+0-CALL-12
size 13 fax=0800-FAX-13,email=13@somewhere.com
size 14 email=14@somewhere.com
size 15 email=15@somewhere.com,fax=0800-FAX-15
size 16 fax=0800-FAX-16,phone=0800-CALL-16,email=16@some
+where.com
size 17 phone=0800-CALL-17
size 18 email=18@somewhere.com
size 19 email=19@somewhere.com,phone=0800-CALL-19,fax=08
+00-FAX-19
size 20 fax=0800-FAX-20,phone=0800-CALL-20,email=20@some
+where.com
weight 1000 fax=0800-FAX-1000
weight 1250 phone=0800-CALL-1250,email=1250@somewhere.com
weight 1500 email=1500@somewhere.com,fax=0800-FAX-1500,phone
+=0800-CALL-1500
weight 1750 phone=0800-CALL-1750,fax=0800-FAX-1750
weight 2000 email=2000@somewhere.com,phone=0800-CALL-2000
weight 2250 fax=0800-FAX-2250
weight 250 fax=0800-FAX-250,email=250@somewhere.com
weight 2500 fax=0800-FAX-2500
weight 500 fax=0800-FAX-500,email=500@somewhere.com
weight 750 email=750@somewhere.com,phone=0800-CALL-750
