1 | use 5.008001; # sane UTF-8 support
|
---|
2 | use strict;
|
---|
3 | use warnings;
|
---|
4 | # Original is YAML::Tiny git description: v1.72-7-g8682f63
|
---|
5 | # We rename it here to allow embedded usage during setupv
|
---|
6 | # when no YAML implementation is available on the target system
|
---|
7 | #
|
---|
8 | package ProjectBuilder::YAML;
|
---|
9 | # XXX-INGY is 5.8.1 too old/broken for utf8?
|
---|
10 | # XXX-XDG Lancaster consensus was that it was sufficient until
|
---|
11 | # proven otherwise
|
---|
12 |
|
---|
13 | our $VERSION = '1.73';
|
---|
14 |
|
---|
15 | #####################################################################
|
---|
16 | # The ProjectBuilder::YAML API.
|
---|
17 | #
|
---|
18 | # These are the currently documented API functions/methods and
|
---|
19 | # exports:
|
---|
20 |
|
---|
21 | use Exporter;
|
---|
22 | our @ISA = qw{ Exporter };
|
---|
23 | our @EXPORT = qw{ pb_Load pb_Dump };
|
---|
24 | our @EXPORT_OK = qw{ pb_LoadFile pb_DumpFile freeze thaw };
|
---|
25 |
|
---|
26 | ###
|
---|
27 | # Functional/Export API:
|
---|
28 |
|
---|
29 | sub pb_Dump {
|
---|
30 | return ProjectBuilder::YAML->new(@_)->_dump_string;
|
---|
31 | }
|
---|
32 |
|
---|
33 | # XXX-INGY Returning last document seems a bad behavior.
|
---|
34 | # XXX-XDG I think first would seem more natural, but I don't know
|
---|
35 | # that it's worth changing now
|
---|
36 | sub pb_Load {
|
---|
37 | my $self = ProjectBuilder::YAML->_load_string(@_);
|
---|
38 | if ( wantarray ) {
|
---|
39 | return @$self;
|
---|
40 | } else {
|
---|
41 | # To match YAML.pm, return the last document
|
---|
42 | return $self->[-1];
|
---|
43 | }
|
---|
44 | }
|
---|
45 |
|
---|
46 | # XXX-INGY Do we really need freeze and thaw?
|
---|
47 | # XXX-XDG I don't think so. I'd support deprecating them.
|
---|
48 | BEGIN {
|
---|
49 | *freeze = \&pb_Dump;
|
---|
50 | *thaw = \&pb_Load;
|
---|
51 | }
|
---|
52 |
|
---|
53 | sub pb_DumpFile {
|
---|
54 | my $file = shift;
|
---|
55 | return ProjectBuilder::YAML->new(@_)->_dump_file($file);
|
---|
56 | }
|
---|
57 |
|
---|
58 | sub pb_LoadFile {
|
---|
59 | my $file = shift;
|
---|
60 | my $self = ProjectBuilder::YAML->_load_file($file);
|
---|
61 | if ( wantarray ) {
|
---|
62 | return @$self;
|
---|
63 | } else {
|
---|
64 | # Return only the last document to match YAML.pm,
|
---|
65 | return $self->[-1];
|
---|
66 | }
|
---|
67 | }
|
---|
68 |
|
---|
69 |
|
---|
70 | ###
|
---|
71 | # Object Oriented API:
|
---|
72 |
|
---|
73 | # Create an empty ProjectBuilder::YAML object
|
---|
74 | # XXX-INGY Why do we use ARRAY object?
|
---|
75 | # NOTE: I get it now, but I think it's confusing and not needed.
|
---|
76 | # Will change it on a branch later, for review.
|
---|
77 | #
|
---|
78 | # XXX-XDG I don't support changing it yet. It's a very well-documented
|
---|
79 | # "API" of ProjectBuilder::YAML. I'd support deprecating it, but Adam suggested
|
---|
80 | # we not change it until YAML.pm's own OO API is established so that
|
---|
81 | # users only have one API change to digest, not two
|
---|
82 | sub new {
|
---|
83 | my $class = shift;
|
---|
84 | bless [ @_ ], $class;
|
---|
85 | }
|
---|
86 |
|
---|
87 | # XXX-INGY It probably doesn't matter, and it's probably too late to
|
---|
88 | # change, but 'read/write' are the wrong names. Read and Write
|
---|
89 | # are actions that take data from storage to memory
|
---|
90 | # characters/strings. These take the data to/from storage to native
|
---|
91 | # Perl objects, which the terms dump and load are meant. As long as
|
---|
92 | # this is a legacy quirk to ProjectBuilder::YAML it's ok, but I'd prefer not
|
---|
93 | # to add new {read,write}_* methods to this API.
|
---|
94 |
|
---|
95 | sub read_string {
|
---|
96 | my $self = shift;
|
---|
97 | $self->_load_string(@_);
|
---|
98 | }
|
---|
99 |
|
---|
100 | sub write_string {
|
---|
101 | my $self = shift;
|
---|
102 | $self->_dump_string(@_);
|
---|
103 | }
|
---|
104 |
|
---|
105 | sub read {
|
---|
106 | my $self = shift;
|
---|
107 | $self->_load_file(@_);
|
---|
108 | }
|
---|
109 |
|
---|
110 | sub write {
|
---|
111 | my $self = shift;
|
---|
112 | $self->_dump_file(@_);
|
---|
113 | }
|
---|
114 |
|
---|
115 |
|
---|
116 |
|
---|
117 |
|
---|
118 | #####################################################################
|
---|
119 | # Constants
|
---|
120 |
|
---|
121 | # Printed form of the unprintable characters in the lowest range
|
---|
122 | # of ASCII characters, listed by ASCII ordinal position.
|
---|
123 | my @UNPRINTABLE = qw(
|
---|
124 | 0 x01 x02 x03 x04 x05 x06 a
|
---|
125 | b t n v f r x0E x0F
|
---|
126 | x10 x11 x12 x13 x14 x15 x16 x17
|
---|
127 | x18 x19 x1A e x1C x1D x1E x1F
|
---|
128 | );
|
---|
129 |
|
---|
130 | # Printable characters for escapes
|
---|
131 | my %UNESCAPES = (
|
---|
132 | 0 => "\x00", z => "\x00", N => "\x85",
|
---|
133 | a => "\x07", b => "\x08", t => "\x09",
|
---|
134 | n => "\x0a", v => "\x0b", f => "\x0c",
|
---|
135 | r => "\x0d", e => "\x1b", '\\' => '\\',
|
---|
136 | );
|
---|
137 |
|
---|
138 | # XXX-INGY
|
---|
139 | # I(ngy) need to decide if these values should be quoted in
|
---|
140 | # ProjectBuilder::YAML or not. Probably yes.
|
---|
141 |
|
---|
142 | # These 3 values have special meaning when unquoted and using the
|
---|
143 | # default YAML schema. They need quotes if they are strings.
|
---|
144 | my %QUOTE = map { $_ => 1 } qw{
|
---|
145 | null true false
|
---|
146 | };
|
---|
147 |
|
---|
148 | # The commented out form is simpler, but overloaded the Perl regex
|
---|
149 | # engine due to recursion and backtracking problems on strings
|
---|
150 | # larger than 32,000ish characters. Keep it for reference purposes.
|
---|
151 | # qr/\"((?:\\.|[^\"])*)\"/
|
---|
152 | my $re_capture_double_quoted = qr/\"([^\\"]*(?:\\.[^\\"]*)*)\"/;
|
---|
153 | my $re_capture_single_quoted = qr/\'([^\']*(?:\'\'[^\']*)*)\'/;
|
---|
154 | # unquoted re gets trailing space that needs to be stripped
|
---|
155 | my $re_capture_unquoted_key = qr/([^:]+(?::+\S(?:[^:]*|.*?(?=:)))*)(?=\s*\:(?:\s+|$))/;
|
---|
156 | my $re_trailing_comment = qr/(?:\s+\#.*)?/;
|
---|
157 | my $re_key_value_separator = qr/\s*:(?:\s+(?:\#.*)?|$)/;
|
---|
158 |
|
---|
159 |
|
---|
160 |
|
---|
161 |
|
---|
162 |
|
---|
163 | #####################################################################
|
---|
164 | # ProjectBuilder::YAML Implementation.
|
---|
165 | #
|
---|
166 | # These are the private methods that do all the work. They may change
|
---|
167 | # at any time.
|
---|
168 |
|
---|
169 |
|
---|
170 | ###
|
---|
171 | # Loader functions:
|
---|
172 |
|
---|
173 | # Create an object from a file
|
---|
174 | sub _load_file {
|
---|
175 | my $class = ref $_[0] ? ref shift : shift;
|
---|
176 |
|
---|
177 | # Check the file
|
---|
178 | my $file = shift or $class->_error( 'You did not specify a file name' );
|
---|
179 | $class->_error( "File '$file' does not exist" )
|
---|
180 | unless -e $file;
|
---|
181 | $class->_error( "'$file' is a directory, not a file" )
|
---|
182 | unless -f _;
|
---|
183 | $class->_error( "Insufficient permissions to read '$file'" )
|
---|
184 | unless -r _;
|
---|
185 |
|
---|
186 | # Open unbuffered with strict UTF-8 decoding and no translation layers
|
---|
187 | open( my $fh, "<:unix:encoding(UTF-8)", $file );
|
---|
188 | unless ( $fh ) {
|
---|
189 | $class->_error("Failed to open file '$file': $!");
|
---|
190 | }
|
---|
191 |
|
---|
192 | # flock if available (or warn if not possible for OS-specific reasons)
|
---|
193 | if ( _can_flock() ) {
|
---|
194 | flock( $fh, Fcntl::LOCK_SH() )
|
---|
195 | or warn "Couldn't lock '$file' for reading: $!";
|
---|
196 | }
|
---|
197 |
|
---|
198 | # slurp the contents
|
---|
199 | my $contents = eval {
|
---|
200 | use warnings FATAL => 'utf8';
|
---|
201 | local $/;
|
---|
202 | <$fh>
|
---|
203 | };
|
---|
204 | if ( my $err = $@ ) {
|
---|
205 | $class->_error("Error reading from file '$file': $err");
|
---|
206 | }
|
---|
207 |
|
---|
208 | # close the file (release the lock)
|
---|
209 | unless ( close $fh ) {
|
---|
210 | $class->_error("Failed to close file '$file': $!");
|
---|
211 | }
|
---|
212 |
|
---|
213 | $class->_load_string( $contents );
|
---|
214 | }
|
---|
215 |
|
---|
216 | # Create an object from a string
|
---|
217 | sub _load_string {
|
---|
218 | my $class = ref $_[0] ? ref shift : shift;
|
---|
219 | my $self = bless [], $class;
|
---|
220 | my $string = $_[0];
|
---|
221 | eval {
|
---|
222 | unless ( defined $string ) {
|
---|
223 | die \"Did not provide a string to load";
|
---|
224 | }
|
---|
225 |
|
---|
226 | # Check if Perl has it marked as characters, but it's internally
|
---|
227 | # inconsistent. E.g. maybe latin1 got read on a :utf8 layer
|
---|
228 | if ( utf8::is_utf8($string) && ! utf8::valid($string) ) {
|
---|
229 | die \<<'...';
|
---|
230 | Read an invalid UTF-8 string (maybe mixed UTF-8 and 8-bit character set).
|
---|
231 | Did you decode with lax ":utf8" instead of strict ":encoding(UTF-8)"?
|
---|
232 | ...
|
---|
233 | }
|
---|
234 |
|
---|
235 | # Ensure Unicode character semantics, even for 0x80-0xff
|
---|
236 | utf8::upgrade($string);
|
---|
237 |
|
---|
238 | # Check for and strip any leading UTF-8 BOM
|
---|
239 | $string =~ s/^\x{FEFF}//;
|
---|
240 |
|
---|
241 | # Check for some special cases
|
---|
242 | return $self unless length $string;
|
---|
243 |
|
---|
244 | # Split the file into lines
|
---|
245 | my @lines = grep { ! /^\s*(?:\#.*)?\z/ }
|
---|
246 | split /(?:\015{1,2}\012|\015|\012)/, $string;
|
---|
247 |
|
---|
248 | # Strip the initial YAML header
|
---|
249 | @lines and $lines[0] =~ /^\%YAML[: ][\d\.]+.*\z/ and shift @lines;
|
---|
250 |
|
---|
251 | # A nibbling parser
|
---|
252 | my $in_document = 0;
|
---|
253 | while ( @lines ) {
|
---|
254 | # Do we have a document header?
|
---|
255 | if ( $lines[0] =~ /^---\s*(?:(.+)\s*)?\z/ ) {
|
---|
256 | # Handle scalar documents
|
---|
257 | shift @lines;
|
---|
258 | if ( defined $1 and $1 !~ /^(?:\#.+|\%YAML[: ][\d\.]+)\z/ ) {
|
---|
259 | push @$self,
|
---|
260 | $self->_load_scalar( "$1", [ undef ], \@lines );
|
---|
261 | next;
|
---|
262 | }
|
---|
263 | $in_document = 1;
|
---|
264 | }
|
---|
265 |
|
---|
266 | if ( ! @lines or $lines[0] =~ /^(?:---|\.\.\.)/ ) {
|
---|
267 | # A naked document
|
---|
268 | push @$self, undef;
|
---|
269 | while ( @lines and $lines[0] !~ /^---/ ) {
|
---|
270 | shift @lines;
|
---|
271 | }
|
---|
272 | $in_document = 0;
|
---|
273 |
|
---|
274 | # XXX The final '-+$' is to look for -- which ends up being an
|
---|
275 | # error later.
|
---|
276 | } elsif ( ! $in_document && @$self ) {
|
---|
277 | # only the first document can be explicit
|
---|
278 | die \"ProjectBuilder::YAML failed to classify the line '$lines[0]'";
|
---|
279 | } elsif ( $lines[0] =~ /^\s*\-(?:\s|$|-+$)/ ) {
|
---|
280 | # An array at the root
|
---|
281 | my $document = [ ];
|
---|
282 | push @$self, $document;
|
---|
283 | $self->_load_array( $document, [ 0 ], \@lines );
|
---|
284 |
|
---|
285 | } elsif ( $lines[0] =~ /^(\s*)\S/ ) {
|
---|
286 | # A hash at the root
|
---|
287 | my $document = { };
|
---|
288 | push @$self, $document;
|
---|
289 | $self->_load_hash( $document, [ length($1) ], \@lines );
|
---|
290 |
|
---|
291 | } else {
|
---|
292 | # Shouldn't get here. @lines have whitespace-only lines
|
---|
293 | # stripped, and previous match is a line with any
|
---|
294 | # non-whitespace. So this clause should only be reachable via
|
---|
295 | # a perlbug where \s is not symmetric with \S
|
---|
296 |
|
---|
297 | # uncoverable statement
|
---|
298 | die \"ProjectBuilder::YAML failed to classify the line '$lines[0]'";
|
---|
299 | }
|
---|
300 | }
|
---|
301 | };
|
---|
302 | my $err = $@;
|
---|
303 | if ( ref $err eq 'SCALAR' ) {
|
---|
304 | $self->_error(${$err});
|
---|
305 | } elsif ( $err ) {
|
---|
306 | $self->_error($err);
|
---|
307 | }
|
---|
308 |
|
---|
309 | return $self;
|
---|
310 | }
|
---|
311 |
|
---|
312 | sub _unquote_single {
|
---|
313 | my ($self, $string) = @_;
|
---|
314 | return '' unless length $string;
|
---|
315 | $string =~ s/\'\'/\'/g;
|
---|
316 | return $string;
|
---|
317 | }
|
---|
318 |
|
---|
319 | sub _unquote_double {
|
---|
320 | my ($self, $string) = @_;
|
---|
321 | return '' unless length $string;
|
---|
322 | $string =~ s/\\"/"/g;
|
---|
323 | $string =~
|
---|
324 | s{\\([Nnever\\fartz0b]|x([0-9a-fA-F]{2}))}
|
---|
325 | {(length($1)>1)?pack("H2",$2):$UNESCAPES{$1}}gex;
|
---|
326 | return $string;
|
---|
327 | }
|
---|
328 |
|
---|
329 | # Load a YAML scalar string to the actual Perl scalar
|
---|
330 | sub _load_scalar {
|
---|
331 | my ($self, $string, $indent, $lines) = @_;
|
---|
332 |
|
---|
333 | # Trim trailing whitespace
|
---|
334 | $string =~ s/\s*\z//;
|
---|
335 |
|
---|
336 | # Explitic null/undef
|
---|
337 | return undef if $string eq '~';
|
---|
338 |
|
---|
339 | # Single quote
|
---|
340 | if ( $string =~ /^$re_capture_single_quoted$re_trailing_comment\z/ ) {
|
---|
341 | return $self->_unquote_single($1);
|
---|
342 | }
|
---|
343 |
|
---|
344 | # Double quote.
|
---|
345 | if ( $string =~ /^$re_capture_double_quoted$re_trailing_comment\z/ ) {
|
---|
346 | return $self->_unquote_double($1);
|
---|
347 | }
|
---|
348 |
|
---|
349 | # Special cases
|
---|
350 | if ( $string =~ /^[\'\"!&]/ ) {
|
---|
351 | die \"ProjectBuilder::YAML does not support a feature in line '$string'";
|
---|
352 | }
|
---|
353 | return {} if $string =~ /^{}(?:\s+\#.*)?\z/;
|
---|
354 | return [] if $string =~ /^\[\](?:\s+\#.*)?\z/;
|
---|
355 |
|
---|
356 | # Regular unquoted string
|
---|
357 | if ( $string !~ /^[>|]/ ) {
|
---|
358 | die \"ProjectBuilder::YAML found illegal characters in plain scalar: '$string'"
|
---|
359 | if $string =~ /^(?:-(?:\s|$)|[\@\%\`])/ or
|
---|
360 | $string =~ /:(?:\s|$)/;
|
---|
361 | $string =~ s/\s+#.*\z//;
|
---|
362 | return $string;
|
---|
363 | }
|
---|
364 |
|
---|
365 | # Error
|
---|
366 | die \"ProjectBuilder::YAML failed to find multi-line scalar content" unless @$lines;
|
---|
367 |
|
---|
368 | # Check the indent depth
|
---|
369 | $lines->[0] =~ /^(\s*)/;
|
---|
370 | $indent->[-1] = length("$1");
|
---|
371 | if ( defined $indent->[-2] and $indent->[-1] <= $indent->[-2] ) {
|
---|
372 | die \"ProjectBuilder::YAML found bad indenting in line '$lines->[0]'";
|
---|
373 | }
|
---|
374 |
|
---|
375 | # Pull the lines
|
---|
376 | my @multiline = ();
|
---|
377 | while ( @$lines ) {
|
---|
378 | $lines->[0] =~ /^(\s*)/;
|
---|
379 | last unless length($1) >= $indent->[-1];
|
---|
380 | push @multiline, substr(shift(@$lines), $indent->[-1]);
|
---|
381 | }
|
---|
382 |
|
---|
383 | my $j = (substr($string, 0, 1) eq '>') ? ' ' : "\n";
|
---|
384 | my $t = (substr($string, 1, 1) eq '-') ? '' : "\n";
|
---|
385 | return join( $j, @multiline ) . $t;
|
---|
386 | }
|
---|
387 |
|
---|
388 | # Load an array
|
---|
389 | sub _load_array {
|
---|
390 | my ($self, $array, $indent, $lines) = @_;
|
---|
391 |
|
---|
392 | while ( @$lines ) {
|
---|
393 | # Check for a new document
|
---|
394 | if ( $lines->[0] =~ /^(?:---|\.\.\.)/ ) {
|
---|
395 | while ( @$lines and $lines->[0] !~ /^---/ ) {
|
---|
396 | shift @$lines;
|
---|
397 | }
|
---|
398 | return 1;
|
---|
399 | }
|
---|
400 |
|
---|
401 | # Check the indent level
|
---|
402 | $lines->[0] =~ /^(\s*)/;
|
---|
403 | if ( length($1) < $indent->[-1] ) {
|
---|
404 | return 1;
|
---|
405 | } elsif ( length($1) > $indent->[-1] ) {
|
---|
406 | die \"ProjectBuilder::YAML found bad indenting in line '$lines->[0]'";
|
---|
407 | }
|
---|
408 |
|
---|
409 | if ( $lines->[0] =~ /^(\s*\-\s+)[^\'\"]\S*\s*:(?:\s+|$)/ ) {
|
---|
410 | # Inline nested hash
|
---|
411 | my $indent2 = length("$1");
|
---|
412 | $lines->[0] =~ s/-/ /;
|
---|
413 | push @$array, { };
|
---|
414 | $self->_load_hash( $array->[-1], [ @$indent, $indent2 ], $lines );
|
---|
415 |
|
---|
416 | } elsif ( $lines->[0] =~ /^\s*\-\s*\z/ ) {
|
---|
417 | shift @$lines;
|
---|
418 | unless ( @$lines ) {
|
---|
419 | push @$array, undef;
|
---|
420 | return 1;
|
---|
421 | }
|
---|
422 | if ( $lines->[0] =~ /^(\s*)\-/ ) {
|
---|
423 | my $indent2 = length("$1");
|
---|
424 | if ( $indent->[-1] == $indent2 ) {
|
---|
425 | # Null array entry
|
---|
426 | push @$array, undef;
|
---|
427 | } else {
|
---|
428 | # Naked indenter
|
---|
429 | push @$array, [ ];
|
---|
430 | $self->_load_array(
|
---|
431 | $array->[-1], [ @$indent, $indent2 ], $lines
|
---|
432 | );
|
---|
433 | }
|
---|
434 |
|
---|
435 | } elsif ( $lines->[0] =~ /^(\s*)\S/ ) {
|
---|
436 | push @$array, { };
|
---|
437 | $self->_load_hash(
|
---|
438 | $array->[-1], [ @$indent, length("$1") ], $lines
|
---|
439 | );
|
---|
440 |
|
---|
441 | } else {
|
---|
442 | die \"ProjectBuilder::YAML failed to classify line '$lines->[0]'";
|
---|
443 | }
|
---|
444 |
|
---|
445 | } elsif ( $lines->[0] =~ /^\s*\-(\s*)(.+?)\s*\z/ ) {
|
---|
446 | # Array entry with a value
|
---|
447 | shift @$lines;
|
---|
448 | push @$array, $self->_load_scalar(
|
---|
449 | "$2", [ @$indent, undef ], $lines
|
---|
450 | );
|
---|
451 |
|
---|
452 | } elsif ( defined $indent->[-2] and $indent->[-1] == $indent->[-2] ) {
|
---|
453 | # This is probably a structure like the following...
|
---|
454 | # ---
|
---|
455 | # foo:
|
---|
456 | # - list
|
---|
457 | # bar: value
|
---|
458 | #
|
---|
459 | # ... so lets return and let the hash parser handle it
|
---|
460 | return 1;
|
---|
461 |
|
---|
462 | } else {
|
---|
463 | die \"ProjectBuilder::YAML failed to classify line '$lines->[0]'";
|
---|
464 | }
|
---|
465 | }
|
---|
466 |
|
---|
467 | return 1;
|
---|
468 | }
|
---|
469 |
|
---|
470 | # Load a hash
|
---|
471 | sub _load_hash {
|
---|
472 | my ($self, $hash, $indent, $lines) = @_;
|
---|
473 |
|
---|
474 | while ( @$lines ) {
|
---|
475 | # Check for a new document
|
---|
476 | if ( $lines->[0] =~ /^(?:---|\.\.\.)/ ) {
|
---|
477 | while ( @$lines and $lines->[0] !~ /^---/ ) {
|
---|
478 | shift @$lines;
|
---|
479 | }
|
---|
480 | return 1;
|
---|
481 | }
|
---|
482 |
|
---|
483 | # Check the indent level
|
---|
484 | $lines->[0] =~ /^(\s*)/;
|
---|
485 | if ( length($1) < $indent->[-1] ) {
|
---|
486 | return 1;
|
---|
487 | } elsif ( length($1) > $indent->[-1] ) {
|
---|
488 | die \"ProjectBuilder::YAML found bad indenting in line '$lines->[0]'";
|
---|
489 | }
|
---|
490 |
|
---|
491 | # Find the key
|
---|
492 | my $key;
|
---|
493 |
|
---|
494 | # Quoted keys
|
---|
495 | if ( $lines->[0] =~
|
---|
496 | s/^\s*$re_capture_single_quoted$re_key_value_separator//
|
---|
497 | ) {
|
---|
498 | $key = $self->_unquote_single($1);
|
---|
499 | }
|
---|
500 | elsif ( $lines->[0] =~
|
---|
501 | s/^\s*$re_capture_double_quoted$re_key_value_separator//
|
---|
502 | ) {
|
---|
503 | $key = $self->_unquote_double($1);
|
---|
504 | }
|
---|
505 | elsif ( $lines->[0] =~
|
---|
506 | s/^\s*$re_capture_unquoted_key$re_key_value_separator//
|
---|
507 | ) {
|
---|
508 | $key = $1;
|
---|
509 | $key =~ s/\s+$//;
|
---|
510 | }
|
---|
511 | elsif ( $lines->[0] =~ /^\s*\?/ ) {
|
---|
512 | die \"ProjectBuilder::YAML does not support a feature in line '$lines->[0]'";
|
---|
513 | }
|
---|
514 | else {
|
---|
515 | die \"ProjectBuilder::YAML failed to classify line '$lines->[0]'";
|
---|
516 | }
|
---|
517 |
|
---|
518 | if ( exists $hash->{$key} ) {
|
---|
519 | warn "ProjectBuilder::YAML found a duplicate key '$key' in line '$lines->[0]'";
|
---|
520 | }
|
---|
521 |
|
---|
522 | # Do we have a value?
|
---|
523 | if ( length $lines->[0] ) {
|
---|
524 | # Yes
|
---|
525 | $hash->{$key} = $self->_load_scalar(
|
---|
526 | shift(@$lines), [ @$indent, undef ], $lines
|
---|
527 | );
|
---|
528 | } else {
|
---|
529 | # An indent
|
---|
530 | shift @$lines;
|
---|
531 | unless ( @$lines ) {
|
---|
532 | $hash->{$key} = undef;
|
---|
533 | return 1;
|
---|
534 | }
|
---|
535 | if ( $lines->[0] =~ /^(\s*)-/ ) {
|
---|
536 | $hash->{$key} = [];
|
---|
537 | $self->_load_array(
|
---|
538 | $hash->{$key}, [ @$indent, length($1) ], $lines
|
---|
539 | );
|
---|
540 | } elsif ( $lines->[0] =~ /^(\s*)./ ) {
|
---|
541 | my $indent2 = length("$1");
|
---|
542 | if ( $indent->[-1] >= $indent2 ) {
|
---|
543 | # Null hash entry
|
---|
544 | $hash->{$key} = undef;
|
---|
545 | } else {
|
---|
546 | $hash->{$key} = {};
|
---|
547 | $self->_load_hash(
|
---|
548 | $hash->{$key}, [ @$indent, length($1) ], $lines
|
---|
549 | );
|
---|
550 | }
|
---|
551 | }
|
---|
552 | }
|
---|
553 | }
|
---|
554 |
|
---|
555 | return 1;
|
---|
556 | }
|
---|
557 |
|
---|
558 |
|
---|
559 | ###
|
---|
560 | # Dumper functions:
|
---|
561 |
|
---|
562 | # Save an object to a file
|
---|
563 | sub _dump_file {
|
---|
564 | my $self = shift;
|
---|
565 |
|
---|
566 | require Fcntl;
|
---|
567 |
|
---|
568 | # Check the file
|
---|
569 | my $file = shift or $self->_error( 'You did not specify a file name' );
|
---|
570 |
|
---|
571 | my $fh;
|
---|
572 | # flock if available (or warn if not possible for OS-specific reasons)
|
---|
573 | if ( _can_flock() ) {
|
---|
574 | # Open without truncation (truncate comes after lock)
|
---|
575 | my $flags = Fcntl::O_WRONLY()|Fcntl::O_CREAT();
|
---|
576 | sysopen( $fh, $file, $flags )
|
---|
577 | or $self->_error("Failed to open file '$file' for writing: $!");
|
---|
578 |
|
---|
579 | # Use no translation and strict UTF-8
|
---|
580 | binmode( $fh, ":raw:encoding(UTF-8)");
|
---|
581 |
|
---|
582 | flock( $fh, Fcntl::LOCK_EX() )
|
---|
583 | or warn "Couldn't lock '$file' for reading: $!";
|
---|
584 |
|
---|
585 | # truncate and spew contents
|
---|
586 | truncate $fh, 0;
|
---|
587 | seek $fh, 0, 0;
|
---|
588 | }
|
---|
589 | else {
|
---|
590 | open $fh, ">:unix:encoding(UTF-8)", $file;
|
---|
591 | }
|
---|
592 |
|
---|
593 | # serialize and spew to the handle
|
---|
594 | print {$fh} $self->_dump_string;
|
---|
595 |
|
---|
596 | # close the file (release the lock)
|
---|
597 | unless ( close $fh ) {
|
---|
598 | $self->_error("Failed to close file '$file': $!");
|
---|
599 | }
|
---|
600 |
|
---|
601 | return 1;
|
---|
602 | }
|
---|
603 |
|
---|
604 | # Save an object to a string
|
---|
605 | sub _dump_string {
|
---|
606 | my $self = shift;
|
---|
607 | return '' unless ref $self && @$self;
|
---|
608 |
|
---|
609 | # Iterate over the documents
|
---|
610 | my $indent = 0;
|
---|
611 | my @lines = ();
|
---|
612 |
|
---|
613 | eval {
|
---|
614 | foreach my $cursor ( @$self ) {
|
---|
615 | push @lines, '---';
|
---|
616 |
|
---|
617 | # An empty document
|
---|
618 | if ( ! defined $cursor ) {
|
---|
619 | # Do nothing
|
---|
620 |
|
---|
621 | # A scalar document
|
---|
622 | } elsif ( ! ref $cursor ) {
|
---|
623 | $lines[-1] .= ' ' . $self->_dump_scalar( $cursor );
|
---|
624 |
|
---|
625 | # A list at the root
|
---|
626 | } elsif ( ref $cursor eq 'ARRAY' ) {
|
---|
627 | unless ( @$cursor ) {
|
---|
628 | $lines[-1] .= ' []';
|
---|
629 | next;
|
---|
630 | }
|
---|
631 | push @lines, $self->_dump_array( $cursor, $indent, {} );
|
---|
632 |
|
---|
633 | # A hash at the root
|
---|
634 | } elsif ( ref $cursor eq 'HASH' ) {
|
---|
635 | unless ( %$cursor ) {
|
---|
636 | $lines[-1] .= ' {}';
|
---|
637 | next;
|
---|
638 | }
|
---|
639 | push @lines, $self->_dump_hash( $cursor, $indent, {} );
|
---|
640 |
|
---|
641 | } else {
|
---|
642 | die \("Cannot serialize " . ref($cursor));
|
---|
643 | }
|
---|
644 | }
|
---|
645 | };
|
---|
646 | if ( ref $@ eq 'SCALAR' ) {
|
---|
647 | $self->_error(${$@});
|
---|
648 | } elsif ( $@ ) {
|
---|
649 | $self->_error($@);
|
---|
650 | }
|
---|
651 |
|
---|
652 | join '', map { "$_\n" } @lines;
|
---|
653 | }
|
---|
654 |
|
---|
655 | sub _has_internal_string_value {
|
---|
656 | my $value = shift;
|
---|
657 | my $b_obj = B::svref_2object(\$value); # for round trip problem
|
---|
658 | return $b_obj->FLAGS & B::SVf_POK();
|
---|
659 | }
|
---|
660 |
|
---|
661 | sub _dump_scalar {
|
---|
662 | my $string = $_[1];
|
---|
663 | my $is_key = $_[2];
|
---|
664 | # Check this before checking length or it winds up looking like a string!
|
---|
665 | my $has_string_flag = _has_internal_string_value($string);
|
---|
666 | return '~' unless defined $string;
|
---|
667 | return "''" unless length $string;
|
---|
668 | if (Scalar::Util::looks_like_number($string)) {
|
---|
669 | # keys and values that have been used as strings get quoted
|
---|
670 | if ( $is_key || $has_string_flag ) {
|
---|
671 | return qq['$string'];
|
---|
672 | }
|
---|
673 | else {
|
---|
674 | return $string;
|
---|
675 | }
|
---|
676 | }
|
---|
677 | if ( $string =~ /[\x00-\x09\x0b-\x0d\x0e-\x1f\x7f-\x9f\'\n]/ ) {
|
---|
678 | $string =~ s/\\/\\\\/g;
|
---|
679 | $string =~ s/"/\\"/g;
|
---|
680 | $string =~ s/\n/\\n/g;
|
---|
681 | $string =~ s/[\x85]/\\N/g;
|
---|
682 | $string =~ s/([\x00-\x1f])/\\$UNPRINTABLE[ord($1)]/g;
|
---|
683 | $string =~ s/([\x7f-\x9f])/'\x' . sprintf("%X",ord($1))/ge;
|
---|
684 | return qq|"$string"|;
|
---|
685 | }
|
---|
686 | if ( $string =~ /(?:^[~!@#%&*|>?:,'"`{}\[\]]|^-+$|\s|:\z)/ or
|
---|
687 | $QUOTE{$string}
|
---|
688 | ) {
|
---|
689 | return "'$string'";
|
---|
690 | }
|
---|
691 | return $string;
|
---|
692 | }
|
---|
693 |
|
---|
694 | sub _dump_array {
|
---|
695 | my ($self, $array, $indent, $seen) = @_;
|
---|
696 | if ( $seen->{refaddr($array)}++ ) {
|
---|
697 | die \"ProjectBuilder::YAML does not support circular references";
|
---|
698 | }
|
---|
699 | my @lines = ();
|
---|
700 | foreach my $el ( @$array ) {
|
---|
701 | my $line = (' ' x $indent) . '-';
|
---|
702 | my $type = ref $el;
|
---|
703 | if ( ! $type ) {
|
---|
704 | $line .= ' ' . $self->_dump_scalar( $el );
|
---|
705 | push @lines, $line;
|
---|
706 |
|
---|
707 | } elsif ( $type eq 'ARRAY' ) {
|
---|
708 | if ( @$el ) {
|
---|
709 | push @lines, $line;
|
---|
710 | push @lines, $self->_dump_array( $el, $indent + 1, $seen );
|
---|
711 | } else {
|
---|
712 | $line .= ' []';
|
---|
713 | push @lines, $line;
|
---|
714 | }
|
---|
715 |
|
---|
716 | } elsif ( $type eq 'HASH' ) {
|
---|
717 | if ( keys %$el ) {
|
---|
718 | push @lines, $line;
|
---|
719 | push @lines, $self->_dump_hash( $el, $indent + 1, $seen );
|
---|
720 | } else {
|
---|
721 | $line .= ' {}';
|
---|
722 | push @lines, $line;
|
---|
723 | }
|
---|
724 |
|
---|
725 | } else {
|
---|
726 | die \"ProjectBuilder::YAML does not support $type references";
|
---|
727 | }
|
---|
728 | }
|
---|
729 |
|
---|
730 | @lines;
|
---|
731 | }
|
---|
732 |
|
---|
733 | sub _dump_hash {
|
---|
734 | my ($self, $hash, $indent, $seen) = @_;
|
---|
735 | if ( $seen->{refaddr($hash)}++ ) {
|
---|
736 | die \"ProjectBuilder::YAML does not support circular references";
|
---|
737 | }
|
---|
738 | my @lines = ();
|
---|
739 | foreach my $name ( sort keys %$hash ) {
|
---|
740 | my $el = $hash->{$name};
|
---|
741 | my $line = (' ' x $indent) . $self->_dump_scalar($name, 1) . ":";
|
---|
742 | my $type = ref $el;
|
---|
743 | if ( ! $type ) {
|
---|
744 | $line .= ' ' . $self->_dump_scalar( $el );
|
---|
745 | push @lines, $line;
|
---|
746 |
|
---|
747 | } elsif ( $type eq 'ARRAY' ) {
|
---|
748 | if ( @$el ) {
|
---|
749 | push @lines, $line;
|
---|
750 | push @lines, $self->_dump_array( $el, $indent + 1, $seen );
|
---|
751 | } else {
|
---|
752 | $line .= ' []';
|
---|
753 | push @lines, $line;
|
---|
754 | }
|
---|
755 |
|
---|
756 | } elsif ( $type eq 'HASH' ) {
|
---|
757 | if ( keys %$el ) {
|
---|
758 | push @lines, $line;
|
---|
759 | push @lines, $self->_dump_hash( $el, $indent + 1, $seen );
|
---|
760 | } else {
|
---|
761 | $line .= ' {}';
|
---|
762 | push @lines, $line;
|
---|
763 | }
|
---|
764 |
|
---|
765 | } else {
|
---|
766 | die \"ProjectBuilder::YAML does not support $type references";
|
---|
767 | }
|
---|
768 | }
|
---|
769 |
|
---|
770 | @lines;
|
---|
771 | }
|
---|
772 |
|
---|
773 |
|
---|
774 |
|
---|
775 | #####################################################################
|
---|
776 | # DEPRECATED API methods:
|
---|
777 |
|
---|
778 | # Error storage (DEPRECATED as of 1.57)
|
---|
779 | our $errstr = '';
|
---|
780 |
|
---|
781 | # Set error
|
---|
782 | sub _error {
|
---|
783 | require Carp;
|
---|
784 | $errstr = $_[1];
|
---|
785 | $errstr =~ s/ at \S+ line \d+.*//;
|
---|
786 | Carp::croak( $errstr );
|
---|
787 | }
|
---|
788 |
|
---|
789 | # Retrieve error
|
---|
790 | my $errstr_warned;
|
---|
791 | sub errstr {
|
---|
792 | require Carp;
|
---|
793 | Carp::carp( "ProjectBuilder::YAML->errstr and \$ProjectBuilder::YAML::errstr is deprecated" )
|
---|
794 | unless $errstr_warned++;
|
---|
795 | $errstr;
|
---|
796 | }
|
---|
797 |
|
---|
798 |
|
---|
799 |
|
---|
800 |
|
---|
801 | #####################################################################
|
---|
802 | # Helper functions. Possibly not needed.
|
---|
803 |
|
---|
804 |
|
---|
805 | # Use to detect nv or iv
|
---|
806 | use B;
|
---|
807 |
|
---|
808 | # XXX-INGY Is flock ProjectBuilder::YAML's responsibility?
|
---|
809 | # Some platforms can't flock :-(
|
---|
810 | # XXX-XDG I think it is. When reading and writing files, we ought
|
---|
811 | # to be locking whenever possible. People (foolishly) use YAML
|
---|
812 | # files for things like session storage, which has race issues.
|
---|
813 | my $HAS_FLOCK;
|
---|
814 | sub _can_flock {
|
---|
815 | if ( defined $HAS_FLOCK ) {
|
---|
816 | return $HAS_FLOCK;
|
---|
817 | }
|
---|
818 | else {
|
---|
819 | require Config;
|
---|
820 | my $c = \%Config::Config;
|
---|
821 | $HAS_FLOCK = grep { $c->{$_} } qw/d_flock d_fcntl_can_lock d_lockf/;
|
---|
822 | require Fcntl if $HAS_FLOCK;
|
---|
823 | return $HAS_FLOCK;
|
---|
824 | }
|
---|
825 | }
|
---|
826 |
|
---|
827 |
|
---|
828 | # XXX-INGY Is this core in 5.8.1? Can we remove this?
|
---|
829 | # XXX-XDG Scalar::Util 1.18 didn't land until 5.8.8, so we need this
|
---|
830 | #####################################################################
|
---|
831 | # Use Scalar::Util if possible, otherwise emulate it
|
---|
832 |
|
---|
833 | use Scalar::Util ();
|
---|
834 | BEGIN {
|
---|
835 | local $@;
|
---|
836 | if ( eval { Scalar::Util->VERSION(1.18); } ) {
|
---|
837 | *refaddr = *Scalar::Util::refaddr;
|
---|
838 | }
|
---|
839 | else {
|
---|
840 | eval <<'END_PERL';
|
---|
841 | # Scalar::Util failed to load or too old
|
---|
842 | sub refaddr {
|
---|
843 | my $pkg = ref($_[0]) or return undef;
|
---|
844 | if ( !! UNIVERSAL::can($_[0], 'can') ) {
|
---|
845 | bless $_[0], 'Scalar::Util::Fake';
|
---|
846 | } else {
|
---|
847 | $pkg = undef;
|
---|
848 | }
|
---|
849 | "$_[0]" =~ /0x(\w+)/;
|
---|
850 | my $i = do { no warnings 'portable'; hex $1 };
|
---|
851 | bless $_[0], $pkg if defined $pkg;
|
---|
852 | $i;
|
---|
853 | }
|
---|
854 | END_PERL
|
---|
855 | }
|
---|
856 | }
|
---|
857 |
|
---|
858 | delete $ProjectBuilder::YAML::{refaddr};
|
---|
859 |
|
---|
860 | 1;
|
---|
861 |
|
---|
862 | # XXX-INGY Doc notes I'm putting up here. Changing the doc when it's wrong
|
---|
863 | # but leaving grey area stuff up here.
|
---|
864 | #
|
---|
865 | # I would like to change Read/Write to Load/Dump below without
|
---|
866 | # changing the actual API names.
|
---|
867 | #
|
---|
868 | # It might be better to put Load/Dump API in the SYNOPSIS instead of the
|
---|
869 | # dubious OO API.
|
---|
870 | #
|
---|
871 | # null and bool explanations may be outdated.
|
---|
872 |
|
---|
873 | __END__
|
---|
874 |
|
---|
875 | =pod
|
---|
876 |
|
---|
877 | =head1 NAME
|
---|
878 |
|
---|
879 | ProjectBuilder::YAML - Read/Write YAML files with as little code as possible
|
---|
880 |
|
---|
881 | =head1 VERSION
|
---|
882 |
|
---|
883 | version 1.73
|
---|
884 |
|
---|
885 | =head1 PREAMBLE
|
---|
886 |
|
---|
887 | The YAML specification is huge. Really, B<really> huge. It contains all the
|
---|
888 | functionality of XML, except with flexibility and choice, which makes it
|
---|
889 | easier to read, but with a formal specification that is more complex than
|
---|
890 | XML.
|
---|
891 |
|
---|
892 | The original pure-Perl implementation L<YAML> costs just over 4 megabytes
|
---|
893 | of memory to load. Just like with Windows F<.ini> files (3 meg to load) and
|
---|
894 | CSS (3.5 meg to load) the situation is just asking for a B<ProjectBuilder::YAML>
|
---|
895 | module, an incomplete but correct and usable subset of the functionality,
|
---|
896 | in as little code as possible.
|
---|
897 |
|
---|
898 | Like the other C<::Tiny> modules, ProjectBuilder::YAML has no non-core dependencies,
|
---|
899 | does not require a compiler to install, is back-compatible to Perl v5.8.1,
|
---|
900 | and can be inlined into other modules if needed.
|
---|
901 |
|
---|
902 | In exchange for this adding this extreme flexibility, it provides support
|
---|
903 | for only a limited subset of YAML. But the subset supported contains most
|
---|
904 | of the features for the more common uses of YAML.
|
---|
905 |
|
---|
906 | =head1 SYNOPSIS
|
---|
907 |
|
---|
908 | Assuming F<file.yml> like this:
|
---|
909 |
|
---|
910 | ---
|
---|
911 | rootproperty: blah
|
---|
912 | section:
|
---|
913 | one: two
|
---|
914 | three: four
|
---|
915 | Foo: Bar
|
---|
916 | empty: ~
|
---|
917 |
|
---|
918 |
|
---|
919 | Read and write F<file.yml> like this:
|
---|
920 |
|
---|
921 | use ProjectBuilder::YAML;
|
---|
922 |
|
---|
923 | # Open the config
|
---|
924 | my $yaml = ProjectBuilder::YAML->read( 'file.yml' );
|
---|
925 |
|
---|
926 | # Get a reference to the first document
|
---|
927 | my $config = $yaml->[0];
|
---|
928 |
|
---|
929 | # Or read properties directly
|
---|
930 | my $root = $yaml->[0]->{rootproperty};
|
---|
931 | my $one = $yaml->[0]->{section}->{one};
|
---|
932 | my $Foo = $yaml->[0]->{section}->{Foo};
|
---|
933 |
|
---|
934 | # Change data directly
|
---|
935 | $yaml->[0]->{newsection} = { this => 'that' }; # Add a section
|
---|
936 | $yaml->[0]->{section}->{Foo} = 'Not Bar!'; # Change a value
|
---|
937 | delete $yaml->[0]->{section}; # Delete a value
|
---|
938 |
|
---|
939 | # Save the document back to the file
|
---|
940 | $yaml->write( 'file.yml' );
|
---|
941 |
|
---|
942 | To create a new YAML file from scratch:
|
---|
943 |
|
---|
944 | # Create a new object with a single hashref document
|
---|
945 | my $yaml = ProjectBuilder::YAML->new( { wibble => "wobble" } );
|
---|
946 |
|
---|
947 | # Add an arrayref document
|
---|
948 | push @$yaml, [ 'foo', 'bar', 'baz' ];
|
---|
949 |
|
---|
950 | # Save both documents to a file
|
---|
951 | $yaml->write( 'data.yml' );
|
---|
952 |
|
---|
953 | Then F<data.yml> will contain:
|
---|
954 |
|
---|
955 | ---
|
---|
956 | wibble: wobble
|
---|
957 | ---
|
---|
958 | - foo
|
---|
959 | - bar
|
---|
960 | - baz
|
---|
961 |
|
---|
962 | =head1 DESCRIPTION
|
---|
963 |
|
---|
964 | B<ProjectBuilder::YAML> is a perl class for reading and writing YAML-style files,
|
---|
965 | written with as little code as possible, reducing load time and memory
|
---|
966 | overhead.
|
---|
967 |
|
---|
968 | Most of the time it is accepted that Perl applications use a lot
|
---|
969 | of memory and modules. The B<::Tiny> family of modules is specifically
|
---|
970 | intended to provide an ultralight and zero-dependency alternative to
|
---|
971 | many more-thorough standard modules.
|
---|
972 |
|
---|
973 | This module is primarily for reading human-written files (like simple
|
---|
974 | config files) and generating very simple human-readable files. Note that
|
---|
975 | I said B<human-readable> and not B<geek-readable>. The sort of files that
|
---|
976 | your average manager or secretary should be able to look at and make
|
---|
977 | sense of.
|
---|
978 |
|
---|
979 | =for stopwords normalise
|
---|
980 |
|
---|
981 | L<ProjectBuilder::YAML> does not generate comments, it won't necessarily preserve the
|
---|
982 | order of your hashes, and it will normalise if reading in and writing out
|
---|
983 | again.
|
---|
984 |
|
---|
985 | It only supports a very basic subset of the full YAML specification.
|
---|
986 |
|
---|
987 | =for stopwords embeddable
|
---|
988 |
|
---|
989 | Usage is targeted at files like Perl's META.yml, for which a small and
|
---|
990 | easily-embeddable module is extremely attractive.
|
---|
991 |
|
---|
992 | Features will only be added if they are human readable, and can be written
|
---|
993 | in a few lines of code. Please don't be offended if your request is
|
---|
994 | refused. Someone has to draw the line, and for ProjectBuilder::YAML that someone
|
---|
995 | is me.
|
---|
996 |
|
---|
997 | If you need something with more power move up to L<YAML> (7 megabytes of
|
---|
998 | memory overhead) or L<YAML::XS> (6 megabytes memory overhead and requires
|
---|
999 | a C compiler).
|
---|
1000 |
|
---|
1001 | To restate, L<ProjectBuilder::YAML> does B<not> preserve your comments, whitespace,
|
---|
1002 | or the order of your YAML data. But it should round-trip from Perl
|
---|
1003 | structure to file and back again just fine.
|
---|
1004 |
|
---|
1005 | =head1 METHODS
|
---|
1006 |
|
---|
1007 | =for Pod::Coverage HAVE_UTF8 refaddr
|
---|
1008 |
|
---|
1009 | =head2 new
|
---|
1010 |
|
---|
1011 | The constructor C<new> creates a C<ProjectBuilder::YAML> object as a blessed array
|
---|
1012 | reference. Any arguments provided are taken as separate documents
|
---|
1013 | to be serialized.
|
---|
1014 |
|
---|
1015 | =head2 read $filename
|
---|
1016 |
|
---|
1017 | The C<read> constructor reads a YAML file from a file name,
|
---|
1018 | and returns a new C<ProjectBuilder::YAML> object containing the parsed content.
|
---|
1019 |
|
---|
1020 | Returns the object on success or throws an error on failure.
|
---|
1021 |
|
---|
1022 | =head2 read_string $string;
|
---|
1023 |
|
---|
1024 | The C<read_string> constructor reads YAML data from a character string, and
|
---|
1025 | returns a new C<ProjectBuilder::YAML> object containing the parsed content. If you have
|
---|
1026 | read the string from a file yourself, be sure that you have correctly decoded
|
---|
1027 | it into characters first.
|
---|
1028 |
|
---|
1029 | Returns the object on success or throws an error on failure.
|
---|
1030 |
|
---|
1031 | =head2 write $filename
|
---|
1032 |
|
---|
1033 | The C<write> method generates the file content for the properties, and
|
---|
1034 | writes it to disk using UTF-8 encoding to the filename specified.
|
---|
1035 |
|
---|
1036 | Returns true on success or throws an error on failure.
|
---|
1037 |
|
---|
1038 | =head2 write_string
|
---|
1039 |
|
---|
1040 | Generates the file content for the object and returns it as a character
|
---|
1041 | string. This may contain non-ASCII characters and should be encoded
|
---|
1042 | before writing it to a file.
|
---|
1043 |
|
---|
1044 | Returns true on success or throws an error on failure.
|
---|
1045 |
|
---|
1046 | =for stopwords errstr
|
---|
1047 |
|
---|
1048 | =head2 errstr (DEPRECATED)
|
---|
1049 |
|
---|
1050 | Prior to version 1.57, some errors were fatal and others were available only
|
---|
1051 | via the C<$ProjectBuilder::YAML::errstr> variable, which could be accessed via the
|
---|
1052 | C<errstr()> method.
|
---|
1053 |
|
---|
1054 | Starting with version 1.57, all errors are fatal and throw exceptions.
|
---|
1055 |
|
---|
1056 | The C<$errstr> variable is still set when exceptions are thrown, but
|
---|
1057 | C<$errstr> and the C<errstr()> method are deprecated and may be removed in a
|
---|
1058 | future release. The first use of C<errstr()> will issue a deprecation
|
---|
1059 | warning.
|
---|
1060 |
|
---|
1061 | =head1 FUNCTIONS
|
---|
1062 |
|
---|
1063 | ProjectBuilder::YAML implements a number of functions to add compatibility with
|
---|
1064 | the L<YAML> API. These should be a drop-in replacement.
|
---|
1065 |
|
---|
1066 | =head2 pb_Dump
|
---|
1067 |
|
---|
1068 | my $string = pb_Dump(list-of-Perl-data-structures);
|
---|
1069 |
|
---|
1070 | Turn Perl data into YAML. This function works very much like
|
---|
1071 | Data::Dumper::Dumper().
|
---|
1072 |
|
---|
1073 | It takes a list of Perl data structures and dumps them into a serialized
|
---|
1074 | form.
|
---|
1075 |
|
---|
1076 | It returns a character string containing the YAML stream. Be sure to encode
|
---|
1077 | it as UTF-8 before serializing to a file or socket.
|
---|
1078 |
|
---|
1079 | The structures can be references or plain scalars.
|
---|
1080 |
|
---|
1081 | Dies on any error.
|
---|
1082 |
|
---|
1083 | =head2 pb_Load
|
---|
1084 |
|
---|
1085 | my @data_structures = pb_Load(string-containing-a-YAML-stream);
|
---|
1086 |
|
---|
1087 | Turn YAML into Perl data. This is the opposite of Dump.
|
---|
1088 |
|
---|
1089 | Just like L<Storable>'s thaw() function or the eval() function in relation
|
---|
1090 | to L<Data::Dumper>.
|
---|
1091 |
|
---|
1092 | It parses a character string containing a valid YAML stream into a list of
|
---|
1093 | Perl data structures representing the individual YAML documents. Be sure to
|
---|
1094 | decode the character string correctly if the string came from a file or
|
---|
1095 | socket.
|
---|
1096 |
|
---|
1097 | my $last_data_structure = pb_Load(string-containing-a-YAML-stream);
|
---|
1098 |
|
---|
1099 | For consistency with YAML.pm, when Load is called in scalar context, it
|
---|
1100 | returns the data structure corresponding to the last of the YAML documents
|
---|
1101 | found in the input stream.
|
---|
1102 |
|
---|
1103 | Dies on any error.
|
---|
1104 |
|
---|
1105 | =head2 freeze() and thaw()
|
---|
1106 |
|
---|
1107 | Aliases to pb_Dump() and pb_Load() for L<Storable> fans. This will also allow
|
---|
1108 | ProjectBuilder::YAML to be plugged directly into modules like POE.pm, that use the
|
---|
1109 | freeze/thaw API for internal serialization.
|
---|
1110 |
|
---|
1111 | =head2 pb_DumpFile(filepath, list)
|
---|
1112 |
|
---|
1113 | Writes the YAML stream to a file with UTF-8 encoding instead of just
|
---|
1114 | returning a string.
|
---|
1115 |
|
---|
1116 | Dies on any error.
|
---|
1117 |
|
---|
1118 | =head2 LoadFile(filepath)
|
---|
1119 |
|
---|
1120 | Reads the YAML stream from a UTF-8 encoded file instead of a string.
|
---|
1121 |
|
---|
1122 | Dies on any error.
|
---|
1123 |
|
---|
1124 | =head1 YAML TINY SPECIFICATION
|
---|
1125 |
|
---|
1126 | This section of the documentation provides a specification for "YAML Tiny",
|
---|
1127 | a subset of the YAML specification.
|
---|
1128 |
|
---|
1129 | It is based on and described comparatively to the YAML 1.1 Working Draft
|
---|
1130 | 2004-12-28 specification, located at L<http://yaml.org/spec/current.html>.
|
---|
1131 |
|
---|
1132 | Terminology and chapter numbers are based on that specification.
|
---|
1133 |
|
---|
1134 | =head2 1. Introduction and Goals
|
---|
1135 |
|
---|
1136 | The purpose of the YAML Tiny specification is to describe a useful subset
|
---|
1137 | of the YAML specification that can be used for typical document-oriented
|
---|
1138 | use cases such as configuration files and simple data structure dumps.
|
---|
1139 |
|
---|
1140 | =for stopwords extensibility
|
---|
1141 |
|
---|
1142 | Many specification elements that add flexibility or extensibility are
|
---|
1143 | intentionally removed, as is support for complex data structures, class
|
---|
1144 | and object-orientation.
|
---|
1145 |
|
---|
1146 | In general, the YAML Tiny language targets only those data structures
|
---|
1147 | available in JSON, with the additional limitation that only simple keys
|
---|
1148 | are supported.
|
---|
1149 |
|
---|
1150 | As a result, all possible YAML Tiny documents should be able to be
|
---|
1151 | transformed into an equivalent JSON document, although the reverse is
|
---|
1152 | not necessarily true (but will be true in simple cases).
|
---|
1153 |
|
---|
1154 | =for stopwords PCRE
|
---|
1155 |
|
---|
1156 | As a result of these simplifications the YAML Tiny specification should
|
---|
1157 | be implementable in a (relatively) small amount of code in any language
|
---|
1158 | that supports Perl Compatible Regular Expressions (PCRE).
|
---|
1159 |
|
---|
1160 | =head2 2. Introduction
|
---|
1161 |
|
---|
1162 | YAML Tiny supports three data structures. These are scalars (in a variety
|
---|
1163 | of forms), block-form sequences and block-form mappings. Flow-style
|
---|
1164 | sequences and mappings are not supported, with some minor exceptions
|
---|
1165 | detailed later.
|
---|
1166 |
|
---|
1167 | The use of three dashes "---" to indicate the start of a new document is
|
---|
1168 | supported, and multiple documents per file/stream is allowed.
|
---|
1169 |
|
---|
1170 | Both line and inline comments are supported.
|
---|
1171 |
|
---|
1172 | Scalars are supported via the plain style, single quote and double quote,
|
---|
1173 | as well as literal-style and folded-style multi-line scalars.
|
---|
1174 |
|
---|
1175 | The use of explicit tags is not supported.
|
---|
1176 |
|
---|
1177 | The use of "null" type scalars is supported via the ~ character.
|
---|
1178 |
|
---|
1179 | The use of "bool" type scalars is not supported.
|
---|
1180 |
|
---|
1181 | =for stopwords serializer
|
---|
1182 |
|
---|
1183 | However, serializer implementations should take care to explicitly escape
|
---|
1184 | strings that match a "bool" keyword in the following set to prevent other
|
---|
1185 | implementations that do support "bool" accidentally reading a string as a
|
---|
1186 | boolean
|
---|
1187 |
|
---|
1188 | y|Y|yes|Yes|YES|n|N|no|No|NO
|
---|
1189 | |true|True|TRUE|false|False|FALSE
|
---|
1190 | |on|On|ON|off|Off|OFF
|
---|
1191 |
|
---|
1192 | The use of anchors and aliases is not supported.
|
---|
1193 |
|
---|
1194 | The use of directives is supported only for the %YAML directive.
|
---|
1195 |
|
---|
1196 | =head2 3. Processing YAML Tiny Information
|
---|
1197 |
|
---|
1198 | B<Processes>
|
---|
1199 |
|
---|
1200 | =for stopwords deserialization
|
---|
1201 |
|
---|
1202 | The YAML specification dictates three-phase serialization and three-phase
|
---|
1203 | deserialization.
|
---|
1204 |
|
---|
1205 | The YAML Tiny specification does not mandate any particular methodology
|
---|
1206 | or mechanism for parsing.
|
---|
1207 |
|
---|
1208 | Any compliant parser is only required to parse a single document at a
|
---|
1209 | time. The ability to support streaming documents is optional and most
|
---|
1210 | likely non-typical.
|
---|
1211 |
|
---|
1212 | =for stopwords acyclic
|
---|
1213 |
|
---|
1214 | Because anchors and aliases are not supported, the resulting representation
|
---|
1215 | graph is thus directed but (unlike the main YAML specification) B<acyclic>.
|
---|
1216 |
|
---|
1217 | Circular references/pointers are not possible, and any YAML Tiny serializer
|
---|
1218 | detecting a circular reference should error with an appropriate message.
|
---|
1219 |
|
---|
1220 | B<Presentation Stream>
|
---|
1221 |
|
---|
1222 | =for stopwords unicode
|
---|
1223 |
|
---|
1224 | YAML Tiny reads and write UTF-8 encoded files. Operations on strings expect
|
---|
1225 | or produce Unicode characters not UTF-8 encoded bytes.
|
---|
1226 |
|
---|
1227 | B<Loading Failure Points>
|
---|
1228 |
|
---|
1229 | =for stopwords modality
|
---|
1230 |
|
---|
1231 | =for stopwords parsers
|
---|
1232 |
|
---|
1233 | YAML Tiny parsers and emitters are not expected to recover from, or
|
---|
1234 | adapt to, errors. The specific error modality of any implementation is
|
---|
1235 | not dictated (return codes, exceptions, etc.) but is expected to be
|
---|
1236 | consistent.
|
---|
1237 |
|
---|
1238 | =head2 4. Syntax
|
---|
1239 |
|
---|
1240 | B<Character Set>
|
---|
1241 |
|
---|
1242 | YAML Tiny streams are processed in memory as Unicode characters and
|
---|
1243 | read/written with UTF-8 encoding.
|
---|
1244 |
|
---|
1245 | The escaping and unescaping of the 8-bit YAML escapes is required.
|
---|
1246 |
|
---|
1247 | The escaping and unescaping of 16-bit and 32-bit YAML escapes is not
|
---|
1248 | required.
|
---|
1249 |
|
---|
1250 | B<Indicator Characters>
|
---|
1251 |
|
---|
1252 | Support for the "~" null/undefined indicator is required.
|
---|
1253 |
|
---|
1254 | Implementations may represent this as appropriate for the underlying
|
---|
1255 | language.
|
---|
1256 |
|
---|
1257 | Support for the "-" block sequence indicator is required.
|
---|
1258 |
|
---|
1259 | Support for the "?" mapping key indicator is B<not> required.
|
---|
1260 |
|
---|
1261 | Support for the ":" mapping value indicator is required.
|
---|
1262 |
|
---|
1263 | Support for the "," flow collection indicator is B<not> required.
|
---|
1264 |
|
---|
1265 | Support for the "[" flow sequence indicator is B<not> required, with
|
---|
1266 | one exception (detailed below).
|
---|
1267 |
|
---|
1268 | Support for the "]" flow sequence indicator is B<not> required, with
|
---|
1269 | one exception (detailed below).
|
---|
1270 |
|
---|
1271 | Support for the "{" flow mapping indicator is B<not> required, with
|
---|
1272 | one exception (detailed below).
|
---|
1273 |
|
---|
1274 | Support for the "}" flow mapping indicator is B<not> required, with
|
---|
1275 | one exception (detailed below).
|
---|
1276 |
|
---|
1277 | Support for the "#" comment indicator is required.
|
---|
1278 |
|
---|
1279 | Support for the "&" anchor indicator is B<not> required.
|
---|
1280 |
|
---|
1281 | Support for the "*" alias indicator is B<not> required.
|
---|
1282 |
|
---|
1283 | Support for the "!" tag indicator is B<not> required.
|
---|
1284 |
|
---|
1285 | Support for the "|" literal block indicator is required.
|
---|
1286 |
|
---|
1287 | Support for the ">" folded block indicator is required.
|
---|
1288 |
|
---|
1289 | Support for the "'" single quote indicator is required.
|
---|
1290 |
|
---|
1291 | Support for the """ double quote indicator is required.
|
---|
1292 |
|
---|
1293 | Support for the "%" directive indicator is required, but only
|
---|
1294 | for the special case of a %YAML version directive before the
|
---|
1295 | "---" document header, or on the same line as the document header.
|
---|
1296 |
|
---|
1297 | For example:
|
---|
1298 |
|
---|
1299 | %YAML 1.1
|
---|
1300 | ---
|
---|
1301 | - A sequence with a single element
|
---|
1302 |
|
---|
1303 | Special Exception:
|
---|
1304 |
|
---|
1305 | To provide the ability to support empty sequences
|
---|
1306 | and mappings, support for the constructs [] (empty sequence) and {}
|
---|
1307 | (empty mapping) are required.
|
---|
1308 |
|
---|
1309 | For example,
|
---|
1310 |
|
---|
1311 | %YAML 1.1
|
---|
1312 | # A document consisting of only an empty mapping
|
---|
1313 | --- {}
|
---|
1314 | # A document consisting of only an empty sequence
|
---|
1315 | --- []
|
---|
1316 | # A document consisting of an empty mapping within a sequence
|
---|
1317 | - foo
|
---|
1318 | - {}
|
---|
1319 | - bar
|
---|
1320 |
|
---|
1321 | B<Syntax Primitives>
|
---|
1322 |
|
---|
1323 | Other than the empty sequence and mapping cases described above, YAML Tiny
|
---|
1324 | supports only the indentation-based block-style group of contexts.
|
---|
1325 |
|
---|
1326 | All five scalar contexts are supported.
|
---|
1327 |
|
---|
1328 | Indentation spaces work as per the YAML specification in all cases.
|
---|
1329 |
|
---|
1330 | Comments work as per the YAML specification in all simple cases.
|
---|
1331 | Support for indented multi-line comments is B<not> required.
|
---|
1332 |
|
---|
1333 | Separation spaces work as per the YAML specification in all cases.
|
---|
1334 |
|
---|
1335 | B<YAML Tiny Character Stream>
|
---|
1336 |
|
---|
1337 | The only directive supported by the YAML Tiny specification is the
|
---|
1338 | %YAML language/version identifier. Although detected, this directive
|
---|
1339 | will have no control over the parsing itself.
|
---|
1340 |
|
---|
1341 | =for stopwords recognise
|
---|
1342 |
|
---|
1343 | The parser must recognise both the YAML 1.0 and YAML 1.1+ formatting
|
---|
1344 | of this directive (as well as the commented form, although no explicit
|
---|
1345 | code should be needed to deal with this case, being a comment anyway)
|
---|
1346 |
|
---|
1347 | That is, all of the following should be supported.
|
---|
1348 |
|
---|
1349 | --- #YAML:1.0
|
---|
1350 | - foo
|
---|
1351 |
|
---|
1352 | %YAML:1.0
|
---|
1353 | ---
|
---|
1354 | - foo
|
---|
1355 |
|
---|
1356 | % YAML 1.1
|
---|
1357 | ---
|
---|
1358 | - foo
|
---|
1359 |
|
---|
1360 | Support for the %TAG directive is B<not> required.
|
---|
1361 |
|
---|
1362 | Support for additional directives is B<not> required.
|
---|
1363 |
|
---|
1364 | Support for the document boundary marker "---" is required.
|
---|
1365 |
|
---|
1366 | Support for the document boundary market "..." is B<not> required.
|
---|
1367 |
|
---|
1368 | If necessary, a document boundary should simply by indicated with a
|
---|
1369 | "---" marker, with not preceding "..." marker.
|
---|
1370 |
|
---|
1371 | Support for empty streams (containing no documents) is required.
|
---|
1372 |
|
---|
1373 | Support for implicit document starts is required.
|
---|
1374 |
|
---|
1375 | That is, the following must be equivalent.
|
---|
1376 |
|
---|
1377 | # Full form
|
---|
1378 | %YAML 1.1
|
---|
1379 | ---
|
---|
1380 | foo: bar
|
---|
1381 |
|
---|
1382 | # Implicit form
|
---|
1383 | foo: bar
|
---|
1384 |
|
---|
1385 | B<Nodes>
|
---|
1386 |
|
---|
1387 | Support for nodes optional anchor and tag properties is B<not> required.
|
---|
1388 |
|
---|
1389 | Support for node anchors is B<not> required.
|
---|
1390 |
|
---|
1391 | Support for node tags is B<not> required.
|
---|
1392 |
|
---|
1393 | Support for alias nodes is B<not> required.
|
---|
1394 |
|
---|
1395 | Support for flow nodes is B<not> required.
|
---|
1396 |
|
---|
1397 | Support for block nodes is required.
|
---|
1398 |
|
---|
1399 | B<Scalar Styles>
|
---|
1400 |
|
---|
1401 | Support for all five scalar styles is required as per the YAML
|
---|
1402 | specification, although support for quoted scalars spanning more
|
---|
1403 | than one line is B<not> required.
|
---|
1404 |
|
---|
1405 | Support for multi-line scalar documents starting on the header
|
---|
1406 | is not required.
|
---|
1407 |
|
---|
1408 | Support for the chomping indicators on multi-line scalar styles
|
---|
1409 | is required.
|
---|
1410 |
|
---|
1411 | B<Collection Styles>
|
---|
1412 |
|
---|
1413 | Support for block-style sequences is required.
|
---|
1414 |
|
---|
1415 | Support for flow-style sequences is B<not> required.
|
---|
1416 |
|
---|
1417 | Support for block-style mappings is required.
|
---|
1418 |
|
---|
1419 | Support for flow-style mappings is B<not> required.
|
---|
1420 |
|
---|
1421 | Both sequences and mappings should be able to be arbitrarily
|
---|
1422 | nested.
|
---|
1423 |
|
---|
1424 | Support for plain-style mapping keys is required.
|
---|
1425 |
|
---|
1426 | Support for quoted keys in mappings is B<not> required.
|
---|
1427 |
|
---|
1428 | Support for "?"-indicated explicit keys is B<not> required.
|
---|
1429 |
|
---|
1430 | =for stopwords endeth
|
---|
1431 |
|
---|
1432 | Here endeth the specification.
|
---|
1433 |
|
---|
1434 | =head2 Additional Perl-Specific Notes
|
---|
1435 |
|
---|
1436 | For some Perl applications, it's important to know if you really have a
|
---|
1437 | number and not a string.
|
---|
1438 |
|
---|
1439 | That is, in some contexts is important that 3 the number is distinctive
|
---|
1440 | from "3" the string.
|
---|
1441 |
|
---|
1442 | Because even Perl itself is not trivially able to understand the difference
|
---|
1443 | (certainly without XS-based modules) Perl implementations of the YAML Tiny
|
---|
1444 | specification are not required to retain the distinctiveness of 3 vs "3".
|
---|
1445 |
|
---|
1446 | =head1 SUPPORT
|
---|
1447 |
|
---|
1448 | Bugs should be reported via the CPAN bug tracker at
|
---|
1449 |
|
---|
1450 | L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=YAML-Tiny>
|
---|
1451 |
|
---|
1452 | =begin html
|
---|
1453 |
|
---|
1454 | For other issues, or commercial enhancement or support, please contact
|
---|
1455 | <a href="http://ali.as/">Adam Kennedy</a> directly.
|
---|
1456 |
|
---|
1457 | =end html
|
---|
1458 |
|
---|
1459 | =head1 AUTHOR
|
---|
1460 |
|
---|
1461 | Adam Kennedy E<lt>adamk@cpan.orgE<gt>
|
---|
1462 |
|
---|
1463 | =head1 SEE ALSO
|
---|
1464 |
|
---|
1465 | =over 4
|
---|
1466 |
|
---|
1467 | =item * L<YAML>
|
---|
1468 |
|
---|
1469 | =item * L<YAML::Syck>
|
---|
1470 |
|
---|
1471 | =item * L<Config::Tiny>
|
---|
1472 |
|
---|
1473 | =item * L<CSS::Tiny>
|
---|
1474 |
|
---|
1475 | =item * L<http://use.perl.org/use.perl.org/_Alias/journal/29427.html>
|
---|
1476 |
|
---|
1477 | =item * L<http://ali.as/>
|
---|
1478 |
|
---|
1479 | =back
|
---|
1480 |
|
---|
1481 | =head1 COPYRIGHT
|
---|
1482 |
|
---|
1483 | Copyright 2006 - 2013 Adam Kennedy.
|
---|
1484 |
|
---|
1485 | This program is free software; you can redistribute
|
---|
1486 | it and/or modify it under the same terms as Perl itself.
|
---|
1487 |
|
---|
1488 | The full text of the license can be found in the
|
---|
1489 | LICENSE file included with this module.
|
---|
1490 |
|
---|
1491 | =cut
|
---|