Permalink
Browse files

More porting.

  • Loading branch information...
1 parent 84f934e commit 73514c82fe57a2e355623e800df7027ecdd202a1 @bacek bacek committed Jan 29, 2011
Showing with 255 additions and 45 deletions.
  1. +255 −45 lib/YAML/Tiny.pm
View
300 lib/YAML/Tiny.pm
@@ -37,7 +37,7 @@ method read_string($string) {
### eval {
### unless ( defined $string ) {
-### die \"Did not provide a string to load";
+### pir::die \"Did not provide a string to load";
### }
###
### # Byte order marks
@@ -50,7 +50,7 @@ method read_string($string) {
### # "\0\0\376\377" => 'UTF-32BE',
### # );
### if ( $string =~ /^(?:\376\377|\377\376|\377\376\0\0|\0\0\376\377)/ ) {
-### die \"Stream has a non UTF-8 BOM";
+### pir::die \"Stream has a non UTF-8 BOM";
### } else {
### # Strip UTF-8 bom if found, we'll just ignore it
### $string =~ s/^\357\273\277//;
@@ -62,51 +62,53 @@ method read_string($string) {
### # Check for some special cases
### return $self unless length $string;
### unless ( $string =~ /[\012\015]+\z/ ) {
-### die \"Stream does not end with newline character";
+### pir::die \"Stream does not end with newline character";
### }
-###
-### # Split the file into lines
-### my @lines = grep { ! /^\s*(?:\#.*)?\z/ }
-### split /(?:\015{1,2}\012|\015|\012)/, $string;
-###
-### # Strip the initial YAML header
+
+ # Split the file into lines
+ my @lines := #grep { ! /^\s*(?:\#.*)?\z/ }
+ split(/\n/, $string).grep(-> $a { !($a ~~ /^^ \s* [\# .*]? $/) });
+
+ # Strip the initial YAML header
### @lines and $lines[0] =~ /^\%YAML[: ][\d\.]+.*\z/ and shift @lines;
-###
-### # A nibbling parser
-### while ( @lines ) {
-### # Do we have a document header?
-### if ( $lines[0] =~ /^---\s*(?:(.+)\s*)?\z/ ) {
-### # Handle scalar documents
-### shift @lines;
-### if ( defined $1 and $1 !~ /^(?:\#.+|\%YAML[: ][\d\.]+)\z/ ) {
-### push @$self, $self->_read_scalar( "$1", [ undef ], \@lines );
-### next;
-### }
-### }
-###
-### if ( ! @lines or $lines[0] =~ /^(?:---|\.\.\.)/ ) {
-### # A naked document
-### push @$self, undef;
-### while ( @lines and $lines[0] !~ /^---/ ) {
-### shift @lines;
-### }
-###
-### } elsif ( $lines[0] =~ /^\s*\-/ ) {
-### # An array at the root
-### my $document = [ ];
-### push @$self, $document;
-### $self->_read_array( $document, [ 0 ], \@lines );
-###
-### } elsif ( $lines[0] =~ /^(\s*)\S/ ) {
-### # A hash at the root
-### my $document = { };
-### push @$self, $document;
-### $self->_read_hash( $document, [ length($1) ], \@lines );
-###
-### } else {
-### die \"YAML::Tiny failed to classify the line '$lines[0]'";
-### }
-### }
+ @lines.shift() if +@lines && @lines[0] ~~ /^^ \%YAML <[: ]> .* $/;
+
+ # A nibbling parser
+ while ( @lines ) {
+ # Do we have a document header?
+ if my $match := @lines[0] ~~ /^^\-\-\-\s*[(.+)\s*]?$/ {
+ # Handle scalar documents
+ @lines.shift;
+ # if ( defined $1 and $1 !~ /^(?:\#.+|\%YAML[: ][\d\.]+)\z/ ) {
+ if pir::defined($match) {
+ @result.push(self._read_scalar( $match, [ undef ], @lines ));
+ next;
+ }
+ }
+
+ if !@lines || !(@lines[0] ~~ /^[\-\-\-|\.\.\.]/) {
+ # A naked document
+ @result.push(undef);
+ while @lines && !(@lines[0] ~~ /^\-\-\-/) {
+ @lines.shift;
+ }
+
+ } elsif @lines[0] ~~ /^\s*\-/ {
+ # An array at the root
+ my $document := [ ];
+ @result.push($document);
+ self._read_array( $document, [ 0 ], @lines );
+
+ } elsif my $m := @lines[0] ~~ /^(\s*)\S/ {
+ # A hash at the root
+ my $document := { };
+ @result.push($document);
+ self._read_hash( $document, [ length($m) ], @lines );
+
+ } else {
+ pir::die("YAML::Tiny failed to classify the line '{ @lines[0] }'");
+ }
+ }
### };
### if ( ref $@ eq 'SCALAR' ) {
### return $self->_error(${$@});
@@ -119,6 +121,214 @@ method read_string($string) {
@result;
}
+# Deparse a scalar string to the actual scalar
+method _read_scalar($string, $indent, @lines) {
+ pir::die("!!!");
+### # Trim trailing whitespace
+### $string =~ s/\s*\z//;
+###
+### # Explitic null/undef
+### return undef if $string eq '~';
+###
+### # Single quote
+### if ( $string =~ /^\'(.*?)\'(?:\s+\#.*)?\z/ ) {
+### return '' unless defined $1;
+### $string = $1;
+### $string =~ s/\'\'/\'/g;
+### return $string;
+### }
+###
+### # Double quote.
+### # The commented out form is simpler, but overloaded the Perl regex
+### # engine due to recursion and backtracking problems on strings
+### # larger than 32,000ish characters. Keep it for reference purposes.
+### # if ( $string =~ /^\"((?:\\.|[^\"])*)\"\z/ ) {
+### if ( $string =~ /^\"([^\\"]*(?:\\.[^\\"]*)*)\"(?:\s+\#.*)?\z/ ) {
+### # Reusing the variable is a little ugly,
+### # but avoids a new variable and a string copy.
+### $string = $1;
+### $string =~ s/\\"/"/g;
+### $string =~ s/\\([never\\fartz]|x([0-9a-fA-F]{2}))/(length($1)>1)?pack("H2",$2):$UNESCAPES{$1}/gex;
+### return $string;
+### }
+###
+### # Special cases
+### if ( $string =~ /^[\'\"!&]/ ) {
+### pir::die \"YAML::Tiny does not support a feature in line '$string'";
+### }
+### return {} if $string =~ /^{}(?:\s+\#.*)?\z/;
+### return [] if $string =~ /^\[\](?:\s+\#.*)?\z/;
+###
+### # Regular unquoted string
+### if ( $string !~ /^[>|]/ ) {
+### if (
+### $string =~ /^(?:-(?:\s|$)|[\@\%\`])/
+### or
+### $string =~ /:(?:\s|$)/
+### ) {
+### pir::die \"YAML::Tiny found illegal characters in plain scalar: '$string'";
+### }
+### $string =~ s/\s+#.*\z//;
+### return $string;
+### }
+###
+### # Error
+### pir::die \"YAML::Tiny failed to find multi-line scalar content" unless @$lines;
+###
+### # Check the indent depth
+### $lines->[0] =~ /^(\s*)/;
+### $indent->[-1] = length("$1");
+### if ( defined $indent->[-2] and $indent->[-1] <= $indent->[-2] ) {
+### pir::die \"YAML::Tiny found bad indenting in line '$lines->[0]'";
+### }
+###
+### # Pull the lines
+### my @multiline = ();
+### while ( @$lines ) {
+### $lines->[0] =~ /^(\s*)/;
+### last unless length($1) >= $indent->[-1];
+### push @multiline, substr(shift(@$lines), length($1));
+### }
+###
+### my $j = (substr($string, 0, 1) eq '>') ? ' ' : "\n";
+### my $t = (substr($string, 1, 1) eq '-') ? '' : "\n";
+### return join( $j, @multiline ) . $t;
+}
+
+# Parse an array
+method _read_array($array, $indent, @lines) {
+ pir::die("!!!");
+### while ( @$lines ) {
+### # Check for a new document
+### if ( $lines->[0] =~ /^(?:---|\.\.\.)/ ) {
+### while ( @$lines and $lines->[0] !~ /^---/ ) {
+### shift @$lines;
+### }
+### return 1;
+### }
+###
+### # Check the indent level
+### $lines->[0] =~ /^(\s*)/;
+### if ( length($1) < $indent->[-1] ) {
+### return 1;
+### } elsif ( length($1) > $indent->[-1] ) {
+### pir::die \"YAML::Tiny found bad indenting in line '$lines->[0]'";
+### }
+###
+### if ( $lines->[0] =~ /^(\s*\-\s+)[^\'\"]\S*\s*:(?:\s+|$)/ ) {
+### # Inline nested hash
+### my $indent2 = length("$1");
+### $lines->[0] =~ s/-/ /;
+### push @$array, { };
+### $self->_read_hash( $array->[-1], [ @$indent, $indent2 ], $lines );
+###
+### } elsif ( $lines->[0] =~ /^\s*\-(\s*)(.+?)\s*\z/ ) {
+### # Array entry with a value
+### shift @$lines;
+### push @$array, $self->_read_scalar( "$2", [ @$indent, undef ], $lines );
+###
+### } elsif ( $lines->[0] =~ /^\s*\-\s*\z/ ) {
+### shift @$lines;
+### unless ( @$lines ) {
+### push @$array, undef;
+### return 1;
+### }
+### if ( $lines->[0] =~ /^(\s*)\-/ ) {
+### my $indent2 = length("$1");
+### if ( $indent->[-1] == $indent2 ) {
+### # Null array entry
+### push @$array, undef;
+### } else {
+### # Naked indenter
+### push @$array, [ ];
+### $self->_read_array( $array->[-1], [ @$indent, $indent2 ], $lines );
+### }
+###
+### } elsif ( $lines->[0] =~ /^(\s*)\S/ ) {
+### push @$array, { };
+### $self->_read_hash( $array->[-1], [ @$indent, length("$1") ], $lines );
+###
+### } else {
+### pir::die \"YAML::Tiny failed to classify line '$lines->[0]'";
+### }
+###
+### } elsif ( defined $indent->[-2] and $indent->[-1] == $indent->[-2] ) {
+### # This is probably a structure like the following...
+### # ---
+### # foo:
+### # - list
+### # bar: value
+### #
+### # ... so lets return and let the hash parser handle it
+### return 1;
+###
+### } else {
+### pir::die \"YAML::Tiny failed to classify line '$lines->[0]'";
+### }
+### }
+###
+### return 1;
+}
+
+# Parse an array
+method _read_hash($hash, $indent, @lines) {
+ pir::die("!!!");
+###
+### while ( @$lines ) {
+### # Check for a new document
+### if ( $lines->[0] =~ /^(?:---|\.\.\.)/ ) {
+### while ( @$lines and $lines->[0] !~ /^---/ ) {
+### shift @$lines;
+### }
+### return 1;
+### }
+###
+### # Check the indent level
+### $lines->[0] =~ /^(\s*)/;
+### if ( length($1) < $indent->[-1] ) {
+### return 1;
+### } elsif ( length($1) > $indent->[-1] ) {
+### pir::die \"YAML::Tiny found bad indenting in line '$lines->[0]'";
+### }
+###
+### # Get the key
+### unless ( $lines->[0] =~ s/^\s*([^\'\" ][^\n]*?)\s*:(\s+(?:\#.*)?|$)// ) {
+### if ( $lines->[0] =~ /^\s*[?\'\"]/ ) {
+### pir::die \"YAML::Tiny does not support a feature in line '$lines->[0]'";
+### }
+### pir::die \"YAML::Tiny failed to classify line '$lines->[0]'";
+### }
+### my $key = $1;
+###
+### # Do we have a value?
+### if ( length $lines->[0] ) {
+### # Yes
+### $hash->{$key} = $self->_read_scalar( shift(@$lines), [ @$indent, undef ], $lines );
+### } else {
+### # An indent
+### shift @$lines;
+### unless ( @$lines ) {
+### $hash->{$key} = undef;
+### return 1;
+### }
+### if ( $lines->[0] =~ /^(\s*)-/ ) {
+### $hash->{$key} = [];
+### $self->_read_array( $hash->{$key}, [ @$indent, length($1) ], $lines );
+### } elsif ( $lines->[0] =~ /^(\s*)./ ) {
+### my $indent2 = length("$1");
+### if ( $indent->[-1] >= $indent2 ) {
+### # Null hash entry
+### $hash->{$key} = undef;
+### } else {
+### $hash->{$key} = {};
+### $self->_read_hash( $hash->{$key}, [ @$indent, length($1) ], $lines );
+### }
+### }
+### }
+### }
+###
+### return 1;
+}
INIT {

0 comments on commit 73514c8

Please sign in to comment.