use strict; use warnings; my %classes = ( student => { name => [qw(get set)], id => [qw(get set)], }, ); foreach my $class (keys %classes) { my $cname = ucfirst $class; $cname =~ s/_(\w)/uc $1/eg; my @data_members; foreach my $data_member (keys %{$classes{$class}}) { push @data_members, $data_member; foreach my $accessor (@{$classes{$class}{$data_member}}) { if ($accessor eq 'get') { no strict 'refs'; no warnings 'once'; print "creating sub ${cname}::${data_member}_get\n"; *{$cname . '::' . $data_member . '_get'} = sub {my $self = shift; return $self->{$data_member}}; } elsif ($accessor eq 'set') { no strict 'refs'; no warnings 'once'; print "creating sub ${cname}::${data_member}_set\n"; *{$cname . '::' . $data_member . '_set'} = sub {my $self = shift; return $self->{$data_member} = shift}; } else { die "Unrecognized accessor type: ${cname}::${data_member}_$accessor.\n"; } } } { no strict 'refs'; no warnings 'once'; print "creating sub ${cname}::new with data members (@data_members)\n"; *{$cname . '::' . 'new'} = sub { my ($class, $args) = @_; my $self = {}; $self->{$_} = $args->{$_} for keys %$args; return bless $self, $class; }; } } # Instantiate an object of class Student: my $s = Student->new({name => 'John Doe', id => 1234}); print "\n\n"; # Use the 'get' accessors for an object of class Student: print $s->id_get, ": ", $s->name_get, "\n"; # Use one of the 'set' accessors for the object: $s->name_set('Mark Doe'); # Verify the change: print $s->id_get, ": ", $s->name_get, "\n";