Update: BTW, /[data]/ matches a character class, not the literal string [data].

Update 2: The real problem is you're using inheritance, but Service is not a parent, it's a factory.

Update 3: Like this:

---./t/00.t---

#!/usr/bin/perl
use warnings;
use strict;

use Test::More;
use Service::Factory;

my $xml = Service::Factory->instantiate('xml', 'xmldata');
$xml->populate;
like $xml->{template}, qr{<data>xmldata</data>}, 'XML OK';

my $json = Service::Factory->instantiate('json', 'jsondata');
$json->populate;
like $json->{template}, qr/{"data":"jsondata"}/, 'JSON OK';

done_testing;
[download]

package Service::XML;

use warnings;
use strict;

use parent 'Service';
use XML::LibXML;

sub new {
    my $class = shift;
    my $self = $class->SUPER::new(@_);
    my $xml = 'XML::LibXML::Document'->new;
    $xml->setDocumentElement($xml->createElement('data'));
    $xml->documentElement->appendTextNode('[data]');
    $self->{template} = $xml->toString;
    return $self
}

__PACKAGE__
[download]

package Service::Factory;

use Service::XML;
use Service::JSON;

use warnings;
use strict;

my %SUPPORTED = (
    xml  => 'XML',
    json => 'JSON');

sub instantiate {
    my ($class, $plugin) = @_;
    die "Unknown plugin '$plugin'.\n" unless $SUPPORTED{$plugin};
    my $subclass = "Service::$SUPPORTED{$plugin}";
    return $subclass->new(@_[2 .. $#_])
}
__PACKAGE__
[download]

package Service::JSON;

use warnings;
use strict;

use parent 'Service';

use Cpanel::JSON::XS qw{ encode_json };

sub new {
    my $class = shift;
    my $self = $class->SUPER::new(@_);
    $self->{template} = encode_json({data => '[data]'});
    return $self
}

__PACKAGE__
[download]

package Service;

use warnings;
use strict;

sub new {
    my ($class, $data) = @_;
    return bless {
        data => $data,
        service => $class,
    }, $class
}

sub populate {
    my $self = shift;
    $self->{template} =~ s/\[data\]/$self->{data}/i;
}

__PACKAGE__
[download]

I see a couple of issues; I think you're mixing some concepts.

• As choroba and hippo said, you use useall to locate the class name of the appropriate "plugin", but then don't instantiate an object of that class, therefore template never gets populated. You could change $self->{service} = $plugin to $self->{service} = $plugin->new to fix that. If you go with this suggestion:

  • You'll need to access the template as ...->{service}->{template} (or with an appropriate accessor), both in Service::populate and in your tests.
  • It doesn't really make sense to me to have the Service/*.pms be subclasses of Service.

• You're using the first parameter of Service->new to locate a subclass. Why not just do e.g. Service::XML->new instead? Then, in your subclasses, you'll need to call the superclass constructor, as in my $self = $class->SUPER::new(@_); $self->{template} = ....

• Another option would be to set up a factory method. Although it could be called new, IMO that messes with inheritance a bit. So you could set up a method such as Service->create that simply dispatches to the constructor of the appropriate subclass; then each subclass constructor could call the superclass constructor like in my previous point.

Another small issue in your sample code: You pass the constructor two arguments, but only use the first.

Thanks a lot. I'm pretty sure that a factory method is what I need. I've never used them before, so I have some googling to do. Are there any especially good (or bad) docs? I am certainly confused (which is why I'm coming here for help) and the fog is starting to lift thanks to everyone's help.

My problem with Service::XML->new is that I really need to call it as Service::$var->new, as I don't know which service will be used until I get the data. I tried various forms of that and got various syntax errors. Obviously I will have to do lots of error checking in case a service is requested that has no subclass, but I'm trying to get the basics working first. Which I won't if I make trivial blunders like the character class Choroba pointed out.

Regards,

John Davies

Update: https://www.perl.com/pub/2003/08/15/design3.html/ looks helpful to me, although I think there are some more modern constructs I could use.

I'm pretty sure that a factory method is what I need. I've never used them before, so I have some googling to do. Are there any especially good (or bad) docs?

I'm not sure, probably Wikipedia is a good start - but the basic concept is pretty simple, it's a class method in a central place somewhere that simply dispatches to the appropriate constructor depending on the arguments. The advantage is that the code calling the factory doesn't have to have any knowledge of the subclasses that exist, or their names. In a strongly typed language the factory method would simply be returning an object that is-a Service.

My problem with Service::XML->new is that I really need to call it as Service::$var->new, as I don't know which service will be used until I get the data. I tried various forms of that and got various syntax errors.

That'll only work if the entire class name is a string, as in my $class="Service::$var"; my $obj=$class->new;. Which is certainly an option, but if you want some flexibility in $var and/or better error messages in case of invalid $var values, then a factory method is probably better.

These tests pass:

Read more... code (2 kB)

Answer using Moo

# oo.t

use strict;
use warnings;
use lib '.';
use Test::More;

use_ok 'Service', 'Service.pl loads';

my $xml = Service->new_by_name('xml', 'xmldata');
$xml->populate;
is $xml->template, '<data>xmldata</data>', 'XML OK';

my $json = Service->new_by_name('json', 'jsondata');
$json->populate;
is $json->template, '{"data": jsondata}', 'JSON OK';

done_testing;


# Service.pm
package Service;

use Moo;

has 'data'      => (is => 'ro', required => 1);
has 'template'  => (is => 'rw', builder => '_build_template');

sub populate {
    my $self = shift;
    (my $tmpl = $self->template) =~ s/\[data\]/$self->data/emsi;
    $self->template($tmpl);
}

sub new_by_name {
    my (undef, $name, $data) = @_;
    $name = uc $name;
    my $class = __PACKAGE__ . "::$name";
    eval "require $class";
    $class->new(data => $data);
}

1;


# Service/XML.pm
package Service::XML;

use Moo;
extends 'Service';

sub _build_template { '<data>[data]</data>' }

1;


# Service/JSON.pm
package Service::JSON;

use Moo;
extends 'Service';

sub _build_template { '{"data": [data]}' }

1;
[download]

Answer using MooX::Pression

In this example, Service/XML.pm and Service/JSON.pm are no longer needed; all classes are defined in Service.pm.

use MooX::Pression prefix => 'MyApp';

class ::Service {
    has data     (is => ro, type => Str, required => true);
    has template (is => rw, type => Str, builder => true);
    
    method populate () {
        (my $tmpl = $self->template) =~ s/\[data\]/$self->data/emsi;
        $self->template($tmpl);
    }
    
    method new_by_name (Str $name, Str $data) {
        $name = uc $name;
        my $child = "$class\::$name";
        $child->new(data => $data);
    }
    
    class +XML {
        method _build_template () { '<data>[data]</data>' }
    }
    
    class +JSON {
        method _build_template () { '{"data": [data]}' }
    }
}

1;
[download]

Shouldn't it use roles instead of inheritance?

I thought I replied to this yesterday, but I guess I did the thing where I preview a post and then forgot to actually post it.

Anyway, the Service class is usable in its own right, so it makes sense to keep it as a class, not a role.

my $text = Service->new( template => "[data]\n", data => 'foo' );
[download]

toby döt ink

Please indicate where in your code you believe that you are instantiating any object of a subclass, because it isn't clear to me that this is happening.

not inherited the 'template' property. What am I doing wrong, please, and what docs should I have read?

maybe write it make it work using

use Moo

then revisit these original files