Commit 90295001 authored by Peter Pentchev's avatar Peter Pentchev

Import original source of Config-MethodProxy 0.02

parents
Revision history for Perl extension Config::MethodProxy.
0.02 2016-11-09
- Switch from Test::Stream to Test2::Bundle::Extended.
- Support $proxy as an alternative to &proxy so that it isn't parsed
as a YAML anchor.
- Add extra validation for things like method proxies with undefined
package and method names, which means better error messages closer
to the caller.
0.01 2015-12-29
- First release.
This diff is collapsed.
# This file was automatically generated by Dist::Zilla::Plugin::Manifest v6.008.
Changes
LICENSE
MANIFEST
META.yml
Makefile.PL
README
cpanfile
lib/Config/MethodProxy.pm
t/00-report-prereqs.dd
t/00-report-prereqs.t
t/author-pod-syntax.t
t/test.t
---
abstract: 'Integrate dynamic logic with static configuration.'
author:
- 'Aran Deltac <bluefeet@gmail.com>'
build_requires:
ExtUtils::MakeMaker: '0'
File::Spec: '0'
Test2::Bundle::Extended: '0'
Test::More: '0'
configure_requires:
ExtUtils::MakeMaker: '0'
dynamic_config: 0
generated_by: 'Dist::Zilla version 6.008, CPAN::Meta::Converter version 2.150001'
license: perl
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.4.html
version: '1.4'
name: Config-MethodProxy
requires:
Carp: '0'
Exporter: '0'
Module::Runtime: '0.014'
Scalar::Util: '0'
namespace::clean: '0.24'
strictures: '2'
resources:
bugtracker: https://github.com/bluefeet/Config-MethodProxy/issues
homepage: https://github.com/bluefeet/Config-MethodProxy
repository: https://github.com/bluefeet/Config-MethodProxy.git
version: '0.02'
x_serialization_backend: 'YAML::Tiny version 1.69'
# This file was automatically generated by Dist::Zilla::Plugin::MakeMaker v6.008.
use strict;
use warnings;
use ExtUtils::MakeMaker;
my %WriteMakefileArgs = (
"ABSTRACT" => "Integrate dynamic logic with static configuration.",
"AUTHOR" => "Aran Deltac <bluefeet\@gmail.com>",
"CONFIGURE_REQUIRES" => {
"ExtUtils::MakeMaker" => 0
},
"DISTNAME" => "Config-MethodProxy",
"LICENSE" => "perl",
"NAME" => "Config::MethodProxy",
"PREREQ_PM" => {
"Carp" => 0,
"Exporter" => 0,
"Module::Runtime" => "0.014",
"Scalar::Util" => 0,
"namespace::clean" => "0.24",
"strictures" => 2
},
"TEST_REQUIRES" => {
"ExtUtils::MakeMaker" => 0,
"File::Spec" => 0,
"Test2::Bundle::Extended" => 0,
"Test::More" => 0
},
"VERSION" => "0.02",
"test" => {
"TESTS" => "t/*.t"
}
);
my %FallbackPrereqs = (
"Carp" => 0,
"Exporter" => 0,
"ExtUtils::MakeMaker" => 0,
"File::Spec" => 0,
"Module::Runtime" => "0.014",
"Scalar::Util" => 0,
"Test2::Bundle::Extended" => 0,
"Test::More" => 0,
"namespace::clean" => "0.24",
"strictures" => 2
);
unless ( eval { ExtUtils::MakeMaker->VERSION(6.63_03) } ) {
delete $WriteMakefileArgs{TEST_REQUIRES};
delete $WriteMakefileArgs{BUILD_REQUIRES};
$WriteMakefileArgs{PREREQ_PM} = \%FallbackPrereqs;
}
delete $WriteMakefileArgs{CONFIGURE_REQUIRES}
unless eval { ExtUtils::MakeMaker->VERSION(6.52) };
WriteMakefile(%WriteMakefileArgs);
This archive contains the distribution Config-MethodProxy,
version 0.02:
Integrate dynamic logic with static configuration.
This software is copyright (c) 2016 by Aran Deltac.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
This README file was generated by Dist::Zilla::Plugin::Readme v6.008.
requires 'Module::Runtime' => 0.014;
requires 'strictures' => 2.000000;
requires 'namespace::clean' => 0.24;
requires 'Exporter' => 0;
requires 'Scalar::Util' => 0;
requires 'Carp' => 0;
on test => sub {
requires 'Test2::Bundle::Extended' => 0;
};
package Config::MethodProxy;
$Config::MethodProxy::VERSION = '0.02';
=head1 NAME
Config::MethodProxy - Integrate dynamic logic with static configuration.
=head1 SYNOPSIS
use Config::MethodProxy;
$config = get_your_config_somewhere();
$config = apply_method_proxies( $config );
=head1 DESCRIPTION
A method proxy is a particular data structure which, when found,
is replaced by the value returned by calling that method. In this
way static configuration can be setup to call your code and return
dynamic contents. This makes static configuration much more powerful,
and gives you the ability to be more declarative in how dynamic values
make it into your configuration.
=head1 EXAMPLE
Consider this static YAML configuration:
---
db:
dsn: DBI:mysql:database=foo
username: bar
password: abc123
Putting your database password inside of a configuration file is usually
considered a bad practice. You can use a method proxy to get around this
without jumping through a bunch of hoops:
---
db:
dsn: DBI:mysql:database=foo
username: bar
password:
- $proxy
- MyApp::Config
- get_db_password
- bar
When L</apply_method_proxies> is called on the above data structure it will
see the method proxy and will replace the array ref with the return value of
calling the method.
A method proxy, in Perl syntax, looks like this:
['$proxy', $package, $method, @args]
The C<$proxy> string can also be written as C<&proxy>. The above is then
converted to a method call and replaced by the return value of the method call:
$package->$method( @args );
In the above database password example the method call would be this:
MyApp::Config->get_db_password( 'bar' );
You would still need to create a C<MyApp::Config> package, and add a
C<get_db_password> method to it.
=cut
use Scalar::Util qw( refaddr );
use Module::Runtime qw( require_module is_module_name );
use Carp qw( croak );
use strictures 2;
use namespace::clean;
use Exporter qw( import );
our @EXPORT = qw(
apply_method_proxies
);
our @EXPORT_OK = qw(
apply_method_proxies
is_method_proxy
call_method_proxy
);
our %EXPORT_TAGS = ('all' => \@EXPORT_OK);
=head1 FUNCTIONS
Only the L</apply_method_proxies> function is exported by default.
=head2 apply_method_proxies
$config = apply_method_proxies( $config );
Traverses the supplied data looking for method proxies, calling them, and
replacing them with the return value of the method. Any value may be passed,
such as a hash ref, an array ref, a method proxy, an object, a scalar, etc.
Array and hash refs will be recursively searched for method proxies.
If a circular reference is detected an error will be thrown.
=cut
our $found_data;
sub apply_method_proxies {
my ($data) = @_;
return $data if !ref $data;
local $found_data = {} if !$found_data;
my $refaddr = refaddr( $data );
if ($found_data->{$refaddr}) {
local $Carp::Internal{ (__PACKAGE__) } = 1;
croak 'Circular reference encountered in data passed to apply_method_proxies';
}
$found_data->{$refaddr} = 1;
if (ref($data) eq 'HASH') {
return {
map { $_ => apply_method_proxies( $data->{$_} ) }
keys( %$data )
};
}
elsif (ref($data) eq 'ARRAY') {
if (is_method_proxy( $data )) {
return call_method_proxy( $data );
}
return [
map { apply_method_proxies( $_ ) }
@$data
];
}
return $data;
}
=head2 is_method_proxy
if (is_method_proxy( $some_data )) { ... }
Returns true if the supplied data is an array ref where the first value
is the string C<$proxy> or C<&proxy>.
=cut
sub is_method_proxy {
my ($proxy) = @_;
return 0 if ref($proxy) ne 'ARRAY';
return 0 if !@$proxy;
return 0 if !defined $proxy->[0];
return 0 if $proxy->[0] !~ m{^[&\$]proxy$};
return 1;
}
=head2 call_method_proxy
call_method_proxy( ['$proxy', $package, $method, @args] );
Calls a method proxy and returns the value.
=cut
sub call_method_proxy {
my ($proxy) = @_;
local $Carp::Internal{ (__PACKAGE__) } = 1;
croak 'Not a method proxy array ref' if !is_method_proxy( $proxy );
my ($marker, $package, $method, @args) = @$proxy;
croak 'The method proxy package is undefined' if !defined $package;
croak 'The method proxy method is undefined' if !defined $method;
croak "The method proxy package, '$package', is not a valid package name"
if !is_module_name( $package );
require_module( $package );
return $package->$method( @args );
}
1;
__END__
=head1 AUTHOR
Aran Clary Deltac <bluefeetE<64>gmail.com>
=head1 ACKNOWLEDGEMENTS
Thanks to L<ZipRecruiter|https://www.ziprecruiter.com/>
for encouraging their employees to contribute back to the open
source ecosystem. Without their dedication to quality software
development this distribution would not exist.
=head1 LICENSE
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
=cut
do { my $x = {
'configure' => {
'requires' => {
'ExtUtils::MakeMaker' => '0'
}
},
'develop' => {
'requires' => {
'Test::Pod' => '1.41'
}
},
'runtime' => {
'requires' => {
'Carp' => '0',
'Exporter' => '0',
'Module::Runtime' => '0.014',
'Scalar::Util' => '0',
'namespace::clean' => '0.24',
'strictures' => '2'
}
},
'test' => {
'recommends' => {
'CPAN::Meta' => '2.120900'
},
'requires' => {
'ExtUtils::MakeMaker' => '0',
'File::Spec' => '0',
'Test2::Bundle::Extended' => '0',
'Test::More' => '0'
}
}
};
$x;
}
\ No newline at end of file
#!perl
use strict;
use warnings;
# This test was generated by Dist::Zilla::Plugin::Test::ReportPrereqs 0.024
use Test::More tests => 1;
use ExtUtils::MakeMaker;
use File::Spec;
# from $version::LAX
my $lax_version_re =
qr/(?: undef | (?: (?:[0-9]+) (?: \. | (?:\.[0-9]+) (?:_[0-9]+)? )?
|
(?:\.[0-9]+) (?:_[0-9]+)?
) | (?:
v (?:[0-9]+) (?: (?:\.[0-9]+)+ (?:_[0-9]+)? )?
|
(?:[0-9]+)? (?:\.[0-9]+){2,} (?:_[0-9]+)?
)
)/x;
# hide optional CPAN::Meta modules from prereq scanner
# and check if they are available
my $cpan_meta = "CPAN::Meta";
my $cpan_meta_pre = "CPAN::Meta::Prereqs";
my $HAS_CPAN_META = eval "require $cpan_meta; $cpan_meta->VERSION('2.120900')" && eval "require $cpan_meta_pre"; ## no critic
# Verify requirements?
my $DO_VERIFY_PREREQS = 1;
sub _max {
my $max = shift;
$max = ( $_ > $max ) ? $_ : $max for @_;
return $max;
}
sub _merge_prereqs {
my ($collector, $prereqs) = @_;
# CPAN::Meta::Prereqs object
if (ref $collector eq $cpan_meta_pre) {
return $collector->with_merged_prereqs(
CPAN::Meta::Prereqs->new( $prereqs )
);
}
# Raw hashrefs
for my $phase ( keys %$prereqs ) {
for my $type ( keys %{ $prereqs->{$phase} } ) {
for my $module ( keys %{ $prereqs->{$phase}{$type} } ) {
$collector->{$phase}{$type}{$module} = $prereqs->{$phase}{$type}{$module};
}
}
}
return $collector;
}
my @include = qw(
);
my @exclude = qw(
);
# Add static prereqs to the included modules list
my $static_prereqs = do 't/00-report-prereqs.dd';
# Merge all prereqs (either with ::Prereqs or a hashref)
my $full_prereqs = _merge_prereqs(
( $HAS_CPAN_META ? $cpan_meta_pre->new : {} ),
$static_prereqs
);
# Add dynamic prereqs to the included modules list (if we can)
my ($source) = grep { -f } 'MYMETA.json', 'MYMETA.yml';
if ( $source && $HAS_CPAN_META ) {
if ( my $meta = eval { CPAN::Meta->load_file($source) } ) {
$full_prereqs = _merge_prereqs($full_prereqs, $meta->prereqs);
}
}
else {
$source = 'static metadata';
}
my @full_reports;
my @dep_errors;
my $req_hash = $HAS_CPAN_META ? $full_prereqs->as_string_hash : $full_prereqs;
# Add static includes into a fake section
for my $mod (@include) {
$req_hash->{other}{modules}{$mod} = 0;
}
for my $phase ( qw(configure build test runtime develop other) ) {
next unless $req_hash->{$phase};
next if ($phase eq 'develop' and not $ENV{AUTHOR_TESTING});
for my $type ( qw(requires recommends suggests conflicts modules) ) {
next unless $req_hash->{$phase}{$type};
my $title = ucfirst($phase).' '.ucfirst($type);
my @reports = [qw/Module Want Have/];
for my $mod ( sort keys %{ $req_hash->{$phase}{$type} } ) {
next if $mod eq 'perl';
next if grep { $_ eq $mod } @exclude;
my $file = $mod;
$file =~ s{::}{/}g;
$file .= ".pm";
my ($prefix) = grep { -e File::Spec->catfile($_, $file) } @INC;
my $want = $req_hash->{$phase}{$type}{$mod};
$want = "undef" unless defined $want;
$want = "any" if !$want && $want == 0;
my $req_string = $want eq 'any' ? 'any version required' : "version '$want' required";
if ($prefix) {
my $have = MM->parse_version( File::Spec->catfile($prefix, $file) );
$have = "undef" unless defined $have;
push @reports, [$mod, $want, $have];
if ( $DO_VERIFY_PREREQS && $HAS_CPAN_META && $type eq 'requires' ) {
if ( $have !~ /\A$lax_version_re\z/ ) {
push @dep_errors, "$mod version '$have' cannot be parsed ($req_string)";
}
elsif ( ! $full_prereqs->requirements_for( $phase, $type )->accepts_module( $mod => $have ) ) {
push @dep_errors, "$mod version '$have' is not in required range '$want'";
}
}
}
else {
push @reports, [$mod, $want, "missing"];
if ( $DO_VERIFY_PREREQS && $type eq 'requires' ) {
push @dep_errors, "$mod is not installed ($req_string)";
}
}
}
if ( @reports ) {
push @full_reports, "=== $title ===\n\n";
my $ml = _max( map { length $_->[0] } @reports );
my $wl = _max( map { length $_->[1] } @reports );
my $hl = _max( map { length $_->[2] } @reports );
if ($type eq 'modules') {
splice @reports, 1, 0, ["-" x $ml, "", "-" x $hl];
push @full_reports, map { sprintf(" %*s %*s\n", -$ml, $_->[0], $hl, $_->[2]) } @reports;
}
else {
splice @reports, 1, 0, ["-" x $ml, "-" x $wl, "-" x $hl];
push @full_reports, map { sprintf(" %*s %*s %*s\n", -$ml, $_->[0], $wl, $_->[1], $hl, $_->[2]) } @reports;
}
push @full_reports, "\n";
}
}
}
if ( @full_reports ) {
diag "\nVersions for all modules listed in $source (including optional ones):\n\n", @full_reports;
}
if ( @dep_errors ) {
diag join("\n",
"\n*** WARNING WARNING WARNING WARNING WARNING WARNING WARNING WARNING ***\n",
"The following REQUIRED prerequisites were not satisfied:\n",
@dep_errors,
"\n"
);
}
pass;
# vim: ts=4 sts=4 sw=4 et:
#!perl
BEGIN {
unless ($ENV{AUTHOR_TESTING}) {
print qq{1..0 # SKIP these tests are for testing by the author\n};
exit
}
}
# This file was automatically generated by Dist::Zilla::Plugin::PodSyntaxTests.
use strict; use warnings;
use Test::More;
use Test::Pod 1.41;
all_pod_files_ok();
#!/usr/bin/env perl
use Test2::Bundle::Extended;
use Test::Fatal;
use Config::MethodProxy qw( :all );
{
package My::Test::Config;
sub foo { shift; join('-','FOO',@_) }
$INC{'My/Test/Config.pm'} = 1;
}
subtest is_method_proxy => sub{
foreach my $test (
[undef, 0, 'undef'],
[1, 0, '1'],
[[], 0, '[]'],
[['&proxx'], 0, q<['&proxx']>],
[{foo=>1}, 0, '{foo=>1}'],
['abc', 0, 'abc'],
[['$proxy'], 1, q<['&proxy']>],
[['$proxy','Package','method','arg'], 1, q<['&proxy','Package','method','arg']>],
[['&proxy'], 1, q<['&proxy']>],
) {
my ($value, $ok, $msg) = @$test;
is(
!!is_method_proxy( $value ),
!!$ok,
"$msg " . ($ok ? 'IS ' : 'is NOT ') . 'a method proxy',
);
}
};
subtest call_method_proxy => sub{
is(
call_method_proxy(['$proxy', 'My::Test::Config', 'foo', 'bar', 'baz']),
'FOO-bar-baz',
'works',
);
like(
dies { call_method_proxy([undef, 'My::Test::Config', 'foo', 'bar', 'baz']) },
qr{Not a method proxy},
'invalid marker string failed',
);
like(
dies { call_method_proxy(['$proxy', undef, 'foo', 'bar', 'baz']) },
qr{package is undefined},
'undef package failed',
);
like(
dies { call_method_proxy(['$proxy', 'My::Test::Config', undef, 'bar', 'baz']) },
qr{method is undefined},
'undef method failed',
);
like(
dies { call_method_proxy(['$proxy', 'My::Test::Config::Bad', 'foo', 'bar', 'baz']) },
qr{Can't locate},
'nonexistent package failed',
);
};
is(
apply_method_proxies({
this => 1,
that => ['$proxy', 'My::Test::Config', 'foo', 'that'],
them => [
'abc',
['&proxy', 'My::Test::Config', 'foo', 'them'],
{ yo=>['&proxy', 'My::Test::Config', 'foo', 'them', 'yo'] },
],
}),
{
this => 1,
that => 'FOO-that',
them => [
'abc',
'FOO-them',
{ yo=>'FOO-them-yo' },
],
},
'apply_method_proxies',
);
done_testing;
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment