Revision f1bfb69b
Von Moritz Bunkus vor mehr als 13 Jahren hinzugefügt
| modules/override/YAML/Loader.pm | ||
|---|---|---|
| 13 | 13 |
# Common YAML character sets |
| 14 | 14 |
my $ESCAPE_CHAR = '[\\x00-\\x08\\x0b-\\x0d\\x0e-\\x1f]'; |
| 15 | 15 |
my $FOLD_CHAR = '>'; |
| 16 |
my $LIT_CHAR = '|';
|
|
| 17 |
my $LIT_CHAR_RX = "\\$LIT_CHAR";
|
|
| 16 |
my $LIT_CHAR = '|'; |
|
| 17 |
my $LIT_CHAR_RX = "\\$LIT_CHAR"; |
|
| 18 | 18 |
|
| 19 | 19 |
sub load {
|
| 20 | 20 |
my $self = shift; |
| ... | ... | |
| 30 | 30 |
$self->{stream} =~ s|\015\012|\012|g;
|
| 31 | 31 |
$self->{stream} =~ s|\015|\012|g;
|
| 32 | 32 |
$self->line(0); |
| 33 |
$self->die('YAML_PARSE_ERR_BAD_CHARS')
|
|
| 33 |
$self->die('YAML_PARSE_ERR_BAD_CHARS')
|
|
| 34 | 34 |
if $self->stream =~ /$ESCAPE_CHAR/; |
| 35 |
$self->die('YAML_PARSE_ERR_NO_FINAL_NEWLINE')
|
|
| 36 |
if length($self->stream) and |
|
| 35 |
# $self->die('YAML_PARSE_ERR_NO_FINAL_NEWLINE')
|
|
| 36 |
$self->{stream} .= "\n"
|
|
| 37 |
if length($self->stream) and |
|
| 37 | 38 |
$self->{stream} !~ s/(.)\n\Z/$1/s;
|
| 38 | 39 |
$self->lines([split /\x0a/, $self->stream, -1]); |
| 39 | 40 |
$self->line(1); |
| ... | ... | |
| 88 | 89 |
|
| 89 | 90 |
$directives{YAML} ||= '1.0';
|
| 90 | 91 |
$directives{TAB} ||= 'NONE';
|
| 91 |
($self->{major_version}, $self->{minor_version}) =
|
|
| 92 |
($self->{major_version}, $self->{minor_version}) =
|
|
| 92 | 93 |
split /\./, $directives{YAML}, 2;
|
| 93 | 94 |
$self->die('YAML_PARSE_ERR_BAD_MAJOR_VERSION', $directives{YAML})
|
| 94 | 95 |
if $self->major_version ne '1'; |
| ... | ... | |
| 111 | 112 |
$self->preface('');
|
| 112 | 113 |
my ($node, $type, $indicator, $escape, $chomp) = ('') x 5;
|
| 113 | 114 |
my ($anchor, $alias, $explicit, $implicit, $class) = ('') x 5;
|
| 114 |
($anchor, $alias, $explicit, $implicit, $preface) =
|
|
| 115 |
($anchor, $alias, $explicit, $implicit, $preface) = |
|
| 115 | 116 |
$self->_parse_qualifiers($preface); |
| 116 | 117 |
if ($anchor) {
|
| 117 | 118 |
$self->anchor2node->{$anchor} = CORE::bless [], 'YAML-anchor2node';
|
| ... | ... | |
| 119 | 120 |
$self->inline('');
|
| 120 | 121 |
while (length $preface) {
|
| 121 | 122 |
my $line = $self->line - 1; |
| 122 |
if ($preface =~ s/^($FOLD_CHAR|$LIT_CHAR_RX)(-|\+)?\d*\s*//) {
|
|
| 123 |
if ($preface =~ s/^($FOLD_CHAR|$LIT_CHAR_RX)(-|\+)?\d*\s*//) {
|
|
| 123 | 124 |
$indicator = $1; |
| 124 | 125 |
$chomp = $2 if defined($2); |
| 125 | 126 |
} |
| ... | ... | |
| 137 | 138 |
} |
| 138 | 139 |
else {
|
| 139 | 140 |
$node = do {my $sv = "*$alias"};
|
| 140 |
push @{$self->anchor2node->{$alias}}, [\$node, $self->line];
|
|
| 141 |
push @{$self->anchor2node->{$alias}}, [\$node, $self->line];
|
|
| 141 | 142 |
} |
| 142 | 143 |
} |
| 143 | 144 |
elsif (length $self->inline) {
|
| 144 | 145 |
$node = $self->_parse_inline(1, $implicit, $explicit); |
| 145 | 146 |
if (length $self->inline) {
|
| 146 |
$self->die('YAML_PARSE_ERR_SINGLE_LINE');
|
|
| 147 |
$self->die('YAML_PARSE_ERR_SINGLE_LINE');
|
|
| 147 | 148 |
} |
| 148 | 149 |
} |
| 149 | 150 |
elsif ($indicator eq $LIT_CHAR) {
|
| 150 | 151 |
$self->{level}++;
|
| 151 | 152 |
$node = $self->_parse_block($chomp); |
| 152 | 153 |
$node = $self->_parse_implicit($node) if $implicit; |
| 153 |
$self->{level}--;
|
|
| 154 |
$self->{level}--;
|
|
| 154 | 155 |
} |
| 155 | 156 |
elsif ($indicator eq $FOLD_CHAR) {
|
| 156 | 157 |
$self->{level}++;
|
| ... | ... | |
| 227 | 228 |
} |
| 228 | 229 |
elsif ($preface =~ s/^\&([^ ,:]+)\s*//) {
|
| 229 | 230 |
$token = $1; |
| 230 |
$self->die('YAML_PARSE_ERR_BAD_ANCHOR')
|
|
| 231 |
$self->die('YAML_PARSE_ERR_BAD_ANCHOR')
|
|
| 231 | 232 |
unless $token =~ /^[a-zA-Z0-9]+$/; |
| 232 | 233 |
$self->die('YAML_PARSE_ERR_MANY_ANCHOR') if $anchor;
|
| 233 | 234 |
$self->die('YAML_PARSE_ERR_ANCHOR_ALIAS') if $alias;
|
| ... | ... | |
| 242 | 243 |
$alias = $token; |
| 243 | 244 |
} |
| 244 | 245 |
} |
| 245 |
return ($anchor, $alias, $explicit, $implicit, $preface);
|
|
| 246 |
return ($anchor, $alias, $explicit, $implicit, $preface); |
|
| 246 | 247 |
} |
| 247 | 248 |
|
| 248 |
# Morph a node to it's explicit type
|
|
| 249 |
# Morph a node to it's explicit type |
|
| 249 | 250 |
sub _parse_explicit {
|
| 250 | 251 |
my $self = shift; |
| 251 | 252 |
my ($node, $explicit) = @_; |
| ... | ... | |
| 315 | 316 |
$key = $self->_parse_node(); |
| 316 | 317 |
$key = "$key"; |
| 317 | 318 |
} |
| 318 |
# If "default" key (equals sign)
|
|
| 319 |
# If "default" key (equals sign) |
|
| 319 | 320 |
elsif ($self->{content} =~ s/^\=\s*//) {
|
| 320 | 321 |
$key = VALUE; |
| 321 | 322 |
} |
| ... | ... | |
| 331 | 332 |
$self->content($self->inline); |
| 332 | 333 |
$self->inline('');
|
| 333 | 334 |
} |
| 334 |
|
|
| 335 |
|
|
| 335 | 336 |
unless ($self->{content} =~ s/^:\s*//) {
|
| 336 | 337 |
$self->die('YAML_LOAD_ERR_BAD_MAP_ELEMENT');
|
| 337 | 338 |
} |
| ... | ... | |
| 387 | 388 |
my ($top, $top_implicit, $top_explicit) = (@_, '', '', ''); |
| 388 | 389 |
$self->{inline} =~ s/^\s*(.*)\s*$/$1/; # OUCH - mugwump
|
| 389 | 390 |
my ($node, $anchor, $alias, $explicit, $implicit) = ('') x 5;
|
| 390 |
($anchor, $alias, $explicit, $implicit, $self->{inline}) =
|
|
| 391 |
($anchor, $alias, $explicit, $implicit, $self->{inline}) =
|
|
| 391 | 392 |
$self->_parse_qualifiers($self->inline); |
| 392 | 393 |
if ($anchor) {
|
| 393 | 394 |
$self->anchor2node->{$anchor} = CORE::bless [], 'YAML-anchor2node';
|
| ... | ... | |
| 403 | 404 |
} |
| 404 | 405 |
else {
|
| 405 | 406 |
$node = do {my $sv = "*$alias"};
|
| 406 |
push @{$self->anchor2node->{$alias}}, [\$node, $self->line];
|
|
| 407 |
push @{$self->anchor2node->{$alias}}, [\$node, $self->line];
|
|
| 407 | 408 |
} |
| 408 | 409 |
} |
| 409 | 410 |
elsif ($self->inline =~ /^\{/) {
|
| ... | ... | |
| 487 | 488 |
my $value = $self->_parse_inline(); |
| 488 | 489 |
push @$node, $value; |
| 489 | 490 |
next if $self->inline =~ /^\s*\]/; |
| 490 |
$self->die('YAML_PARSE_ERR_INLINE_SEQUENCE')
|
|
| 491 |
$self->die('YAML_PARSE_ERR_INLINE_SEQUENCE')
|
|
| 491 | 492 |
unless $self->{inline} =~ s/^\,\s*//;
|
| 492 | 493 |
} |
| 493 | 494 |
return $node; |
| ... | ... | |
| 604 | 605 |
# 3) Find the next _content_ line |
| 605 | 606 |
# A) Skip over any throwaways (Comments/blanks) |
| 606 | 607 |
# B) Set $self->indent, $self->content, $self->line |
| 607 |
# 4) Expand tabs appropriately
|
|
| 608 |
# 4) Expand tabs appropriately |
|
| 608 | 609 |
sub _parse_next_line {
|
| 609 | 610 |
my $self = shift; |
| 610 | 611 |
my ($type) = @_; |
| ... | ... | |
| 646 | 647 |
$offset = $self->offset->[++$level]; |
| 647 | 648 |
} |
| 648 | 649 |
# Determine the offset for a new collection level |
| 649 |
elsif ($type == COLLECTION and
|
|
| 650 |
elsif ($type == COLLECTION and |
|
| 650 | 651 |
$self->preface =~ /^(\s*(\!\S*|\&\S+))*\s*$/) {
|
| 651 | 652 |
$self->_parse_throwaway_comments(); |
| 652 | 653 |
if ($self->eos) {
|
| ... | ... | |
| 664 | 665 |
} |
| 665 | 666 |
$offset = $self->offset->[++$level]; |
| 666 | 667 |
} |
| 667 |
|
|
| 668 |
|
|
| 668 | 669 |
if ($type == LEAF) {
|
| 669 | 670 |
while (@{$self->lines} and
|
| 670 | 671 |
$self->lines->[0] =~ m{^( *)(\#)} and
|
| ... | ... | |
| 678 | 679 |
else {
|
| 679 | 680 |
$self->_parse_throwaway_comments(); |
| 680 | 681 |
} |
| 681 |
return if $self->eos;
|
|
| 682 |
|
|
| 682 |
return if $self->eos; |
|
| 683 |
|
|
| 683 | 684 |
if ($self->lines->[0] =~ /^---(\s|$)/) {
|
| 684 | 685 |
$self->done(1); |
| 685 | 686 |
return; |
| 686 | 687 |
} |
| 687 |
if ($type == LEAF and
|
|
| 688 |
if ($type == LEAF and |
|
| 688 | 689 |
$self->lines->[0] =~ /^ {$offset}(.*)$/
|
| 689 | 690 |
) {
|
| 690 | 691 |
$self->indent($offset); |
| ... | ... | |
| 699 | 700 |
while ($self->offset->[$level] > length($1)) {
|
| 700 | 701 |
$level--; |
| 701 | 702 |
} |
| 702 |
$self->die('YAML_PARSE_ERR_INCONSISTENT_INDENTATION')
|
|
| 703 |
$self->die('YAML_PARSE_ERR_INCONSISTENT_INDENTATION')
|
|
| 703 | 704 |
if $self->offset->[$level] != length($1); |
| 704 | 705 |
$self->indent(length($1)); |
| 705 | 706 |
$self->content($2); |
| ... | ... | |
| 713 | 714 |
#============================================================================== |
| 714 | 715 |
|
| 715 | 716 |
# Printable characters for escapes |
| 716 |
my %unescapes =
|
|
| 717 |
my %unescapes = |
|
| 717 | 718 |
( |
| 718 | 719 |
z => "\x00", a => "\x07", t => "\x09", |
| 719 | 720 |
n => "\x0a", v => "\x0b", f => "\x0c", |
| 720 | 721 |
r => "\x0d", e => "\x1b", '\\' => '\\', |
| 721 | 722 |
); |
| 722 |
|
|
| 723 |
|
|
| 723 | 724 |
# Transform all the backslash style escape characters to their literal meaning |
| 724 | 725 |
sub _unescape {
|
| 725 | 726 |
my $self = shift; |
Auch abrufbar als: Unified diff
Bei fehlendem Newline an YAML-Code nicht meckern
Google Chrome scheint Newlines am Ende von Variablen unter bestimmten
Umständen zu entfernen. Diese zu ergänzen ist trivial; da muss das
YAML-Modul keine Fehler melden.