Upgrade to Module::Build 0.2808_01
[p5sagit/p5-mst-13.2.git] / lib / Module / Build / YAML.pm
1 package Module::Build::YAML;
2
3 use strict;
4 use vars qw($VERSION);
5 $VERSION = '0.2808_01';
6 $VERSION = eval $VERSION;
7
8 use vars qw($VERSION @EXPORT @EXPORT_OK);
9 $VERSION = "0.50";
10 @EXPORT = ();
11 @EXPORT_OK = qw(Dump Load DumpFile LoadFile);
12
13 sub new {
14     my $this = shift;
15     my $class = ref($this) || $this;
16     my $self = {};
17     bless $self, $class;
18     return($self);
19 }
20
21 sub Dump {
22     shift if ($_[0] eq __PACKAGE__ || ref($_[0]) eq __PACKAGE__);
23     my $yaml = "";
24     foreach my $item (@_) {
25         $yaml .= "---\n";
26         $yaml .= &_yaml_chunk("", $item);
27     }
28     return $yaml;
29 }
30
31 sub Load {
32     shift if ($_[0] eq __PACKAGE__ || ref($_[0]) eq __PACKAGE__);
33     die "not yet implemented";
34 }
35
36 # This is basically copied out of YAML.pm and simplified a little.
37 sub DumpFile {
38     shift if ($_[0] eq __PACKAGE__ || ref($_[0]) eq __PACKAGE__);
39     my $filename = shift;
40     local $/ = "\n"; # reset special to "sane"
41     my $mode = '>';
42     if ($filename =~ /^\s*(>{1,2})\s*(.*)$/) {
43         ($mode, $filename) = ($1, $2);
44     }
45     open my $OUT, "$mode $filename"
46       or die "Can't open $filename for writing: $!";
47     print $OUT Dump(@_);
48     close $OUT;
49 }
50
51 # This is basically copied out of YAML.pm and simplified a little.
52 sub LoadFile {
53     shift if ($_[0] eq __PACKAGE__ || ref($_[0]) eq __PACKAGE__);
54     my $filename = shift;
55     open my $IN, $filename
56       or die "Can't open $filename for reading: $!";
57     return Load(do { local $/; <$IN> });
58     close $IN;
59 }   
60
61 sub _yaml_chunk {
62   my ($indent, $values) = @_;
63   my $yaml_chunk = "";
64   my $ref = ref($values);
65   my ($value, @allkeys, %keyseen);
66   if (!$ref) {  # a scalar
67     $yaml_chunk .= &_yaml_value($values) . "\n";
68   }
69   elsif ($ref eq "ARRAY") {
70     foreach $value (@$values) {
71       $yaml_chunk .= "$indent-";
72       $ref = ref($value);
73       if (!$ref) {
74         $yaml_chunk .= " " . &_yaml_value($value) . "\n";
75       }
76       else {
77         $yaml_chunk .= "\n";
78         $yaml_chunk .= &_yaml_chunk("$indent  ", $value);
79       }
80     }
81   }
82   else { # assume "HASH"
83     if ($values->{_order} && ref($values->{_order}) eq "ARRAY") {
84         @allkeys = @{$values->{_order}};
85         $values = { %$values };
86         delete $values->{_order};
87     }
88     push(@allkeys, sort keys %$values);
89     foreach my $key (@allkeys) {
90       next if (!defined $key || $key eq "" || $keyseen{$key});
91       $keyseen{$key} = 1;
92       $yaml_chunk .= "$indent$key:";
93       $value = $values->{$key};
94       $ref = ref($value);
95       if (!$ref) {
96         $yaml_chunk .= " " . &_yaml_value($value) . "\n";
97       }
98       else {
99         $yaml_chunk .= "\n";
100         $yaml_chunk .= &_yaml_chunk("$indent  ", $value);
101       }
102     }
103   }
104   return($yaml_chunk);
105 }
106
107 sub _yaml_value {
108   my ($value) = @_;
109   # undefs become ~
110   return '~' if not defined $value;
111
112   # empty strings will become empty strings
113   return '""' if $value eq '';
114
115   # allow simple scalars (without embedded quote chars) to be unquoted
116   # (includes $%_+=-\;:,./)
117   return $value if $value !~ /["'`~\n!\@\#^\&\*\(\)\{\}\[\]\|<>\?]/;
118
119   # quote and escape strings with special values
120   return "'$value'"
121     if $value !~ /['`~\n!\#^\&\*\(\)\{\}\[\]\|\?]/;  # nothing but " or @ or < or > (email addresses)
122
123   $value =~ s/\n/\\n/g;    # handle embedded newlines
124   $value =~ s/"/\\"/g;     # handle embedded quotes
125   return qq{"$value"};
126 }
127
128 1;
129
130 __END__
131
132 =head1 NAME
133
134 Module::Build::YAML - Provides just enough YAML support so that Module::Build works even if YAML.pm is not installed
135
136 =head1 SYNOPSIS
137
138     use Module::Build::YAML;
139
140     ...
141
142 =head1 DESCRIPTION
143
144 Provides just enough YAML support so that Module::Build works even if YAML.pm is not installed.
145
146 Currently, this amounts to the ability to write META.yml files when "perl Build distmeta"
147 is executed via the Dump() and DumpFile() functions/methods.
148
149 =head1 AUTHOR
150
151 Stephen Adkins <spadkins@gmail.com>
152
153 =head1 COPYRIGHT
154
155 Copyright (c) 2006. Stephen Adkins. All rights reserved.
156
157 This program is free software; you can redistribute it and/or modify it
158 under the same terms as Perl itself.
159
160 See L<http://www.perl.com/perl/misc/Artistic.html>
161
162 =cut
163