Silence ill-behaved or failing Module::Build tests on VMS.

[p5sagit/p5-mst-13.2.git] / lib / Module / Build / YAML.pm

diff --git a/lib/Module/Build/YAML.pm b/lib/Module/Build/YAML.pm
index ef7eccf..4922bd5 100644 (file)
--- a/lib/Module/Build/YAML.pm
+++ b/lib/Module/Build/YAML.pm
@@ -1,11 +1,14 @@
 package Module::Build::YAML;
 
 use strict;
-use warnings;
+use vars qw($VERSION);
+$VERSION = '0.2808_01';
+$VERSION = eval $VERSION;
 
-our $VERSION = "0.50";
-our @EXPORT = ();
-our @EXPORT_OK = qw(Dump Load DumpFile LoadFile);
+use vars qw($VERSION @EXPORT @EXPORT_OK);
+$VERSION = "0.50";
+@EXPORT = ();
+@EXPORT_OK = qw(Dump Load DumpFile LoadFile);
 
 sub new {
     my $this = shift;
@@ -39,7 +42,7 @@ sub DumpFile {
     if ($filename =~ /^\s*(>{1,2})\s*(.*)$/) {
         ($mode, $filename) = ($1, $2);
     }
-    open my $OUT, $mode, $filename
+    open my $OUT, "$mode $filename"
       or die "Can't open $filename for writing: $!";
     print $OUT Dump(@_);
     close $OUT;
@@ -102,26 +105,24 @@ sub _yaml_chunk {
 }
 
 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 ~
+  return '~' if not defined $value;
+
+  # empty strings will become empty strings
+  return '""' if $value eq '';
+
   # allow simple scalars (without embedded quote chars) to be unquoted
-  elsif ($value !~ /["'\\]/) {
-    return($value);
-  }
-  # strings without double-quotes get double-quoted
-  elsif ($value !~ /\"/) {
-    $value =~ s{\\}{\\\\}g;
-    return qq{"$value"};
-  }
-  # other strings get single-quoted
-  else {
-    $value =~ s{([\\'])}{\\$1}g;
-    return qq{'$value'};
-  }
+  # (includes $%_+=-\;:,./)
+  return $value if $value !~ /["'`~\n!\@\#^\&\*\(\)\{\}\[\]\|<>\?]/;
+
+  # quote and escape strings with special values
+  return "'$value'"
+    if $value !~ /['`~\n!\#^\&\*\(\)\{\}\[\]\|\?]/;  # nothing but " or @ or < or > (email addresses)
+
+  $value =~ s/\n/\\n/g;    # handle embedded newlines
+  $value =~ s/"/\\"/g;     # handle embedded quotes
+  return qq{"$value"};
 }
 
 1;