[Module-build-checkins] [svn:Module-Build] r6293 - in Module-Build/trunk: . lib/Module/Build t

[<kwi...@cv...>]

Author: kwilliams
Date: Fri May 12 14:25:11 2006
New Revision: 6293

Modified:
   Module-Build/trunk/Changes
   Module-Build/trunk/lib/Module/Build/YAML.pm
   Module-Build/trunk/t/mbyaml.t

Log:
Some fixes for YAML generation

Modified: Module-Build/trunk/Changes
==============================================================================
--- Module-Build/trunk/Changes	(original)
+++ Module-Build/trunk/Changes	Fri May 12 14:25:11 2006
@@ -20,6 +20,12 @@
    attended mode are working properly was assuming that we started out
    in attended mode. [Steve Peters]
 
+ - Improved our stand-in YAML generator that we use to generate
+   META.yaml when authors don't have a copy of YAML.pm installed on
+   their machine.  It was unable to handle things like embedded
+   newlines in the data, now it has a much more extensive escaping
+   mechanism. [Stephen Adkins]
+
 0.28  Thu Apr 27 22:25:00 CDT 2006
 
  - When y_n() or prompt() are called without a default value and the

Modified: Module-Build/trunk/lib/Module/Build/YAML.pm
==============================================================================
--- Module-Build/trunk/lib/Module/Build/YAML.pm	(original)
+++ Module-Build/trunk/lib/Module/Build/YAML.pm	Fri May 12 14:25:11 2006
@@ -102,25 +102,30 @@
 }
 
 sub _yaml_value {
-  # XXX doesn't handle embedded newlines
   my ($value) = @_;
-  # undefs and empty strings will become empty strings
-  if (! defined $value || $value eq "") {
-    return('""');
+  # undefs become ~
+  if (! defined $value) {
+    return("~");
   }
-  # allow simple scalars (without embedded quote chars) to be unquoted
-  elsif ($value !~ /["'\\]/) {
-    return($value);
+  # empty strings will become empty strings
+  elsif (! defined $value || $value eq "") {
+    return('""');
   }
-  # strings without double-quotes get double-quoted
-  elsif ($value !~ /\"/) {
-    $value =~ s{\\}{\\\\}g;
-    return qq{"$value"};
+  # quote and escape strings with special values
+  elsif ($value =~ /["'`~\n!\@\#^\&\*\(\)\{\}\[\]\|<>\?]/) {
+    if ($value !~ /['`~\n!\#^\&\*\(\)\{\}\[\]\|\?]/) {  # nothing but " or @ or < or > (email addresses)
+      return("'" . $value . "'");
+    }
+    else {
+      $value =~ s/\n/\\n/g;    # handle embedded newlines
+      $value =~ s/"/\\"/g;     # handle embedded quotes
+      return('"' . $value . '"');
+    }
   }
-  # other strings get single-quoted
+  # allow simple scalars (without embedded quote chars) to be unquoted
+  # (includes $%_+=-\;:,./)
   else {
-    $value =~ s{([\\'])}{\\$1}g;
-    return qq{'$value'};
+    return($value);
   }
 }
 

Modified: Module-Build/trunk/t/mbyaml.t
==============================================================================
--- Module-Build/trunk/t/mbyaml.t	(original)
+++ Module-Build/trunk/t/mbyaml.t	Fri May 12 14:25:11 2006
@@ -9,9 +9,12 @@
 $dir = "t" if (-d "t");
 
 {
-  use_ok("Module::Build::YAML");
-  my ($expected, $got, $var);
-  $var = {
+    use_ok("Module::Build::YAML");
+    my ($expected, $got, $var);
+    ##########################################################
+    # Test a typical-looking Module::Build structure (alphabetized)
+    ##########################################################
+    $var = {
           'resources' => {
                            'license' => 'http://opensource.org/licenses/artistic-license.php'
                          },
@@ -43,11 +46,11 @@
                         },
           'abstract' => 'A framework for building dynamic widgets or full applications in Javascript'
         };
-  $expected = <<EOF;
+    $expected = <<'EOF';
 ---
 abstract: A framework for building dynamic widgets or full applications in Javascript
 author:
-  - '"Stephen Adkins" <spadkins\@gmail.com>'
+  - '"Stephen Adkins" <spa...@gm...>'
 build_requires:
   App::Build: 0
   File::Spec: 0
@@ -72,12 +75,15 @@
     $got = &Module::Build::YAML::Dump($var);
     is($got, $expected, "Dump(): single deep hash");
 
-  $expected = <<EOF;
+    ##########################################################
+    # Test a typical-looking Module::Build structure (ordered)
+    ##########################################################
+    $expected = <<'EOF';
 ---
 name: js-app
 version: 0.13
 author:
-  - '"Stephen Adkins" <spadkins\@gmail.com>'
+  - '"Stephen Adkins" <spa...@gm...>'
 abstract: A framework for building dynamic widgets or full applications in Javascript
 license: lgpl
 resources:
@@ -102,13 +108,16 @@
     $got = &Module::Build::YAML::Dump($var);
     is($got, $expected, "Dump(): single deep hash, ordered");
 
+    ##########################################################
+    # Test that an array turns into multiple documents
+    ##########################################################
     $var = [
         "e",
         2.71828,
         [ "pi", "is", 3.1416 ],
         { fun => "under_sun", 6 => undef, "more", undef },
     ];
-    $expected = <<EOF;
+    $expected = <<'EOF';
 ---
 e
 ---
@@ -118,14 +127,17 @@
 - is
 - 3.1416
 ---
-6: ""
+6: ~
 fun: under_sun
-more: ""
+more: ~
 EOF
     $got = &Module::Build::YAML::Dump(@$var);
     is($got, $expected, "Dump(): multiple, various");
 
-    $expected = <<EOF;
+    ##########################################################
+    # Test that a single array ref turns into one document
+    ##########################################################
+    $expected = <<'EOF';
 ---
 - e
 - 2.71828
@@ -134,16 +146,115 @@
   - is
   - 3.1416
 -
-  6: ""
+  6: ~
   fun: under_sun
-  more: ""
+  more: ~
 EOF
     $got = &Module::Build::YAML::Dump($var);
     is($got, $expected, "Dump(): single array of various");
 
+    ##########################################################
+    # Test Object-Oriented Flavor of the API
+    ##########################################################
     my $y = Module::Build::YAML->new();
     $got = $y->Dump($var);
     is($got, $expected, "Dump(): single array of various (OO)");
+
+    ##########################################################
+    # Test Quoting Conditions (newlines, quotes, tildas, undefs)
+    ##########################################################
+    $var = {
+        'foo01' => '`~!@#$%^&*()_+-={}|[]\\;\':",./?<>
+<nl>',
+        'foo02' => '~!@#$%^&*()_+-={}|[]\\;:,./<>?',
+        'foo03' => undef,
+        'foo04' => '~',
+    };
+    $expected = <<'EOF';
+---
+foo01: "`~!@#$%^&*()_+-={}|[]\;':\",./?<>\n<nl>"
+foo02: "~!@#$%^&*()_+-={}|[]\;:,./<>?"
+foo03: ~
+foo04: "~"
+EOF
+    $got = &Module::Build::YAML::Dump($var);
+    is($got, $expected, "Dump(): tricky embedded characters");
+
+    $var = {
+        'foo10' => undef,
+        'foo40' => '!',
+        'foo41' => '@',
+        'foo42' => '#',
+        'foo43' => '$',
+        'foo44' => '%',
+        'foo45' => '^',
+        'foo47' => '&',
+        'foo48' => '*',
+        'foo49' => '(',
+        'foo50' => ')',
+        'foo51' => '_',
+        'foo52' => '+',
+        'foo53' => '-',
+        'foo54' => '=',
+        'foo55' => '{',
+        'foo56' => '}',
+        'foo57' => '|',
+        'foo58' => '[',
+        'foo59' => ']',
+        'foo60' => '\\',
+        'foo61' => ';',
+        'foo62' => ':',
+        'foo63' => ',',
+        'foo64' => '.',
+        'foo65' => '/',
+        'foo66' => '<',
+        'foo67' => '>',
+        'foo68' => '?',
+        'foo69' => '\'',
+        'foo70' => '"',
+        'foo71' => '`',
+        'foo72' => '
+',
+    };
+    $expected = <<'EOF';
+---
+foo10: ~
+foo40: "!"
+foo41: '@'
+foo42: "#"
+foo43: $
+foo44: %
+foo45: "^"
+foo47: "&"
+foo48: "*"
+foo49: "("
+foo50: ")"
+foo51: _
+foo52: +
+foo53: -
+foo54: =
+foo55: "{"
+foo56: "}"
+foo57: "|"
+foo58: "["
+foo59: "]"
+foo60: \
+foo61: ;
+foo62: :
+foo63: ,
+foo64: .
+foo65: /
+foo66: '<'
+foo67: '>'
+foo68: "?"
+foo69: "'"
+foo70: '"'
+foo71: "`"
+foo72: "\n"
+EOF
+    $got = &Module::Build::YAML::Dump($var);
+    is($got, $expected, "Dump(): tricky embedded characters (singles)");
+
 }