Merge branch 'dev' into feature_path

LibreCat · Jun 6, 2018 · b6d25da · b6d25da
2 parents 2ec557d + 370c5ef
commit b6d25da
Show file tree

Hide file tree

Showing 12 changed files with 233 additions and 155 deletions.
diff --git a/Changes b/Changes
@@ -2,6 +2,7 @@ Revision history for Catmandu
 
 {{$NEXT}}
   - bring Dockerfile back to this repository
+  - include fix now accepts glob patterns
   - the export and convert commands get a new --id-file option
 
 1.09  2018-03-06 11:24:35 CET

diff --git a/lib/Catmandu.pm b/lib/Catmandu.pm
@@ -747,6 +747,14 @@ See L<Config::Onion> for more information on how this works.
 
 L<http://librecat.org/Catmandu/>
 
+=item blog
+
+L<https://librecatproject.wordpress.com/>
+
+=item step-by-step introduction from basics
+
+L<https://librecatproject.wordpress.com/2014/12/01/day-1-getting-catmandu/>
+
 =item command line client
 
 L<catmandu>

diff --git a/lib/Catmandu/Fix.pm b/lib/Catmandu/Fix.pm
@@ -808,10 +808,6 @@ You can load fixes from another namespace with the C<use> statement:
     if fb.is_baz()
     end
 
-    # the import option makes them available without prefix
-    use(foo.bar, import: 1)
-    baz()
-
 =head1 PATHS
 
 Most of the Fix commandsuse paths to point to values

diff --git a/lib/Catmandu/Fix/Namespace.pm b/lib/Catmandu/Fix/Namespace.pm
@@ -0,0 +1,14 @@
+package Catmandu::Fix::Namespace;
+
+use Catmandu::Sane;
+
+our $VERSION = '1.09';
+
+use Moo::Role;
+use namespace::clean;
+
+requires 'load';
+
+has name => (is => 'ro', required => 1);
+
+1;
diff --git a/lib/Catmandu/Fix/Namespace/perl.pm b/lib/Catmandu/Fix/Namespace/perl.pm
@@ -0,0 +1,45 @@
+package Catmandu::Fix::Namespace::perl;
+
+use Catmandu::Sane;
+
+our $VERSION = '1.09';
+
+use Catmandu::Util qw(is_instance require_package);
+use String::CamelCase qw(camelize);
+use Moo;
+use namespace::clean;
+
+with 'Catmandu::Fix::Namespace';
+
+sub load {
+    my ($self, $name, $args, $type) = @_;
+    my $ns = join('::', map {camelize($_)} split(/\./, $self->name));
+    $ns = join('::', $ns, $type) if $type;
+
+    my $pkg;
+    try {
+        $pkg = require_package($name, $ns);
+    }
+    catch_case [
+        'Catmandu::NoSuchPackage' => sub {
+            Catmandu::NoSuchFixPackage->throw(
+                message      => "No such fix package: $name",
+                package_name => $_->package_name,
+                fix_name     => $name,
+            );
+        },
+    ];
+    try {
+        $pkg->new(@$args);
+    }
+    catch {
+        $_->throw if is_instance($_, 'Catmandu::Error');
+        Catmandu::BadFixArg->throw(
+            message      => $_,
+            package_name => $pkg,
+            fix_name     => $name,
+        );
+    };
+}
+
+1;
diff --git a/lib/Catmandu/Fix/Parser.pm b/lib/Catmandu/Fix/Parser.pm
@@ -6,79 +6,88 @@ our $VERSION = '1.09';
 
 use Catmandu::Util
     qw(check_value check_string is_array_ref is_instance is_able require_package);
-use String::CamelCase qw(camelize);
 use Module::Info;
 use Moo;
 use namespace::clean;
 
 extends 'Parser::MGC';
 
-has default_namespace => (is => 'lazy');
-has env_stack         => (is => 'lazy');
+has env        => (is => 'lazy');
+has default_ns => (is => 'lazy');
 
 sub FOREIGNBUILDARGS {
     my ($class, $opts) = @_;
     $opts->{toplevel} = 'parse_statements';
     %$opts;
 }
 
