Merge branch 'ikedas/pr-1286_fix1' into ikedas/issue-508_601

src/lib/Sympa/CLI.pm

@@ -32,7 +32,9 @@ BEGIN { eval 'use Encode::Locale'; }
 use Conf;
 use Sympa::Constants;
 use Sympa::DatabaseManager;
+use Sympa::Family;
 use Sympa::Language;
+use Sympa::List;
 use Sympa::Log;
 use Sympa::Mailer;
 use Sympa::Template;
@@ -43,7 +45,6 @@ my $language = Sympa::Language->instance;
 sub run {
     my $class   = shift;
     my $options = shift if @_ and ref $_[0] eq 'HASH';
-    my $command = shift;
     my @argv    = @_;
 
     if ($class eq 'Sympa::CLI') {
@@ -77,44 +78,48 @@ sub run {
         $language->set_lang(@langs, 'en-US', 'en');
     }
 
-    # Load module for the command.
-    unless ($command and $command !~ /\W/) {
-        warn $language->gettext_sprintf(
-            'Invalid argument \'%s\' (command is expected)', $command)
-            . "\n";
-        return undef;
+    if (@argv and ($argv[0] // '') =~ /\A\w+\z/) {
+        # Check if (sub-)command is implemented.
+        my $dir = $INC{($class =~ s|::|/|gr) . '.pm'} =~ s/[.]pm\z//r;
+        if (-e "$dir/$argv[0].pm") {
+            # Load module for the command.
+            my $command = shift @argv;
+            my $subclass = sprintf '%s::%s', $class, $command;
+            unless (eval(sprintf 'require %s', $subclass)
+                and $subclass->isa($class)) {
+                warn $language->gettext_sprintf('Invalid command \'%s\'',
+                    $command)
+                    . "\n";
+                return undef;
+            }
+            return $subclass->run(($options ? ($options) : ()), @argv);
+        }
     }
-    my $module = sprintf '%s::%s', $class, $command;
-    unless (eval sprintf 'require %s', $module and $module->isa($class)) {
-        warn $language->gettext_sprintf('Invalid command \'%s\'', $command)
+    if ($class eq 'Sympa::CLI') {
+        # No valid main command.
+        warn $language->gettext_sprintf(
+            'Invalid argument \'%s\' (command is expected)',
+            ($argv[0] // ''))
             . "\n";
         return undef;
     }
 
-    # Check if any sub-commands are implemented.
-    if (@argv and length($argv[0] // '') and $argv[0] !~ /\W/) {
-        my $subdir = $INC{($module =~ s|::|/|gr) . '.pm'} =~ s/[.]pm\z//r;
-        if (<$subdir/*.pm>) {
-            return $module->run(($options ? ($options) : ()), @argv);
-        }
-    }
-
     # Parse options if necessary.
     my %options;
     if ($options) {
         %options = %$options;
-    } elsif (grep /^-/, $module->_options) {
+    } elsif (grep /^-/, $class->_options) {
         ;
     } elsif (
         not Getopt::Long::GetOptionsFromArray(
             \@argv, \%options,
             qw(config|f=s debug|d lang|l=s log_level=s mail|m),
-            $module->_options
+            $class->_options
         )
     ) {
         warn $language->gettext_sprintf('See \'%s help %s\'',
             $PROGRAM_NAME, join ' ', split /::/,
-            ($module =~ s/\ASympa::CLI:://r))
+            ($class =~ s/\ASympa::CLI:://r))
             . "\n";
         return undef;
     }
@@ -122,11 +127,11 @@ sub run {
     # Get privileges and load config if necessary.
     # Otherwise only setup language if specified.
     $language->set_lang($options{lang}) if $options{lang};
-    $module->arrange(%options) if $module->_need_priv;
+    $class->arrange(%options) if $class->_need_priv;
 
     # Parse arguments.
     my @parsed_argv = ();
-    foreach my $argdefs ($module->_args) {
+    foreach my $argdefs ($class->_args) {
         my $defs = $argdefs;
         my @a;
         if ($defs =~ s/[*]\z//) {
@@ -136,8 +141,8 @@ sub run {
         } elsif (@argv and defined $argv[0]) {
             @a = (shift @argv);
         } else {
-            warn $language->gettext_sprintf(
-                'Missing argument (%s is expected)', $defs)
+            warn $language->gettext_sprintf('Missing argument (%s)',
+                _arg_expected($defs))
                 . "\n";
             return undef;
         }
@@ -193,15 +198,15 @@ sub run {
                 push @parsed_argv, $val;
             } else {
                 warn $language->gettext_sprintf(
-                    'Invalid argument \'%s\' (%s is expected)',
-                    $arg, $defs)
+                    'Invalid argument \'%s\' (%s)',
+                    $arg, _arg_expected($defs))
                     . "\n";
                 return undef;
             }
         }
     }
 
-    $module->_run(\%options, @parsed_argv, @argv);
+    $class->_run(\%options, @parsed_argv, @argv);
 }
 
 sub _options       { () }
@@ -401,6 +406,36 @@ sub _translate_warn {
 
 $SIG{__WARN__} = sub { warn _translate_warn(shift) };
 
+my $arg_labels = {
+    list    => {gettext_id => 'list'},
+    list_id => {gettext_id => 'list'},
+    family  => {gettext_id => 'family'},
+    domain  => {gettext_id => 'domain'},
+    site    => {gettext_id => '"*"'},
+    command => {gettext_id => 'command'},
+    string  => {gettext_id => 'string'},
+    email   => {gettext_id => 'email address'},
+};
+
+sub _arg_expected {
+    my $defs = shift;
+
+    my @labels = map {
+              $arg_labels->{$_}
+            ? $language->gettext($arg_labels->{$_}->{gettext_id})
+            : $_
+    } split /[|]/, ($defs =~ s/[?*]\z//r);
+    if (3 == scalar @labels) {
+        return $language->gettext_sprintf('%s, %s or %s is expected',
+            @labels);
+    } elsif (2 == scalar @labels) {
+        return $language->gettext_sprintf('%s or %s is expected', @labels);
+    } else {
+        return $language->gettext_sprintf('%s is expected',
+            join(', ', @labels));
+    }
+}
+
 1;
 __END__
 

src/lib/Sympa/CLI/help.pm

@@ -28,6 +28,7 @@ use English qw(-no_match_vars);
 use Pod::Usage qw();
 
 use Sympa::Constants;
+use Sympa::Language;
 
 use parent qw(Sympa::CLI);
 
@@ -35,6 +36,8 @@ use constant _options   => qw(format|o=s);
 use constant _args      => qw(command*);
 use constant _need_priv => 0;
 
+my $language = Sympa::Language->instance;
+
 sub _run {
     my $class   = shift;
     my $options = shift;
@@ -68,9 +71,13 @@ sub _run {
         undef $path;
     }
     unless ($path) {
-        printf STDERR
-            "Unknown command '%s'. See '%s help commands' to know available commands.\n",
-            join(' ', @command), $PROGRAM_NAME;
+        warn $language->gettext_sprintf('Unknown command \'%s\'',
+            join(' ', @command))
+            . "\n";
+        warn $language->gettext_sprintf(
+            'See \'%s help\' to know available commands',
+            $PROGRAM_NAME)
+            . "\n";
         exit 1;
     } else {
         Pod::Usage::pod2usage(