view release on metacpan or  search on metacpan

t/000-report-versions.t  view on Meta::CPAN

  $YAML::Tiny::errstr = '';
}

# Printable characters for escapes
my %UNESCAPES = (
  z    => "\x00",
  a    => "\x07",
  t    => "\x09",
  n    => "\x0a",
  v    => "\x0b",
  f    => "\x0c",
  r    => "\x0d",
  e    => "\x1b",
  '\\' => '\\',
);

#####################################################################
# Implementation

# Create an empty YAML::Tiny object
sub new {
  my $class = shift;
  bless [@_], $class;
}

# Create an object from a file
sub read {
  my $class = ref $_[0] ? ref shift : shift;

  # Check the file
  my $file = shift or return $class->_error( 'You did not specify a file name' );
  return $class->_error( "File '$file' does not exist" )              unless -e $file;
  return $class->_error( "'$file' is a directory, not a file" )       unless -f _;
  return $class->_error( "Insufficient permissions to read '$file'" ) unless -r _;

  # Slurp in the file
  local $/ = undef;
  local *CFG;
  unless ( open( CFG, $file ) ) {
    return $class->_error( "Failed to open file '$file': $!" );
  }
  my $contents = <CFG>;
  unless ( close( CFG ) ) {
    return $class->_error( "Failed to close file '$file': $!" );
  }

  $class->read_string( $contents );
} ## end sub read

# Create an object from a string
sub read_string {
  my $class = ref $_[0] ? ref shift : shift;
  my $self = bless [], $class;
  my $string = $_[0];
  unless ( defined $string ) {
    return $self->_error( "Did not provide a string to load" );
  }

  # Byte order marks
  # NOTE: Keeping this here to educate maintainers
  # my %BOM = (
  #     "\357\273\277" => 'UTF-8',
  #     "\376\377"     => 'UTF-16BE',
  #     "\377\376"     => 'UTF-16LE',
  #     "\377\376\0\0" => 'UTF-32LE'
  #     "\0\0\376\377" => 'UTF-32BE',
  # );
  if ( $string =~ /^(?:\376\377|\377\376|\377\376\0\0|\0\0\376\377)/ ) {
    return $self->_error( "Stream has a non UTF-8 BOM" );
  } else {

    # Strip UTF-8 bom if found, we'll just ignore it
    $string =~ s/^\357\273\277//;
  }

  # Try to decode as utf8
  utf8::decode( $string ) if HAVE_UTF8;

  # Check for some special cases
  return $self unless length $string;
  unless ( $string =~ /[\012\015]+\z/ ) {
    return $self->_error( "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
  @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 {
      croak( "YAML::Tiny failed to classify the line '$lines[0]'" );