[libtest-bdd-cucumber-perl] 26/52: The option --i18n now prints the keywords in a more readable fashion. Again, this is closer to cucumber than it was before.

[Intrigeri]

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

intrigeri pushed a commit to annotated tag 0.19
in repository libtest-bdd-cucumber-perl.

commit 11311ba0ec33454d8997d3ea425583f34bd0d0e0
Author: glauschwuffel <glauschwuffel at nomaden.org>
Date:   Thu May 29 13:32:55 2014 +0200

    The option --i18n now prints the keywords in a more readable fashion. Again, this is closer to cucumber than it was before.
---
 lib/App/.#pherkin.pm              |  1 +
 lib/App/pherkin.pm                | 15 +++++++++++----
 lib/Test/BDD/Cucumber/I18n.pm     | 21 ++++++++++++++++++++-
 lib/Test/BDD/Cucumber/StepFile.pm | 11 ++++++-----
 4 files changed, 38 insertions(+), 10 deletions(-)

diff --git a/lib/App/.#pherkin.pm b/lib/App/.#pherkin.pm
new file mode 120000
index 0000000..61182e7
--- /dev/null
+++ b/lib/App/.#pherkin.pm
@@ -0,0 +1 @@
+glauschwuffel at GregorGoldbachMBP-2.local.265
\ No newline at end of file
diff --git a/lib/App/pherkin.pm b/lib/App/pherkin.pm
index 7e8b60a..afa7a07 100644
--- a/lib/App/pherkin.pm
+++ b/lib/App/pherkin.pm
@@ -2,9 +2,10 @@ package App::pherkin;
 
 use strict;
 use warnings;
+
 use FindBin::libs;
 use Getopt::Long;
-use Test::BDD::Cucumber::I18n qw(languages langdef);
+use Test::BDD::Cucumber::I18n qw(languages langdef readable_keywords keyword_to_subname);
 use List::Util qw(max);
 
 use Moose;
@@ -172,14 +173,20 @@ sub _print_langdef {
 
     my @keywords= qw(feature background scenario scenario_outline examples
 		     given when then and but);
-    my $max_length = max map { length $langdef->{$_} } @keywords;
+    my $max_length = max map { length readable_keywords ($langdef->{$_}) } @keywords;
 
     my $format= "| %-16s | %-${max_length}s |\n";
-
     for my $keyword (qw(feature background scenario scenario_outline
 			examples given when then and but )) {
-        printf $format, $keyword, $langdef->{$keyword};
+        printf $format, $keyword, readable_keywords($langdef->{$keyword});
     }
+
+    my $codeformat= "| %-16s | %-${max_length}s |\n";
+    for my $keyword (qw(given when then )) {
+        printf $codeformat, $keyword.' (code)',
+          readable_keywords($langdef->{$keyword}, \&keyword_to_subname);
+    }
+
     exit;
 }
 
diff --git a/lib/Test/BDD/Cucumber/I18n.pm b/lib/Test/BDD/Cucumber/I18n.pm
index e1fbf14..413f5f1 100644
--- a/lib/Test/BDD/Cucumber/I18n.pm
+++ b/lib/Test/BDD/Cucumber/I18n.pm
@@ -32,7 +32,7 @@ use utf8;
 
 use base 'Exporter';
 
-our @EXPORT_OK=qw(languages langdef has_language);
+our @EXPORT_OK=qw(languages langdef has_language readable_keywords keyword_to_subname);
 
 # Parse keywords hash for all supported languages from the DATA segment
 my $json      = join '', (<DATA>);
@@ -55,6 +55,25 @@ sub langdef {
     return $langdefs->{$language};
 }
 
+sub readable_keywords {
+    my ($string, $transform)=@_;
+
+    my @keywords= grep { $_ ne '[*]' } split(/\|/, $string);
+
+    @keywords = map { $transform->($_) } @keywords if $transform;
+
+    return join(', ', map { '"'.$_.'"' } @keywords);
+}
+
+sub keyword_to_subname {
+    my ($word)=@_;
+
+    # remove non-word characters so we have a decent sub name
+    $word =~ s{[^\p{Word}]}{}g;
+
+    return $word;
+}
+
 =head1 LANGUAGES
 
 Languages are defined in a JSON-based hash in the __DATA__ section of this file.
diff --git a/lib/Test/BDD/Cucumber/StepFile.pm b/lib/Test/BDD/Cucumber/StepFile.pm
index 2912cb3..0728ce0 100755
--- a/lib/Test/BDD/Cucumber/StepFile.pm
+++ b/lib/Test/BDD/Cucumber/StepFile.pm
@@ -10,7 +10,7 @@ use strict;
 use warnings;
 use Carp qw/croak/;
 
-use Test::BDD::Cucumber::I18n qw(languages langdef);
+use Test::BDD::Cucumber::I18n qw(languages langdef keyword_to_subname);
 require Exporter;
 our @ISA = qw(Exporter);
 our @EXPORT = qw(Givenn When Then Step Transform Before After C S Angenommen);
@@ -103,16 +103,17 @@ sub _alias_function {
 
   my @keywords=split('\|', $keywords);
   for my $word (@keywords) {
+    # asterisks won't be aliased to any sub
     next if $word eq '[*]';
-    # remove non-word characters
-    $word =~ s{[^\p{Word}]}{}g;
+
+    my $subname=keyword_to_subname($word);
 
     no strict 'refs';
     no warnings 'redefine';
-    *$word=$f;
+    *$subname=$f;
     use warnings 'redefine';
 
-    push @SUBS, $word;
+    push @SUBS, $subname;
     use strict 'refs';
   }
 }

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