in reply to Building Perl classes dynamically based on an input schema/template

If you want to build this yourself, you can. A class is really just a namespace. Subroutines can be exported into any namespace by assigning a subref to the typeglob. Here's a simple example:

package main; { no warnings 'once'; *main::foo = sub {print "Foo\n"} foo(); }

This will print Foo. Our assignment of a subref in this case is virtually synonymous with this:

package main; sub foo {print "Foo\n"}

...except that the typeglob version can be wielded dynamically. It can even be done in a BEGIN block. Now here is a fully functional implementation that installs a constructor, a getter, and a setter for a class that is described by a data structure.

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 $se +lf = 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 $se +lf = shift; return $self->{$data_member} = shift}; } else { die "Unrecognized accessor type: ${cname}::${data_memb +er}_$accessor.\n"; } } } { no strict 'refs'; no warnings 'once'; print "creating sub ${cname}::new with data members (@data_mem +bers)\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";

The output will be:

creating sub Student::name_get creating sub Student::name_set creating sub Student::id_get creating sub Student::id_set creating sub Student::new with data members (name id) 1234: John Doe 1234: Mark Doe

Dave

Replies are listed 'Best First'.
Re^2: Building Perl classes dynamically based on an input schema/template
by karlgoethebier (Abbot) on Nov 15, 2016 at 19:47 UTC

    What about this variation?

    #!/usr/bin/env perl use strict; use warnings; use Cpanel::JSON::XS; use Data::Dump; use feature qw(say); my $json = <DATA>; my $class = decode_json $json; my $name = ( keys %$class )[0]; my $package = ucfirst $name; my $code = qq(package $package; use Class::Tiny qw( @{[ keys %{($class +->{$name}[1])} ]}); 1;); eval $code; my @objects = map {$package->new($_)} @{ $class->{$name} }; my @attributes = Class::Tiny->get_all_attributes_for($package); say $json; dd \@objects; dd \@attributes; say $code; say $package; for my $object(@objects) { for my $attribute( @attributes ) { say $object->$attribute; } } __DATA__ {"student": [{"name": "Nose", "id": "0001"}, {"name": "Cuke", "id":"00 +02"}]} __END__

    Just an idea. I'm not sure if it's sound and recommended and therefore i didn't reply to the OP.

    Thanks for any hint and regards, Karl

    «The Crux of the Biscuit is the Apostrophe»

      It works and is fairly elegant. :)

      Both are susceptible to someone using a class name that clobbers an existing namespace if the inputs are not trustworthy (or otherwise inept). I suppose that the eval version would allow for some sort of code injection beyond namespace collisions too, so again, the caveat about trustworthy, reliable inputs. In a real-world solution either one of our strategies should do thorough sanitization first.


      Dave

        Karl and Dave, Thanks to both of you for your great inputs. I was initially looking for an usage example with CLASS::MOP to solve the problem, but I guess now that it can be solved through the above methods equally well. Let me look into implementing them and update you if I run into any issues. Thanks, Tito

        Thanks for the feedback. Regards, Karl

        «The Crux of the Biscuit is the Apostrophe»