"Fossies" - the Fresh Open Source Software Archive 
Member "RT-Extension-Assets-1.05/inc/YAML/Tiny.pm" (6 May 2015, 24978 Bytes) of package /linux/misc/RT-Extension-Assets-1.05.tar.gz:
As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Perl source code syntax highlighting (style:
standard) with prefixed line numbers and
code folding option.
Alternatively you can here
view or
download the uninterpreted source code file.
For more information about "Tiny.pm" see the
Fossies "Dox" file reference documentation and the last
Fossies "Diffs" side-by-side code changes report:
1.02_vs_1.04.
1 #line 1
2 use 5.008001; # sane UTF-8 support
3 use strict;
4 use warnings;
5 package YAML::Tiny;
6 # git description: v1.63-12-g5dd832a
7 $YAML::Tiny::VERSION = '1.64';
8 # XXX-INGY is 5.8.1 too old/broken for utf8?
9 # XXX-XDG Lancaster consensus was that it was sufficient until
10 # proven otherwise
11
12
13 #####################################################################
14 # The YAML::Tiny API.
15 #
16 # These are the currently documented API functions/methods and
17 # exports:
18
19 use Exporter;
20 our @ISA = qw{ Exporter };
21 our @EXPORT = qw{ Load Dump };
22 our @EXPORT_OK = qw{ LoadFile DumpFile freeze thaw };
23
24 ###
25 # Functional/Export API:
26
27 sub Dump {
28 return YAML::Tiny->new(@_)->_dump_string;
29 }
30
31 # XXX-INGY Returning last document seems a bad behavior.
32 # XXX-XDG I think first would seem more natural, but I don't know
33 # that it's worth changing now
34 sub Load {
35 my $self = YAML::Tiny->_load_string(@_);
36 if ( wantarray ) {
37 return @$self;
38 } else {
39 # To match YAML.pm, return the last document
40 return $self->[-1];
41 }
42 }
43
44 # XXX-INGY Do we really need freeze and thaw?
45 # XXX-XDG I don't think so. I'd support deprecating them.
46 BEGIN {
47 *freeze = \&Dump;
48 *thaw = \&Load;
49 }
50
51 sub DumpFile {
52 my $file = shift;
53 return YAML::Tiny->new(@_)->_dump_file($file);
54 }
55
56 sub LoadFile {
57 my $file = shift;
58 my $self = YAML::Tiny->_load_file($file);
59 if ( wantarray ) {
60 return @$self;
61 } else {
62 # Return only the last document to match YAML.pm,
63 return $self->[-1];
64 }
65 }
66
67
68 ###
69 # Object Oriented API:
70
71 # Create an empty YAML::Tiny object
72 # XXX-INGY Why do we use ARRAY object?
73 # NOTE: I get it now, but I think it's confusing and not needed.
74 # Will change it on a branch later, for review.
75 #
76 # XXX-XDG I don't support changing it yet. It's a very well-documented
77 # "API" of YAML::Tiny. I'd support deprecating it, but Adam suggested
78 # we not change it until YAML.pm's own OO API is established so that
79 # users only have one API change to digest, not two
80 sub new {
81 my $class = shift;
82 bless [ @_ ], $class;
83 }
84
85 # XXX-INGY It probably doesn't matter, and it's probably too late to
86 # change, but 'read/write' are the wrong names. Read and Write
87 # are actions that take data from storage to memory
88 # characters/strings. These take the data to/from storage to native
89 # Perl objects, which the terms dump and load are meant. As long as
90 # this is a legacy quirk to YAML::Tiny it's ok, but I'd prefer not
91 # to add new {read,write}_* methods to this API.
92
93 sub read_string {
94 my $self = shift;
95 $self->_load_string(@_);
96 }
97
98 sub write_string {
99 my $self = shift;
100 $self->_dump_string(@_);
101 }
102
103 sub read {
104 my $self = shift;
105 $self->_load_file(@_);
106 }
107
108 sub write {
109 my $self = shift;
110 $self->_dump_file(@_);
111 }
112
113
114
115
116 #####################################################################
117 # Constants
118
119 # Printed form of the unprintable characters in the lowest range
120 # of ASCII characters, listed by ASCII ordinal position.
121 my @UNPRINTABLE = qw(
122 0 x01 x02 x03 x04 x05 x06 a
123 b t n v f r x0E x0F
124 x10 x11 x12 x13 x14 x15 x16 x17
125 x18 x19 x1A e x1C x1D x1E x1F
126 );
127
128 # Printable characters for escapes
129 my %UNESCAPES = (
130 0 => "\x00", z => "\x00", N => "\x85",
131 a => "\x07", b => "\x08", t => "\x09",
132 n => "\x0a", v => "\x0b", f => "\x0c",
133 r => "\x0d", e => "\x1b", '\\' => '\\',
134 );
135
136 # XXX-INGY
137 # I(ngy) need to decide if these values should be quoted in
138 # YAML::Tiny or not. Probably yes.
139
140 # These 3 values have special meaning when unquoted and using the
141 # default YAML schema. They need quotes if they are strings.
142 my %QUOTE = map { $_ => 1 } qw{
143 null true false
144 };
145
146 # The commented out form is simpler, but overloaded the Perl regex
147 # engine due to recursion and backtracking problems on strings
148 # larger than 32,000ish characters. Keep it for reference purposes.
149 # qr/\"((?:\\.|[^\"])*)\"/
150 my $re_capture_double_quoted = qr/\"([^\\"]*(?:\\.[^\\"]*)*)\"/;
151 my $re_capture_single_quoted = qr/\'([^\']*(?:\'\'[^\']*)*)\'/;
152 # unquoted re gets trailing space that needs to be stripped
153 my $re_capture_unquoted_key = qr/([^:]+(?::+\S(?:[^:]*|.*?(?=:)))*)(?=\s*\:(?:\s+|$))/;
154 my $re_trailing_comment = qr/(?:\s+\#.*)?/;
155 my $re_key_value_separator = qr/\s*:(?:\s+(?:\#.*)?|$)/;
156
157
158
159
160
161 #####################################################################
162 # YAML::Tiny Implementation.
163 #
164 # These are the private methods that do all the work. They may change
165 # at any time.
166
167
168 ###
169 # Loader functions:
170
171 # Create an object from a file
172 sub _load_file {
173 my $class = ref $_[0] ? ref shift : shift;
174
175 # Check the file
176 my $file = shift or $class->_error( 'You did not specify a file name' );
177 $class->_error( "File '$file' does not exist" )
178 unless -e $file;
179 $class->_error( "'$file' is a directory, not a file" )
180 unless -f _;
181 $class->_error( "Insufficient permissions to read '$file'" )
182 unless -r _;
183
184 # Open unbuffered with strict UTF-8 decoding and no translation layers
185 open( my $fh, "<:unix:encoding(UTF-8)", $file );
186 unless ( $fh ) {
187 $class->_error("Failed to open file '$file': $!");
188 }
189
190 # flock if available (or warn if not possible for OS-specific reasons)
191 if ( _can_flock() ) {
192 flock( $fh, Fcntl::LOCK_SH() )
193 or warn "Couldn't lock '$file' for reading: $!";
194 }
195
196 # slurp the contents
197 my $contents = eval {
198 use warnings FATAL => 'utf8';
199 local $/;
200 <$fh>
201 };
202 if ( my $err = $@ ) {
203 $class->_error("Error reading from file '$file': $err");
204 }
205
206 # close the file (release the lock)
207 unless ( close $fh ) {
208 $class->_error("Failed to close file '$file': $!");
209 }
210
211 $class->_load_string( $contents );
212 }
213
214 # Create an object from a string
215 sub _load_string {
216 my $class = ref $_[0] ? ref shift : shift;
217 my $self = bless [], $class;
218 my $string = $_[0];
219 eval {
220 unless ( defined $string ) {
221 die \"Did not provide a string to load";
222 }
223
224 # Check if Perl has it marked as characters, but it's internally
225 # inconsistent. E.g. maybe latin1 got read on a :utf8 layer
226 if ( utf8::is_utf8($string) && ! utf8::valid($string) ) {
227 die \<<'...';
228 Read an invalid UTF-8 string (maybe mixed UTF-8 and 8-bit character set).
229 Did you decode with lax ":utf8" instead of strict ":encoding(UTF-8)"?
230 ...
231 }
232
233 # Ensure Unicode character semantics, even for 0x80-0xff
234 utf8::upgrade($string);
235
236 # Check for and strip any leading UTF-8 BOM
237 $string =~ s/^\x{FEFF}//;
238
239 # Check for some special cases
240 return $self unless length $string;
241
242 # Split the file into lines
243 my @lines = grep { ! /^\s*(?:\#.*)?\z/ }
244 split /(?:\015{1,2}\012|\015|\012)/, $string;
245
246 # Strip the initial YAML header
247 @lines and $lines[0] =~ /^\%YAML[: ][\d\.]+.*\z/ and shift @lines;
248
249 # A nibbling parser
250 my $in_document = 0;
251 while ( @lines ) {
252 # Do we have a document header?
253 if ( $lines[0] =~ /^---\s*(?:(.+)\s*)?\z/ ) {
254 # Handle scalar documents
255 shift @lines;
256 if ( defined $1 and $1 !~ /^(?:\#.+|\%YAML[: ][\d\.]+)\z/ ) {
257 push @$self,
258 $self->_load_scalar( "$1", [ undef ], \@lines );
259 next;
260 }
261 $in_document = 1;
262 }
263
264 if ( ! @lines or $lines[0] =~ /^(?:---|\.\.\.)/ ) {
265 # A naked document
266 push @$self, undef;
267 while ( @lines and $lines[0] !~ /^---/ ) {
268 shift @lines;
269 }
270 $in_document = 0;
271
272 # XXX The final '-+$' is to look for -- which ends up being an
273 # error later.
274 } elsif ( ! $in_document && @$self ) {
275 # only the first document can be explicit
276 die \"YAML::Tiny failed to classify the line '$lines[0]'";
277 } elsif ( $lines[0] =~ /^\s*\-(?:\s|$|-+$)/ ) {
278 # An array at the root
279 my $document = [ ];
280 push @$self, $document;
281 $self->_load_array( $document, [ 0 ], \@lines );
282
283 } elsif ( $lines[0] =~ /^(\s*)\S/ ) {
284 # A hash at the root
285 my $document = { };
286 push @$self, $document;
287 $self->_load_hash( $document, [ length($1) ], \@lines );
288
289 } else {
290 # Shouldn't get here. @lines have whitespace-only lines
291 # stripped, and previous match is a line with any
292 # non-whitespace. So this clause should only be reachable via
293 # a perlbug where \s is not symmetric with \S
294
295 # uncoverable statement
296 die \"YAML::Tiny failed to classify the line '$lines[0]'";
297 }
298 }
299 };
300 my $err = $@;
301 if ( ref $err eq 'SCALAR' ) {
302 $self->_error(${$err});
303 } elsif ( $err ) {
304 $self->_error($err);
305 }
306
307 return $self;
308 }
309
310 sub _unquote_single {
311 my ($self, $string) = @_;
312 return '' unless length $string;
313 $string =~ s/\'\'/\'/g;
314 return $string;
315 }
316
317 sub _unquote_double {
318 my ($self, $string) = @_;
319 return '' unless length $string;
320 $string =~ s/\\"/"/g;
321 $string =~
322 s{\\([Nnever\\fartz0b]|x([0-9a-fA-F]{2}))}
323 {(length($1)>1)?pack("H2",$2):$UNESCAPES{$1}}gex;
324 return $string;
325 }
326
327 # Load a YAML scalar string to the actual Perl scalar
328 sub _load_scalar {
329 my ($self, $string, $indent, $lines) = @_;
330
331 # Trim trailing whitespace
332 $string =~ s/\s*\z//;
333
334 # Explitic null/undef
335 return undef if $string eq '~';
336
337 # Single quote
338 if ( $string =~ /^$re_capture_single_quoted$re_trailing_comment\z/ ) {
339 return $self->_unquote_single($1);
340 }
341
342 # Double quote.
343 if ( $string =~ /^$re_capture_double_quoted$re_trailing_comment\z/ ) {
344 return $self->_unquote_double($1);
345 }
346
347 # Special cases
348 if ( $string =~ /^[\'\"!&]/ ) {
349 die \"YAML::Tiny does not support a feature in line '$string'";
350 }
351 return {} if $string =~ /^{}(?:\s+\#.*)?\z/;
352 return [] if $string =~ /^\[\](?:\s+\#.*)?\z/;
353
354 # Regular unquoted string
355 if ( $string !~ /^[>|]/ ) {
356 die \"YAML::Tiny found illegal characters in plain scalar: '$string'"
357 if $string =~ /^(?:-(?:\s|$)|[\@\%\`])/ or
358 $string =~ /:(?:\s|$)/;
359 $string =~ s/\s+#.*\z//;
360 return $string;
361 }
362
363 # Error
364 die \"YAML::Tiny failed to find multi-line scalar content" unless @$lines;
365
366 # Check the indent depth
367 $lines->[0] =~ /^(\s*)/;
368 $indent->[-1] = length("$1");
369 if ( defined $indent->[-2] and $indent->[-1] <= $indent->[-2] ) {
370 die \"YAML::Tiny found bad indenting in line '$lines->[0]'";
371 }
372
373 # Pull the lines
374 my @multiline = ();
375 while ( @$lines ) {
376 $lines->[0] =~ /^(\s*)/;
377 last unless length($1) >= $indent->[-1];
378 push @multiline, substr(shift(@$lines), length($1));
379 }
380
381 my $j = (substr($string, 0, 1) eq '>') ? ' ' : "\n";
382 my $t = (substr($string, 1, 1) eq '-') ? '' : "\n";
383 return join( $j, @multiline ) . $t;
384 }
385
386 # Load an array
387 sub _load_array {
388 my ($self, $array, $indent, $lines) = @_;
389
390 while ( @$lines ) {
391 # Check for a new document
392 if ( $lines->[0] =~ /^(?:---|\.\.\.)/ ) {
393 while ( @$lines and $lines->[0] !~ /^---/ ) {
394 shift @$lines;
395 }
396 return 1;
397 }
398
399 # Check the indent level
400 $lines->[0] =~ /^(\s*)/;
401 if ( length($1) < $indent->[-1] ) {
402 return 1;
403 } elsif ( length($1) > $indent->[-1] ) {
404 die \"YAML::Tiny found bad indenting in line '$lines->[0]'";
405 }
406
407 if ( $lines->[0] =~ /^(\s*\-\s+)[^\'\"]\S*\s*:(?:\s+|$)/ ) {
408 # Inline nested hash
409 my $indent2 = length("$1");
410 $lines->[0] =~ s/-/ /;
411 push @$array, { };
412 $self->_load_hash( $array->[-1], [ @$indent, $indent2 ], $lines );
413
414 } elsif ( $lines->[0] =~ /^\s*\-\s*\z/ ) {
415 shift @$lines;
416 unless ( @$lines ) {
417 push @$array, undef;
418 return 1;
419 }
420 if ( $lines->[0] =~ /^(\s*)\-/ ) {
421 my $indent2 = length("$1");
422 if ( $indent->[-1] == $indent2 ) {
423 # Null array entry
424 push @$array, undef;
425 } else {
426 # Naked indenter
427 push @$array, [ ];
428 $self->_load_array(
429 $array->[-1], [ @$indent, $indent2 ], $lines
430 );
431 }
432
433 } elsif ( $lines->[0] =~ /^(\s*)\S/ ) {
434 push @$array, { };
435 $self->_load_hash(
436 $array->[-1], [ @$indent, length("$1") ], $lines
437 );
438
439 } else {
440 die \"YAML::Tiny failed to classify line '$lines->[0]'";
441 }
442
443 } elsif ( $lines->[0] =~ /^\s*\-(\s*)(.+?)\s*\z/ ) {
444 # Array entry with a value
445 shift @$lines;
446 push @$array, $self->_load_scalar(
447 "$2", [ @$indent, undef ], $lines
448 );
449
450 } elsif ( defined $indent->[-2] and $indent->[-1] == $indent->[-2] ) {
451 # This is probably a structure like the following...
452 # ---
453 # foo:
454 # - list
455 # bar: value
456 #
457 # ... so lets return and let the hash parser handle it
458 return 1;
459
460 } else {
461 die \"YAML::Tiny failed to classify line '$lines->[0]'";
462 }
463 }
464
465 return 1;
466 }
467
468 # Load a hash
469 sub _load_hash {
470 my ($self, $hash, $indent, $lines) = @_;
471
472 while ( @$lines ) {
473 # Check for a new document
474 if ( $lines->[0] =~ /^(?:---|\.\.\.)/ ) {
475 while ( @$lines and $lines->[0] !~ /^---/ ) {
476 shift @$lines;
477 }
478 return 1;
479 }
480
481 # Check the indent level
482 $lines->[0] =~ /^(\s*)/;
483 if ( length($1) < $indent->[-1] ) {
484 return 1;
485 } elsif ( length($1) > $indent->[-1] ) {
486 die \"YAML::Tiny found bad indenting in line '$lines->[0]'";
487 }
488
489 # Find the key
490 my $key;
491
492 # Quoted keys
493 if ( $lines->[0] =~
494 s/^\s*$re_capture_single_quoted$re_key_value_separator//
495 ) {
496 $key = $self->_unquote_single($1);
497 }
498 elsif ( $lines->[0] =~
499 s/^\s*$re_capture_double_quoted$re_key_value_separator//
500 ) {
501 $key = $self->_unquote_double($1);
502 }
503 elsif ( $lines->[0] =~
504 s/^\s*$re_capture_unquoted_key$re_key_value_separator//
505 ) {
506 $key = $1;
507 $key =~ s/\s+$//;
508 }
509 elsif ( $lines->[0] =~ /^\s*\?/ ) {
510 die \"YAML::Tiny does not support a feature in line '$lines->[0]'";
511 }
512 else {
513 die \"YAML::Tiny failed to classify line '$lines->[0]'";
514 }
515
516 if ( exists $hash->{$key} ) {
517 die \"YAML::Tiny found a duplicate key '$key' in line '$lines->[0]'";
518 }
519
520 # Do we have a value?
521 if ( length $lines->[0] ) {
522 # Yes
523 $hash->{$key} = $self->_load_scalar(
524 shift(@$lines), [ @$indent, undef ], $lines
525 );
526 } else {
527 # An indent
528 shift @$lines;
529 unless ( @$lines ) {
530 $hash->{$key} = undef;
531 return 1;
532 }
533 if ( $lines->[0] =~ /^(\s*)-/ ) {
534 $hash->{$key} = [];
535 $self->_load_array(
536 $hash->{$key}, [ @$indent, length($1) ], $lines
537 );
538 } elsif ( $lines->[0] =~ /^(\s*)./ ) {
539 my $indent2 = length("$1");
540 if ( $indent->[-1] >= $indent2 ) {
541 # Null hash entry
542 $hash->{$key} = undef;
543 } else {
544 $hash->{$key} = {};
545 $self->_load_hash(
546 $hash->{$key}, [ @$indent, length($1) ], $lines
547 );
548 }
549 }
550 }
551 }
552
553 return 1;
554 }
555
556
557 ###
558 # Dumper functions:
559
560 # Save an object to a file
561 sub _dump_file {
562 my $self = shift;
563
564 require Fcntl;
565
566 # Check the file
567 my $file = shift or $self->_error( 'You did not specify a file name' );
568
569 my $fh;
570 # flock if available (or warn if not possible for OS-specific reasons)
571 if ( _can_flock() ) {
572 # Open without truncation (truncate comes after lock)
573 my $flags = Fcntl::O_WRONLY()|Fcntl::O_CREAT();
574 sysopen( $fh, $file, $flags );
575 unless ( $fh ) {
576 $self->_error("Failed to open file '$file' for writing: $!");
577 }
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 \"YAML::Tiny 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 \"YAML::Tiny 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 \"YAML::Tiny 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 \"YAML::Tiny 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( "YAML::Tiny->errstr and \$YAML::Tiny::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 YAML::Tiny'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 $YAML::Tiny::{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 #line 1490