-sub _build_default_namespace {
-    'Catmandu::Fix';
+sub _build_default_ns {
+    my ($self) = @_;
+    $self->_build_ns('perl:catmandu.fix');
 }
 
-sub _build_env_stack {
-    [{_ns => []}];
+sub _build_env {
+    my ($self) = @_;
+    $self->init_env([]);
 }
 
-sub clear_env {
-    my ($self) = @_;
-    my $envs = $self->env_stack;
-    splice(@$envs);
+sub init_env {
+    my ($self, $envs) = @_;
+    splice(@$envs, 0, @$envs, {ns => {'' => $self->default_ns}});
     $envs;
 }
 
-sub env_get {
-    my ($self, $key, $default) = @_;
-    my $envs = $self->env_stack;
+#sub env_get {
+#my ($self, $key, $default) = @_;
+#my $envs = $self->env_stack;
+#for my $env (@$envs) {
+#return $env->{$key} if exists $env->{$key};
+#}
+#$default;
+#}
+
+#sub env_add {
+#my ($self, $key, $val) = @_;
+#my $env = $self->env_stack->[-1];
+#Catmandu::FixParseError->throw("Already defined: $key")
+#if exists $env->{$key};
+#$env->{$key} = $val;
+#}
+
+sub get_ns {
+    my ($self, $name) = @_;
+    my $envs = $self->env;
     for my $env (@$envs) {
-        return $env->{$key} if exists $env->{$key};
+        return $env->{ns}{$name}
+            if exists $env->{ns} && exists $env->{ns}{$name};
     }
-    $default;
+    return;
 }
 
-sub env_add {
-    my ($self, $key, $val) = @_;
-    my $env = $self->env_stack->[-1];
-    Catmandu::FixParseError->throw("Already defined: $key")
-        if exists $env->{$key};
-    $env->{$key} = $val;
+sub add_ns {
+    my ($self, $name, $ns) = @_;
+    my $env = $self->env->[-1];
+    ($env->{ns} //= {})->{$name} = $ns;
 }
 
-sub add_namespace {
-    my ($self, $ns) = @_;
-    my $env = $self->env_stack->[-1];
-    my $nss = $env->{_ns} //= [];
-    push @$nss, $ns;
-}
-
-sub namespace_for {
-    my ($self, $name, $sub_ns) = @_;
-    my $envs = $self->env_stack;
-    for my $env (@$envs) {
-        my $nss = $env->{_ns} // next;
-        for my $ns (@$nss) {
-            $ns .= "::$sub_ns" if defined $sub_ns;
-            return $ns if Module::Info->new_from_module("${ns}::${name}");
-        }
-    }
-    my $ns = $self->default_namespace;
-    $ns .= "::$sub_ns" if defined $sub_ns;
-    $ns;
-}
+#sub namespace_for {
+#my ($self, $name, $sub_ns) = @_;
+#my $envs = $self->env_stack;
+#for my $env (@$envs) {
+#my $nss = $env->{_ns} // next;
+#for my $ns (@$nss) {
+#$ns .= "::$sub_ns" if defined $sub_ns;
+#return $ns if Module::Info->new_from_module("${ns}::${name}");
+#}
+#}
+#my $ns = $self->default_namespace;
+#$ns .= "::$sub_ns" if defined $sub_ns;
+#$ns;
+#}
 
 sub scope {
     my ($self, $block) = @_;
-    my $envs = $self->env_stack;
+    my $envs = $self->env;
     push @$envs, +{};
     my $res = $block->();
 
@@ -104,7 +113,7 @@ sub parse {
         Catmandu::FixParseError->throw(message => $err, source => $source,);
     }
     finally {
-        $self->clear_env;
+        $self->init_env;
     };
 }
 
@@ -143,15 +152,10 @@ sub parse_use {
     my ($self) = @_;
     $self->token_kw('use');
     my $args = $self->parse_arguments;
-    my $as   = check_string(shift(@$args));
-    my $ns   = join('::', map {camelize($_)} split(/\./, $as));
+    my $name = check_string(shift(@$args));
+    my $ns   = $self->_build_ns($name);
     my %opts = @$args;
-    if ($opts{import}) {
-        $self->add_namespace($ns);
-    }
-    else {
-        $self->env_add($opts{as} // $as, $ns);
-    }
+    $self->add_ns($opts{as} // $name, $ns);
     return;
 }
 
@@ -344,7 +348,7 @@ sub parse_double_quoted_string {
 sub _build_condition {
     my ($self, $name, $args, $pass, $fixes) = @_;
     $fixes = [$fixes] unless is_array_ref($fixes);
-    my $cond = $self->_build_fix_ns($name, $args, 'Condition');
+    my $cond = $self->_build_fix($name, $args, 'Condition');
     if ($pass) {
         $cond->pass_fixes($fixes);
     }
@@ -357,56 +361,29 @@ sub _build_condition {
 sub _build_bind {
     my ($self, $name, $args, $return, $fixes) = @_;
     $fixes = [$fixes] unless is_array_ref($fixes);
-    my $bind = $self->_build_fix_ns($name, $args, 'Bind');
+    my $bind = $self->_build_fix($name, $args, 'Bind');
     $bind->__return__($return);
     $bind->__fixes__($fixes);
     $bind;
 }
 
 sub _build_fix {
-    my ($self, $name, $args) = @_;
-    $self->_build_fix_ns($name, $args);
+    my ($self, $name, $args, $type) = @_;
+    my @name_parts = split(/\./, $name);
+    my $fix_name   = pop @name_parts;
+    my $ns_name    = join('.', @name_parts);
+    my $ns         = $self->get_ns($ns_name)
+        // Catmandu::FixParseError->throw("Unknown namespace: $ns_name");
+    $ns->load($fix_name, $args, $type);
 }
 
-sub _build_fix_ns {
-    my ($self, $name, $args, $sub_ns) = @_;
-    my @name_parts = split(/\./, $name);
+sub _build_ns {
+    my ($self, $name) = @_;
+    my @name_parts = split(/:/, $name);
     $name = pop @name_parts;
-    my $ns;
-    if (@name_parts) {
-        my $as = join('.', @name_parts);
-        $ns = $self->env_get($as)
-            // Catmandu::FixParseError->throw("Unknown namespace: $as");
-        $ns = join('::', $ns, $sub_ns) if defined $sub_ns;
-    }
-    else {
-        $ns = $self->namespace_for($name, $sub_ns);
-    }
-
-    my $pkg;
-    try {
-        $pkg = require_package($name, $ns);
-    }
-    catch_case [
-        'Catmandu::NoSuchPackage' => sub {
-            Catmandu::NoSuchFixPackage->throw(
-                message      => "No such fix package: $name",
-                package_name => $_->package_name,
-                fix_name     => $name,
-            );
-        },
-    ];
-    try {
-        $pkg->new(@$args);
-    }
-    catch {
-        $_->throw if is_instance($_, 'Catmandu::Error');
-        Catmandu::BadFixArg->throw(
-            message      => $_,
-            package_name => $pkg,
-            fix_name     => $name,
-        );
-    };
+    my $pkg_name = $name_parts[0] // 'perl';
+    my $pkg = require_package($pkg_name, 'Catmandu::Fix::Namespace');
+    $pkg->new(name => $name);
 }
 
 1;