[Module-build-checkins] Module-Build/lib/Module/Build YAML.pm,NONE,1.1 Base.pm,1.561,1.562

[Ken W. <kwi...@us...>]

Update of /cvsroot/module-build/Module-Build/lib/Module/Build
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv21878/lib/Module/Build

Modified Files:
	Base.pm 
Added Files:
	YAML.pm 
Log Message:
Include our own YAML work-alike

Index: Base.pm
===================================================================
RCS file: /cvsroot/module-build/Module-Build/lib/Module/Build/Base.pm,v
retrieving revision 1.561
retrieving revision 1.562
diff -u -d -r1.561 -r1.562
--- Base.pm	18 Mar 2006 02:35:32 -0000	1.561
+++ Base.pm	21 Mar 2006 04:51:34 -0000	1.562
@@ -3034,44 +3034,6 @@
   }
 }
 
-sub _yaml_quote_string {
-  # XXX doesn't handle embedded newlines
-
-  my ($self, $string) = @_;
-  if ($string !~ /\"/) {
-    $string =~ s{\\}{\\\\}g;
-    return qq{"$string"};
-  } else {
-    $string =~ s{([\\'])}{\\$1}g;
-    return qq{'$string'};
-  }
-}
-
-sub _write_minimal_metadata {
-  my $self = shift;
-  my $p = $self->{properties};
-
-  my $file = $self->metafile;
-  my $fh = IO::File->new("> $file")
-    or die "Can't open $file: $!";
-
-  my @author = map $self->_yaml_quote_string($_), @{$self->dist_author};
-  my $abstract = $self->_yaml_quote_string($self->dist_abstract);
-
-  # XXX Add the meta_add & meta_merge stuff
-
-  print $fh <<"EOF";
---- #YAML:1.0
-name: $p->{dist_name}
-version: $p->{dist_version}
-author:
-@{[ join "\n", map "  - $_", @author ]}
-abstract: $abstract
-license: $p->{license}
-generated_by: Module::Build version $Module::Build::VERSION, without YAML.pm
-EOF
-}
-
 sub ACTION_distmeta {
   my ($self) = @_;
 
@@ -3126,26 +3088,25 @@
     $self->{wrote_metadata} = $yaml_sub->($metafile, $node );
 
   } else {
-    $self->log_warn(<<EOF);
-
-Couldn't load YAML.pm, generating a minimal META.yml without it.
-Please check and edit the generated metadata, or consider installing YAML.pm.
-
-EOF
-
-    $self->_write_minimal_metadata;
+    require Module::Build::YAML;
+    my (%node, @order_keys);
+    $self->prepare_metadata(\%node, \@order_keys);
+    $node{_order} = \@order_keys;
+    &Module::Build::YAML::DumpFile($metafile, \%node);
+    $self->{wrote_metadata} = 1;
   }
 
   $self->_add_to_manifest('MANIFEST', $metafile);
 }
 
 sub prepare_metadata {
-  my ($self, $node) = @_;
+  my ($self, $node, $keys) = @_;
   my $p = $self->{properties};
 
   foreach (qw(dist_name dist_version dist_author dist_abstract license)) {
     (my $name = $_) =~ s/^dist_//;
     $node->{$name} = $self->$_();
+    push(@$keys, $name) if ($keys);
     die "ERROR: Missing required field '$_' for META.yml\n"
       unless defined($node->{$name}) && length($node->{$name});
   }
@@ -3156,10 +3117,16 @@
   }
 
   foreach ( @{$self->prereq_action_types} ) {
-    $node->{$_} = $p->{$_} if exists $p->{$_} and keys %{ $p->{$_} };
+    if (exists $p->{$_} and keys %{ $p->{$_} }) {
+      $node->{$_} = $p->{$_};
+      push(@$keys, $_) if ($keys);
+    }
   }
 
-  $node->{dynamic_config} = $p->{dynamic_config} if exists $p->{dynamic_config};
+  if (exists $p->{dynamic_config}) {
+    $node->{dynamic_config} = $p->{dynamic_config};
+    push(@$keys, "dynamic_config") if ($keys);
+  }
   my $pkgs = eval { $self->find_dist_packages };
   if ($@) {
     $self->log_warn("WARNING: Possible missing or corrupt 'MANIFEST' file.\n" .
@@ -3168,18 +3135,24 @@
     $node->{provides} = $pkgs if %$pkgs;
   }
 ;
-  $node->{no_index} = $p->{no_index} if exists $p->{no_index};
+  if (exists $p->{no_index}) {
+    $node->{no_index} = $p->{no_index};
+    push(@$keys, "no_index") if ($keys);
+  }
 
   $node->{generated_by} = "Module::Build version $Module::Build::VERSION";
+  push(@$keys, "generated_by") if ($keys);
 
   $node->{'meta-spec'} = {
     version => '1.2',
     url     => 'http://module-build.sourceforge.net/META-spec-v1.2.html',
   };
+  push(@$keys, "meta-spec") if ($keys);
 
 
   while (my($k, $v) = each %{$self->meta_add}) {
     $node->{$k} = $v;
+    push(@$keys, $k) if ($keys);
   }
 
   while (my($k, $v) = each %{$self->meta_merge}) {

--- NEW FILE: YAML.pm ---
package Module::Build::YAML;

use strict;
use warnings;

our $VERSION = "0.50";
our @EXPORT = ();
our @EXPORT_OK = qw(Dump Load DumpFile LoadFile);

sub new {
    my $this = shift;
    my $class = ref($this) || $this;
    my $self = {};
    bless $self, $class;
    return($self);
}

sub Dump {
    shift if ($_[0] eq __PACKAGE__ || ref($_[0]) eq __PACKAGE__);
    my $yaml = "";
    foreach my $item (@_) {
        $yaml .= "---\n";
        $yaml .= &_yaml_chunk("", $item);
    }
    return $yaml;
}

sub Load {
    shift if ($_[0] eq __PACKAGE__ || ref($_[0]) eq __PACKAGE__);
    die "not yet implemented";
}

# This is basically copied out of YAML.pm and simplified a little.
sub DumpFile {
    shift if ($_[0] eq __PACKAGE__ || ref($_[0]) eq __PACKAGE__);
    my $filename = shift;
    local $/ = "\n"; # reset special to "sane"
    my $mode = '>';
    if ($filename =~ /^\s*(>{1,2})\s*(.*)$/) {
        ($mode, $filename) = ($1, $2);
    }
    open my $OUT, $mode, $filename
      or die "Can't open $filename for writing: $!";
    print $OUT Dump(@_);
    close $OUT;
}

# This is basically copied out of YAML.pm and simplified a little.
sub LoadFile {
    shift if ($_[0] eq __PACKAGE__ || ref($_[0]) eq __PACKAGE__);
    my $filename = shift;
    open my $IN, $filename
      or die "Can't open $filename for reading: $!";
    return Load(do { local $/; <$IN> });
    close $IN;
}   

sub _yaml_chunk {
  my ($indent, $values) = @_;
  my $yaml_chunk = "";
  my $ref = ref($values);
  my ($value, @allkeys, %keyseen);
  if (!$ref) {  # a scalar
    $yaml_chunk .= &_yaml_value($values) . "\n";
  }
  elsif ($ref eq "ARRAY") {
    foreach $value (@$values) {
      $yaml_chunk .= "$indent-";
      $ref = ref($value);
      if (!$ref) {
        $yaml_chunk .= " " . &_yaml_value($value) . "\n";
      }
      else {
        $yaml_chunk .= "\n";
        $yaml_chunk .= &_yaml_chunk("$indent  ", $value);
      }
    }
  }
  else { # assume "HASH"
    if ($values->{_order} && ref($values->{_order}) eq "ARRAY") {
        @allkeys = @{$values->{_order}};
        $values = { %$values };
        delete $values->{_order};
    }
    push(@allkeys, sort keys %$values);
    foreach my $key (@allkeys) {
      next if (!defined $key || $key eq "" || $keyseen{$key});
      $keyseen{$key} = 1;
      $yaml_chunk .= "$indent$key:";
      $value = $values->{$key};
      $ref = ref($value);
      if (!$ref) {
        $yaml_chunk .= " " . &_yaml_value($value) . "\n";
      }
      else {
        $yaml_chunk .= "\n";
        $yaml_chunk .= &_yaml_chunk("$indent  ", $value);
      }
    }
  }
  return($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('""');
  }
  # 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'};
  }
}

1;

__END__

=head1 NAME

Module::Build::YAML - Provides just enough YAML support so that Module::Build works even if YAML.pm is not installed

=head1 SYNOPSIS

    use Module::Build::YAML;

    ...

=head1 DESCRIPTION

Provides just enough YAML support so that Module::Build works even if YAML.pm is not installed.

Currently, this amounts to the ability to write META.yml files when "perl Build distmeta"
is executed via the Dump() and DumpFile() functions/methods.

=head1 AUTHOR

Stephen Adkins <spa...@gm...>

=head1 COPYRIGHT

Copyright (c) 2006. Stephen Adkins. All rights reserved.

This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.

See L<http://www.perl.com/perl/misc/Artistic.html>

=cut