package Rewire::Engine; use 5.014; use strict; use warnings; use registry; use routines; use Data::Object::Space; use Scalar::Util (); # FUNCTIONS # returns the json-schema-based engine ruleset fun ruleset() { state $ruleset = require Rewire::Ruleset; } # returns context closure fun context() { my $cache = {}; fun(Str $name, Any $object) { return $cache->{$name} = $object if $object; return $cache->{$name}; } } # returns the compilation of 2+ service configurations fun merger(HashRef $servSpec, HashRef $servA, HashRef $servB = {}) { my $service = {}; my $service_a = $servA; my $service_b = $servB; if (my $extends = $service_b->{extends}) { $service_b = merger($servSpec, $service_b, $servSpec->{$extends}); } $service = {%$service_b, %$service_a}; delete $service->{extends}; if ( (my $arg_a = $service_a->{argument}) || (my $arg_b = $service_b->{argument})) { if ( (defined $service_a->{argument} && !ref($arg_a)) || (defined $service_b->{argument} && !ref($arg_b))) { $service->{argument} ||= $arg_a if $arg_a; } elsif ((defined $service_a->{argument} && (ref($arg_a) eq 'ARRAY')) && (defined $service_b->{argument} && (ref($arg_b) eq 'ARRAY'))) { $service->{argument} = [@$arg_b, @$arg_a]; } elsif ((defined $service_a->{argument} && (ref($arg_a) eq 'HASH')) && (defined $service_b->{argument} && (ref($arg_b) eq 'HASH'))) { $service->{argument} = {%$arg_b, %$arg_a}; } else { $service->{argument} ||= $arg_a if $arg_a; } } return $service; } # returns context with eager-loaded objects fun preload(HashRef $servConf, Maybe[CodeRef] $context) { $context = context() if !$context; if (my $servSpec = $servConf->{services}) { for my $name (keys %$servSpec) { next if $context->($name); my $service = $servSpec->{$name}; my $lifecycle = $service->{lifecycle}; next if !$lifecycle; if ($lifecycle eq 'eager') { $context->($name, reifier($name, $servConf, $context)); } } } $context; } # builds and returns object or value based on spec fun builder(HashRef $service, Any $argument, Maybe[Object] $construct) { my $space = Data::Object::Space->new($service->{package}); # load declared package $space->load; # determine how to pass arguments (if any) my @arguments = arguments($argument, $service->{argument_as}); # determine construction if (my $builder = $service->{builder}) { my $original; # inject at last build step unless arguments exist my @injectables = @arguments; for (my $i=0; $i < @$builder; $i++) { my $buildspec = $builder->[$i]; my $argument = $buildspec->{argument}; my $argument_as = $buildspec->{argument_as}; my $return = $buildspec->{return}; my $result = $construct || $space->package; my @arguments = arguments($argument, $argument_as); if ($i == $#$builder) { # on last build step if no build step arguments @arguments = @injectables if not exists $buildspec->{argument}; } if (my $function = $buildspec->{function}) { $result = $space->call($function, @arguments); } elsif (my $method = $buildspec->{method}) { $result = $space->call($method, $result, @arguments); } elsif (my $routine = $buildspec->{routine}) { $result = $space->call($routine, $space->package, @arguments); } else { next; } if ($return eq 'class') { $construct = $space->package; } if ($return eq 'result') { $construct = $result; } if ($return eq 'self') { $construct = $original //= $result; } } } elsif (my $method = $service->{method}) { $construct = $space->package->$method(@arguments); } elsif (my $function = $service->{function}) { $construct = $space->call($function, @arguments); } elsif (my $routine = $service->{routine}) { $construct = $space->call($routine, $space->package, @arguments); } elsif (my $constructor = $service->{constructor}) { $construct = $space->package->$constructor(@arguments); } else { $construct = $space->build(@arguments); } $construct; } # returns invoked object or value based on service name fun reifier(Str $servName, HashRef $servConf, Maybe[CodeRef] $context) { $context = preload($servConf) if !$context; my $value; my $service; my $extended; my $servSpec = $servConf->{services}; # use cached (if any) $service = $context->($servName); return $service if $service; $service = $servSpec->{$servName} or return; # extend existing service (if requested) if (my $extends = $service->{extends}) { $service = merger($servSpec, $service, $servSpec->{$extends}); } # build object or value my $arguments = resolver($service->{argument}, $servConf, $context); $value = builder($service, $arguments, $extended); # determine cachability my $lifecycle = $service->{lifecycle}; if ($lifecycle && $lifecycle eq 'singleton') { $context->($servName, $value); } return $value; } # resolves service spec arguments fun resolver(Any $argsData, HashRef $servConf, Maybe[CodeRef] $context) { my $servMeta = $servConf->{metadata}; my $servSpec = $servConf->{services}; if (ref $argsData eq 'ARRAY') { $argsData = [map resolver($_, $servConf, $context), @$argsData]; } # $metadata if (ref $argsData eq 'HASH' && (keys %$argsData) == 1) { if ($servMeta && $argsData->{'$metadata'}) { $argsData = $servMeta->{$argsData->{'$metadata'}}; } } # $envvar if (ref $argsData eq 'HASH' && (keys %$argsData) == 1) { if (my $envvar = $argsData->{'$envvar'}) { if (exists $ENV{$envvar}) { $argsData = $ENV{$envvar}; } elsif (exists $ENV{uc($envvar)}) { $argsData = $ENV{uc($envvar)}; } else { $argsData = undef; } } } # $function if (ref $argsData eq 'HASH' && (keys %$argsData) == 1) { if ($servSpec && $argsData->{'$function'}) { my ($name, $next) = split /#/, $argsData->{'$function'}; if ($name && $next) { if (my $resolved = reifier($name, $servConf, $context)) { if (Scalar::Util::blessed($resolved) || (!ref($resolved) && ($resolved =~ /^[a-z-A-Z]/))) { my $space = Data::Object::Space->new(ref $resolved || $resolved); $argsData = $space->call($next) if $next && $next =~ /^[a-zA-Z]/; } } } } } # $method if (ref $argsData eq 'HASH' && (keys %$argsData) == 1) { if ($servSpec && $argsData->{'$method'}) { my ($name, $next) = split /#/, $argsData->{'$method'}; if ($name && $next) { if (my $resolved = reifier($name, $servConf, $context)) { if (Scalar::Util::blessed($resolved) || (!ref($resolved) && ($resolved =~ /^[a-z-A-Z]/))) { $argsData = $resolved->$next if $next && $next =~ /^[a-zA-Z]/; } } } } } # $routine if (ref $argsData eq 'HASH' && (keys %$argsData) == 1) { if ($servSpec && $argsData->{'$routine'}) { my ($name, $next) = split /#/, $argsData->{'$routine'}; if ($name && $next) { if (my $resolved = reifier($name, $servConf, $context)) { if (Scalar::Util::blessed($resolved) || (!ref($resolved) && ($resolved =~ /^[a-z-A-Z]/))) { my $space = Data::Object::Space->new(ref $resolved || $resolved); $argsData = $space->call($next) if $next && $next =~ /^[a-zA-Z]/; } } } } } # $callback if (ref $argsData eq 'HASH' && (keys %$argsData) == 1) { if ($servSpec && (my $callback = $argsData->{'$callback'})) { $argsData = sub { reifier($callback, $servConf, $context) }; } } # $service if (ref $argsData eq 'HASH' && (keys %$argsData) == 1) { if ($servSpec && $argsData->{'$service'}) { $argsData = reifier($argsData->{'$service'}, $servConf, $context); } } if (ref $argsData eq 'HASH' && grep ref, values %$argsData) { @$argsData{keys %$argsData} = map resolver($_, $servConf, $context), values %$argsData; } return $argsData; } # returns a list of arguments for object construction fun arguments(Any $argument, Any $argument_as) { my @arguments; if ($argument && $argument_as) { if ($argument_as eq 'array') { if (ref $argument eq 'HASH') { @arguments = ([$argument]); } else { @arguments = ($argument); } } if ($argument_as eq 'hashmap') { if (ref $argument eq 'ARRAY') { @arguments = ({@$argument}); } else { @arguments = ($argument); } } if ($argument_as eq 'list') { if (ref $argument eq 'ARRAY') { @arguments = (@$argument); } elsif (ref $argument eq 'HASH') { @arguments = (%$argument); } else { @arguments = ($argument); } } } else { @arguments = ($argument) if defined $argument; } (@arguments); } 1;