in reply to Re^2: Inheritance when subclass passed as a parameter
in thread [Solved] Inheritance when subclass passed as a parameter

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:

lib/Service.pm:

package Service;
use warnings;
use strict;
use Module::Find 'useall';

sub create {
    my $class = shift;
    my $type = shift;
    my @found = useall $class;
    for my $plugin (@found) {
        if ($plugin =~ /::\Q$type\E\z/i) {
            return $plugin->new(@_);
        }
    }
    die "No $class found for type '$type'";
}

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

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

1;

[download]

lib/Service/JSON.pm:

package Service::JSON;
use warnings;
use strict;
use parent 'Service';

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

1;

[download]

lib/Service/XML.pm:

package Service::XML;
use warnings;
use strict;
use parent 'Service';

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

1;

[download]

t/00.t:

use warnings;
use strict;
use Test::More tests=>3;

use_ok 'Service';

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

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

[download]

Replies are listed 'Best First'.
Re^4: Inheritance when subclass passed as a parameter
by Fletch (Bishop) on Feb 05, 2020 at 16:27 UTC

    wiki.c2.com is also another good design patterns resource (along with the original GangOfFour book ISBN 9780201633610).

    The cake is a lie.
    The cake is a lie.
    The cake is a lie.

[reply]

In Section Seekers of Perl Wisdom