[libcatmandu-perl] 04/16: Adding the 'info' command again to Catmandu core #98

[Jonas Smedegaard]

This is an automated email from the git hooks/post-receive script.

js pushed a commit to tag 0.9209
in repository libcatmandu-perl.

commit 7fcf78bdbcb4c6f1055d377dc347b1f469da5402
Author: Patrick Hochstenbach <patrick.hochstenbach at ugent.be>
Date:   Fri Nov 21 11:13:50 2014 +0100

    Adding the 'info' command again to Catmandu core #98
---
 Build.PL                 |  10 ++--
 lib/Catmandu/Cmd/info.pm | 129 +++++++++++++++++++++++++++++++++++++++++++++++
 t/Catmandu-Cmd-info.t    |  22 ++++++++
 3 files changed, 156 insertions(+), 5 deletions(-)

diff --git a/Build.PL b/Build.PL
index 712e89c..dfa9888 100644
--- a/Build.PL
+++ b/Build.PL
@@ -1,17 +1,17 @@
 
-# This file was automatically generated by Dist::Zilla::Plugin::ModuleBuild v5.017.
+# This file was automatically generated by Dist::Zilla::Plugin::ModuleBuild v5.023.
 use strict;
 use warnings;
 
-use Module::Build 0.3601;
+use Module::Build 0.28;
 
 
 my %module_build_args = (
   "build_requires" => {
-    "Module::Build" => "0.3601"
+    "Module::Build" => "0.28"
   },
   "configure_requires" => {
-    "Module::Build" => "0.3601"
+    "Module::Build" => "0.28"
   },
   "dist_abstract" => "a data toolkit",
   "dist_author" => [
@@ -72,7 +72,7 @@ my %module_build_args = (
 my %fallback_build_requires = (
   "Log::Any::Adapter" => "0.11",
   "Log::Any::Test" => "0.15",
-  "Module::Build" => "0.3601",
+  "Module::Build" => "0.28",
   "Test::Deep" => "0.112",
   "Test::Exception" => "0.32",
   "Test::More" => "1.001003",
diff --git a/lib/Catmandu/Cmd/info.pm b/lib/Catmandu/Cmd/info.pm
new file mode 100644
index 0000000..f4f0f9f
--- /dev/null
+++ b/lib/Catmandu/Cmd/info.pm
@@ -0,0 +1,129 @@
+package Catmandu::Cmd::info;
+
+use Catmandu::Sane;
+use parent 'Catmandu::Cmd';
+use Catmandu::Importer::Modules;
+use Catmandu::Store::Hash;
+
+use Data::Dumper;
+
+sub command_opt_spec {
+    (
+        ["all"       , "show all module on this server"],
+        ["exporters" , "show all catmandu exporters"],
+        ["importers" , "show all catmandu importers"],
+        ["fixes"     , "show all catmandu fixes"],
+        ["stores"    , "show all catmandu stores"],
+        ["namespace=s", "search by namespace"],
+        ["max_depth=i", "maximum depth to search for modules"],
+        ["inc=s@", 'override included directories (defaults to @INC)', {default => [@INC]}],
+        ["verbose|v", ""]
+    );
+}
+
+sub all_catmandu {
+    my ($opts)  = @_;
+    my $from = Catmandu::Store::Hash->new()->bag;
+
+    for my $namespace (qw(Catmandu::Exporter Catmandu::Fix Catmandu::Importer Catmandu::Store)) {
+        my $from_opts = { namespace => $namespace };
+        for my $key (qw(inc)) {
+            $from_opts->{$key} = $opts->$key if defined $opts->$key;
+        }
+
+        my $m = Catmandu::Importer::Modules->new($from_opts)->to_array;
+        $from->add_many($m);
+    }
+
+    $from;
+}
+
+sub all_modules {
+    my ($opts)    = @_;
+    my $from_opts = {};
+
+    for my $key (qw(inc namespace max_depth)) {
+        $from_opts->{$key} = $opts->$key if defined $opts->$key;
+    }
+
+    Catmandu::Importer::Modules->new($from_opts);
+}
+
+sub command {
+    my ($self, $opts, $args) = @_;
+    my $verbose = $opts->verbose;
+    my $from;
+
+    if (defined $opts->{namespace}) {
+        $from = all_modules($opts);
+    }
+    elsif ($opts->{all}) {
+        delete $opts->{all};
+        $from = all_modules($opts);
+    }
+    elsif ($opts->{exporters}) {
+        delete $opts->{exporters};
+        $opts->{namespace} = 'Catmandu::Exporter';
+        $from = all_modules($opts);
+    }
+    elsif ($opts->{importers}) {
+        delete $opts->{importers};
+        $opts->{namespace} = 'Catmandu::Importer';
+        $from = all_modules($opts);
+    }
+    elsif ($opts->{fixes}) {
+        delete $opts->{fixes};
+        $opts->{namespace} = 'Catmandu::Fix';
+        $from = all_modules($opts);
+    }
+    elsif ($opts->{stores}) {
+        delete $opts->{stores};
+        $opts->{namespace} = 'Catmandu::Store';
+        $from = all_modules($opts);
+    }
+    else {
+        $from = all_catmandu($opts);
+    }
+
+    my $into_args = [];
+    my $into_opts = {};
+    my $into;
+
+    if (@$args && $args->[0] eq 'to') {
+        for (my $i = 1; $i < @$args; $i++) {
+            my $arg = $args->[$i];
+            if ($arg =~ s/^-+//) {
+                $arg =~ s/-/_/g;
+                if ($arg eq 'fix') {
+                    push @{$into_opts->{$arg} ||= []}, $args->[++$i];
+                } else {
+                    $into_opts->{$arg} = $args->[++$i];
+                }
+            } else {
+                push @$into_args, $arg;
+            }
+        }
+    }
+
+    if (@$into_args || %$into_opts) {
+        $into = Catmandu->exporter($into_args->[0], $into_opts);
+        $into->add_many($from);
+        $into->commit;
+    } else {
+        my $cols = [qw(name version)];
+        push @$cols, 'file' if $opts->verbose;
+        $from->format(cols => $cols);
+    }
+}
+
+=head1 NAME
+
+Catmandu::Cmd::info - list installed Catmandu modules
+
+=head1 DESCRIPTION
+
+This L<Catmandu::Cmd> uses L<Catmandu::Importer::Modules> to list all modules.
+
+=cut
+
+1;
\ No newline at end of file
diff --git a/t/Catmandu-Cmd-info.t b/t/Catmandu-Cmd-info.t
new file mode 100644
index 0000000..ae9ced2
--- /dev/null
+++ b/t/Catmandu-Cmd-info.t
@@ -0,0 +1,22 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use Test::More;
+use Test::Exception;
+use App::Cmd::Tester;
+
+my $pkg;
+BEGIN {
+    $pkg = 'Catmandu::Cmd::info';
+    use_ok $pkg;
+}
+require_ok $pkg;
+
+use Catmandu::CLI;
+
+my $result = test_app(qq|Catmandu::CLI| => [ qw(info) ]);
+
+is $result->error, undef, 'threw no exceptions' ;
+
+done_testing 3;
\ No newline at end of file

-- 
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-perl/packages/libcatmandu-perl.git