#!/usr/bin/env perl

# This chunk of stuff was generated by App::FatPacker. To find the original
# file's code, look for the end of this BEGIN block or the string 'FATPACK'
BEGIN {
my %fatpacked;

$fatpacked{"App/Dex.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'APP_DEX';
  package App::Dex;
  use Moo;
  use List::Util qw( first );
  use YAML::PP qw( LoadFile );
  use IPC::Run3;
  
  our $VERSION = '0.002002';
  
  has config_file => (
      is      => 'ro',
      isa     => sub { die 'Config file not found' unless $_[0] && -e $_[0] },
      lazy    => 1,
      default => sub {
          first { -e $_ } @{shift->config_file_names};
      },
  );
  
  has config_file_names => (
      is      => 'ro',
      lazy    => 1,
      default => sub {
          return [ qw( dex.yaml .dex.yaml ) ],
      },
  );
  
  has config => (
      is      => 'ro',
      lazy    => 1,
      builder => sub {
          LoadFile shift->config_file;
      },
  );
  
  has menu => (
      is      => 'ro',
      lazy    => 1,
      builder => sub {
          my ( $self ) = @_;
          return [ $self->_menu_data( $self->config, 0 ) ];
      }
  );
  
  sub _menu_data {
      my ( $self, $config, $depth ) = @_;
  
      my @menu;
      foreach my $block ( @{$config} ) {
          push @menu, {
              name  => $block->{name},
              desc  => $block->{desc},
              depth => $depth,
          };
          if ( $block->{children} ) {
              push @menu, $self->_menu_data($block->{children}, $depth + 1);
  
          }
      }
      return @menu;
  }
  
  sub display_menu {
      my ( $self, $menu ) = @_;
  
      $menu = $self->menu unless $menu;
  
      foreach my $item ( @{$menu} ) {
          printf( "%s%-24s: %s\n", " " x ( 4 * $item->{depth} ), $item->{name}, $item->{desc}  );
      }
  }
  
  sub resolve_block {
      my ( $self, $path ) = @_;
  
      return $self->_resolve_block( $path, $self->config );
  }
  
  sub _resolve_block {
      my ( $self, $path, $config ) = @_;
  
      my $block;
      while ( defined ( my $segment = shift @{$path} ) ) {
          $block = first { $_->{name} eq $segment } @{$config};
  
          return undef unless $block;
  
          if ( @{$path} ) {
              $config = $block->{children};
              next;
          }
      }
      return $block;
  }
  
  sub process_block {
      my ( $self, $block ) = @_;
  
      if ( $block->{shell} ) {
          _run_block_shell( $block );
      }
  }
  
  sub _run_block_shell {
      my ( $block ) = @_;
  
      foreach my $command ( @{$block->{shell}} ) {
          run3( $command );
      }
  }
  
  1;
  
  __END__
  
  =encoding utf8
  
  =head1 NAME
  
  App::dex - Directory Execute
  
  =head1 DESCRIPTION
  
  B<dex> provides a command line utility for managing directory-specific commands.
  
  =head1 USAGE
  
      dex                    - Display the menu
      dex command            - Run a command
      dex command subcommand - Run a sub command
  
  Create a file called C<dex.yaml> or C<.dex.yaml> and define commands to be run.
  
  =head1 DEX FILE SPECIFICATION
  
  This is an example dex file.
  
      - name: build
        desc: "Run through the build process, including testing."
        shell:
          - ./fatpack.sh
          - dzil test
          - dzil build
      - name: test
        desc: "Just test the changes"
        shell:
          - dzil test
      - name: release
        desc: "Publish App::Dex to CPAN"
        shell:
          - dzil release
      - name: clean
        desc: "Remove artifacts"
        shell:
          - dzil clean
      - name: authordeps
        desc: "Install distzilla and dependencies"
        shell:
          - cpanm Dist::Zilla
          - dzil authordeps --missing | cpanm
          - dzil listdeps --develop --missing | cpanm
  
  When running the command dex, a menu will display:
  
      $ dex
      build                   : Run through the build process, including testing.
      test                    : Just test the changes
      release                 : Publish App::Dex to CPAN
      clean                   : Remove artifacts
      authordeps              : Install distzilla and dependencies
  
  To execute the build command run C<dex build>.
  
  =head2 SUBCOMMANDS
  
  Commands can be grouped to logically organize them, for example:
  
      - name: foo
        desc: "Foo command"
        children:
          - name: bar
            desc: "Bar subcommand"
            shell:
              - echo "Ran the command!"
  
  The menu for this would show the relationship:
  
      $ dex
      foo                     : Foo command
          bar                     : Bar subcommand
  
  To execute the command one would run C<dex foo bar>.
  
  
  =head1 FALLBACK COMMAND
  
  When dex doesn't understand the command it will give an error and display the menu. It
  can be configured to allow another program to try to execute the command.
  
  Set the environment variable C<DEX_FALLBACK_CMD> to the command you would like to run
  instead.
  
  =head1 AUTHOR
  
  Kaitlyn Parkhurst (SymKat) I<E<lt>symkat@symkat.comE<gt>> ( Blog: L<http://symkat.com/> )
  
  =head1 CONTRIBUTORS
  
  =head1 SPONSORS
  
  =head1 COPYRIGHT
  
  Copyright (c) 2019 the App::dex L</AUTHOR>, L</CONTRIBUTORS>, and L</SPONSORS> as listed above.
  
  =head1 LICENSE
  
  This library is free software and may be distributed under the same terms as perl itself.
  
  =head2 AVAILABILITY
  
  The most current version of App::dec can be found at L<https://github.com/symkat/App-dex>
APP_DEX

$fatpacked{"IPC/Run3.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'IPC_RUN3';
  package IPC::Run3;
  BEGIN { require 5.006_000; } # i.e. 5.6.0
  use strict;
  
  =head1 NAME
  
  IPC::Run3 - run a subprocess with input/ouput redirection
  
  =head1 VERSION
  
  version 0.048
  
  =cut
  
  our $VERSION = '0.048';
  
  =head1 SYNOPSIS
  
      use IPC::Run3;    # Exports run3() by default
  
      run3 \@cmd, \$in, \$out, \$err;
  
  =head1 DESCRIPTION
  
  This module allows you to run a subprocess and redirect stdin, stdout,
  and/or stderr to files and perl data structures.  It aims to satisfy 99% of the
  need for using C<system>, C<qx>, and C<open3>
  with a simple, extremely Perlish API.
  
  Speed, simplicity, and portability are paramount.  (That's speed of Perl code;
  which is often much slower than the kind of buffered I/O that this module uses
  to spool input to and output from the child command.)
  
  =cut
  
  use Exporter;
  our @ISA = qw(Exporter);
  our @EXPORT = qw( run3 );
  our %EXPORT_TAGS = ( all => \@EXPORT );
  
  use constant debugging => $ENV{IPCRUN3DEBUG} || $ENV{IPCRUNDEBUG} || 0;
  use constant profiling => $ENV{IPCRUN3PROFILE} || $ENV{IPCRUNPROFILE} || 0;
  use constant is_win32  => 0 <= index $^O, "Win32";
  
  BEGIN {
     if ( is_win32 ) {
        eval "use Win32 qw( GetOSName ); use Win32::ShellQuote qw(quote_native); 1" or die $@;
     }
  }
  
  #use constant is_win2k => is_win32 && GetOSName() =~ /Win2000/i;
  #use constant is_winXP => is_win32 && GetOSName() =~ /WinXP/i;
  
  use Carp qw( croak );
  use File::Temp qw( tempfile );
  use POSIX qw( dup dup2 );
  
  # We cache the handles of our temp files in order to
  # keep from having to incur the (largish) overhead of File::Temp
  my %fh_cache;
  my $fh_cache_pid = $$;
  
  my $profiler;
  
  sub _profiler { $profiler } # test suite access
  
  BEGIN {
      if ( profiling ) {
          eval "use Time::HiRes qw( gettimeofday ); 1" or die $@;
          if ( $ENV{IPCRUN3PROFILE} =~ /\A\d+\z/ ) {
              require IPC::Run3::ProfPP;
              IPC::Run3::ProfPP->import;
              $profiler = IPC::Run3::ProfPP->new(Level => $ENV{IPCRUN3PROFILE});
          } else {
              my ( $dest, undef, $class ) =
                 reverse split /(=)/, $ENV{IPCRUN3PROFILE}, 2;
              $class = "IPC::Run3::ProfLogger"
                  unless defined $class && length $class;
              if ( not eval "require $class" ) {
                  my $e = $@;
                  $class = "IPC::Run3::$class";
                  eval "require IPC::Run3::$class" or die $e;
              }
              $profiler = $class->new( Destination => $dest );
          }
          $profiler->app_call( [ $0, @ARGV ], scalar gettimeofday() );
      }
  }
  
  
  END {
      $profiler->app_exit( scalar gettimeofday() ) if profiling;
  }
  
  sub _binmode {
      my ( $fh, $mode, $what ) = @_;
      # if $mode is not given, then default to ":raw", except on Windows,
      # where we default to ":crlf";
      # otherwise if a proper layer string was given, use that,
      # else use ":raw"
      my $layer = !$mode
         ? (is_win32 ? ":crlf" : ":raw")
         : ($mode =~ /^:/ ? $mode : ":raw");
      warn "binmode $what, $layer\n" if debugging >= 2;
  
      binmode $fh, ":raw" unless $layer eq ":raw";      # remove all layers first
      binmode $fh, $layer or croak "binmode $layer failed: $!";
  }
  
  sub _spool_data_to_child {
      my ( $type, $source, $binmode_it ) = @_;
  
      # If undef (not \undef) passed, they want the child to inherit
      # the parent's STDIN.
      return undef unless defined $source;
  
      my $fh;
      if ( ! $type ) {
          open $fh, "<", $source or croak "$!: $source";
         _binmode($fh, $binmode_it, "STDIN");
          warn "run3(): feeding file '$source' to child STDIN\n"
              if debugging >= 2;
      } elsif ( $type eq "FH" ) {
          $fh = $source;
          warn "run3(): feeding filehandle '$source' to child STDIN\n"
              if debugging >= 2;
      } else {
          $fh = $fh_cache{in} ||= tempfile;
          truncate $fh, 0;
          seek $fh, 0, 0;
         _binmode($fh, $binmode_it, "STDIN");
          my $seekit;
          if ( $type eq "SCALAR" ) {
  
              # When the run3()'s caller asks to feed an empty file
              # to the child's stdin, we want to pass a live file
              # descriptor to an empty file (like /dev/null) so that
              # they don't get surprised by invalid fd errors and get
              # normal EOF behaviors.
              return $fh unless defined $$source;  # \undef passed
  
              warn "run3(): feeding SCALAR to child STDIN",
                  debugging >= 3
                     ? ( ": '", $$source, "' (", length $$source, " chars)" )
                     : (),
                  "\n"
                  if debugging >= 2;
  
              $seekit = length $$source;
              print $fh $$source or die "$! writing to temp file";
  
          } elsif ( $type eq "ARRAY" ) {
              warn "run3(): feeding ARRAY to child STDIN",
                  debugging >= 3 ? ( ": '", @$source, "'" ) : (),
                  "\n"
              if debugging >= 2;
  
              print $fh @$source or die "$! writing to temp file";
              $seekit = grep length, @$source;
          } elsif ( $type eq "CODE" ) {
              warn "run3(): feeding output of CODE ref '$source' to child STDIN\n"
                  if debugging >= 2;
              my $parms = [];  # TODO: get these from $options
              while (1) {
                  my $data = $source->( @$parms );
                  last unless defined $data;
                  print $fh $data or die "$! writing to temp file";
                  $seekit = length $data;
              }
          }
  
          seek $fh, 0, 0 or croak "$! seeking on temp file for child's stdin"
              if $seekit;
      }
  
      croak "run3() can't redirect $type to child stdin"
          unless defined $fh;
  
      return $fh;
  }
  
  sub _fh_for_child_output {
      my ( $what, $type, $dest, $options ) = @_;
  
      my $fh;
      if ( $type eq "SCALAR" && $dest == \undef ) {
          warn "run3(): redirecting child $what to oblivion\n"
              if debugging >= 2;
  
          $fh = $fh_cache{nul} ||= do {
              open $fh, ">", File::Spec->devnull;
             $fh;
          };
      } elsif ( $type eq "FH" ) {
          $fh = $dest;
          warn "run3(): redirecting $what to filehandle '$dest'\n"
              if debugging >= 3;
      } elsif ( !$type ) {
          warn "run3(): feeding child $what to file '$dest'\n"
              if debugging >= 2;
  
          open $fh, $options->{"append_$what"} ? ">>" : ">", $dest
             or croak "$!: $dest";
      } else {
          warn "run3(): capturing child $what\n"
              if debugging >= 2;
  
          $fh = $fh_cache{$what} ||= tempfile;
          seek $fh, 0, 0;
          truncate $fh, 0;
      }
  
      my $binmode_it = $options->{"binmode_$what"};
      _binmode($fh, $binmode_it, uc $what);
  
      return $fh;
  }
  
  sub _read_child_output_fh {
      my ( $what, $type, $dest, $fh, $options ) = @_;
  
      return if $type eq "SCALAR" && $dest == \undef;
  
      seek $fh, 0, 0 or croak "$! seeking on temp file for child $what";
  
      if ( $type eq "SCALAR" ) {
          warn "run3(): reading child $what to SCALAR\n"
              if debugging >= 3;
  
          # two read()s are used instead of 1 so that the first will be
          # logged even it reads 0 bytes; the second won't.
          my $count = read $fh, $$dest, 10_000,
             $options->{"append_$what"} ? length $$dest : 0;
          while (1) {
              croak "$! reading child $what from temp file"
                  unless defined $count;
  
              last unless $count;
  
              warn "run3(): read $count bytes from child $what",
                  debugging >= 3 ? ( ": '", substr( $$dest, -$count ), "'" ) : (),
                  "\n"
                  if debugging >= 2;
  
              $count = read $fh, $$dest, 10_000, length $$dest;
          }
      } elsif ( $type eq "ARRAY" ) {
         if ($options->{"append_$what"}) {
             push @$dest, <$fh>;
         } else {
             @$dest = <$fh>;
         }
          if ( debugging >= 2 ) {
              my $count = 0;
              $count += length for @$dest;
              warn
                  "run3(): read ",
                  scalar @$dest,
                  " records, $count bytes from child $what",
                  debugging >= 3 ? ( ": '", @$dest, "'" ) : (),
                  "\n";
          }
      } elsif ( $type eq "CODE" ) {
          warn "run3(): capturing child $what to CODE ref\n"
              if debugging >= 3;
  
          local $_;
          while ( <$fh> ) {
              warn
                  "run3(): read ",
                  length,
                  " bytes from child $what",
                  debugging >= 3 ? ( ": '", $_, "'" ) : (),
                  "\n"
                  if debugging >= 2;
  
              $dest->( $_ );
          }
      } else {
          croak "run3() can't redirect child $what to a $type";
      }
  
  }
  
  sub _type {
      my ( $redir ) = @_;
  
      return "FH" if eval {
          local $SIG{'__DIE__'};
          $redir->isa("IO::Handle")
      };
  
      my $type = ref $redir;
      return $type eq "GLOB" ? "FH" : $type;
  }
  
  sub _max_fd {
      my $fd = dup(0);
      POSIX::close $fd;
      return $fd;
  }
  
  my $run_call_time;
  my $sys_call_time;
  my $sys_exit_time;
  
  sub run3 {
      $run_call_time = gettimeofday() if profiling;
  
      my $options = @_ && ref $_[-1] eq "HASH" ? pop : {};
  
      my ( $cmd, $stdin, $stdout, $stderr ) = @_;
  
      print STDERR "run3(): running ",
         join( " ", map "'$_'", ref $cmd ? @$cmd : $cmd ),
         "\n"
         if debugging;
  
      if ( ref $cmd ) {
          croak "run3(): empty command"     unless @$cmd;
          croak "run3(): undefined command" unless defined $cmd->[0];
          croak "run3(): command name ('')" unless length  $cmd->[0];
      } else {
          croak "run3(): missing command" unless @_;
          croak "run3(): undefined command" unless defined $cmd;
          croak "run3(): command ('')" unless length  $cmd;
      }
  
      foreach (qw/binmode_stdin binmode_stdout binmode_stderr/) {
         if (my $mode = $options->{$_}) {
             croak qq[option $_ must be a number or a proper layer string: "$mode"]
                unless $mode =~ /^(:|\d+$)/;
         }
      }
  
      my $in_type  = _type $stdin;
      my $out_type = _type $stdout;
      my $err_type = _type $stderr;
  
      if ($fh_cache_pid != $$) {
         # fork detected, close all cached filehandles and clear the cache
         close $_ foreach values %fh_cache;
         %fh_cache = ();
         $fh_cache_pid = $$;
      }
  
      # This routine proceeds in stages so that a failure in an early
      # stage prevents later stages from running, and thus from needing
      # cleanup.
  
      my $in_fh  = _spool_data_to_child $in_type, $stdin,
          $options->{binmode_stdin} if defined $stdin;
  
      my $out_fh = _fh_for_child_output "stdout", $out_type, $stdout,
          $options if defined $stdout;
  
      my $tie_err_to_out =
          defined $stderr && defined $stdout && $stderr eq $stdout;
  
      my $err_fh = $tie_err_to_out
          ? $out_fh
          : _fh_for_child_output "stderr", $err_type, $stderr,
              $options if defined $stderr;
  
      # this should make perl close these on exceptions
  #    local *STDIN_SAVE;
      local *STDOUT_SAVE;
      local *STDERR_SAVE;
  
      my $saved_fd0 = dup( 0 ) if defined $in_fh;
  
  #    open STDIN_SAVE,  "<&STDIN"#  or croak "run3(): $! saving STDIN"
  #        if defined $in_fh;
      open STDOUT_SAVE, ">&STDOUT" or croak "run3(): $! saving STDOUT"
          if defined $out_fh;
      open STDERR_SAVE, ">&STDERR" or croak "run3(): $! saving STDERR"
          if defined $err_fh;
  
      my $errno;
      my $ok = eval {
          # The open() call here seems to not force fd 0 in some cases;
          # I ran in to trouble when using this in VCP, not sure why.
          # the dup2() seems to work.
          dup2( fileno $in_fh, 0 )
  #        open STDIN,  "<&=" . fileno $in_fh
              or croak "run3(): $! redirecting STDIN"
              if defined $in_fh;
  
  #        close $in_fh or croak "$! closing STDIN temp file"
  #            if ref $stdin;
  
          open STDOUT, ">&" . fileno $out_fh
              or croak "run3(): $! redirecting STDOUT"
              if defined $out_fh;
  
          open STDERR, ">&" . fileno $err_fh
              or croak "run3(): $! redirecting STDERR"
              if defined $err_fh;
  
          $sys_call_time = gettimeofday() if profiling;
  
          my $r = ref $cmd
                ? system { $cmd->[0] } is_win32 ? quote_native( @$cmd ) : @$cmd
                : system $cmd;
  
         $errno = $!;              # save $!, because later failures will overwrite it
          $sys_exit_time = gettimeofday() if profiling;
          if ( debugging ) {
              my $err_fh = defined $err_fh ? \*STDERR_SAVE : \*STDERR;
             if ( defined $r && $r != -1 ) {
                print $err_fh "run3(): \$? is $?\n";
             } else {
                print $err_fh "run3(): \$? is $?, \$! is $errno\n";
             }
          }
  
          if (
              defined $r
              && ( $r == -1 || ( is_win32 && $r == 0xFF00 ) )
              && !$options->{return_if_system_error}
          ) {
              croak( $errno );
          }
  
          1;
      };
      my $x = $@;
  
      my @errs;
  
      if ( defined $saved_fd0 ) {
          dup2( $saved_fd0, 0 );
          POSIX::close( $saved_fd0 );
      }
  
  #    open STDIN,  "<&STDIN_SAVE"#  or push @errs, "run3(): $! restoring STDIN"
  #        if defined $in_fh;
      open STDOUT, ">&STDOUT_SAVE" or push @errs, "run3(): $! restoring STDOUT"
          if defined $out_fh;
      open STDERR, ">&STDERR_SAVE" or push @errs, "run3(): $! restoring STDERR"
          if defined $err_fh;
  
      croak join ", ", @errs if @errs;
  
      die $x unless $ok;
  
      _read_child_output_fh "stdout", $out_type, $stdout, $out_fh, $options
          if defined $out_fh && $out_type && $out_type ne "FH";
      _read_child_output_fh "stderr", $err_type, $stderr, $err_fh, $options
          if defined $err_fh && $err_type && $err_type ne "FH" && !$tie_err_to_out;
      $profiler->run_exit(
         $cmd,
         $run_call_time,
         $sys_call_time,
         $sys_exit_time,
         scalar gettimeofday()
      ) if profiling;
  
      $! = $errno;              # restore $! from system()
  
      return 1;
  }
  
  1;
  
  __END__
  
  =head2 C<< run3($cmd, $stdin, $stdout, $stderr, \%options) >>
  
  All parameters after C<$cmd> are optional.
  
  The parameters C<$stdin>, C<$stdout> and C<$stderr> indicate how the child's
  corresponding filehandle (C<STDIN>, C<STDOUT> and C<STDERR>, resp.) will be
  redirected.  Because the redirects come last, this allows C<STDOUT> and
  C<STDERR> to default to the parent's by just not specifying them -- a common
  use case.
  
  C<run3> throws an exception if the wrapped C<system> call returned -1 or
  anything went wrong with C<run3>'s processing of filehandles.  Otherwise it
  returns true.  It leaves C<$?> intact for inspection of exit and wait status.
  
  Note that a true return value from C<run3> doesn't mean that the command had a
  successful exit code. Hence you should always check C<$?>.
  
  See L</%options> for an option to handle the case of C<system> returning -1
  yourself.
  
  =head3 C<$cmd>
  
  Usually C<$cmd> will be an ARRAY reference and the child is invoked via
  
    system @$cmd;
  
  But C<$cmd> may also be a string in which case the child is invoked via
  
    system $cmd;
  
  (cf. L<perlfunc/system> for the difference and the pitfalls of using
  the latter form).
  
  =head3 C<$stdin>, C<$stdout>, C<$stderr>
  
  The parameters C<$stdin>, C<$stdout> and C<$stderr> can take one of the
  following forms:
  
  =over 4
  
  =item C<undef> (or not specified at all)
  
  The child inherits the corresponding filehandle from the parent.
  
    run3 \@cmd, $stdin;                   # child writes to same STDOUT and STDERR as parent
    run3 \@cmd, undef, $stdout, $stderr;  # child reads from same STDIN as parent
  
  =item C<\undef>
  
  The child's filehandle is redirected from or to the local equivalent of
  C</dev/null> (as returned by C<< File::Spec->devnull() >>).
  
    run3 \@cmd, \undef, $stdout, $stderr; # child reads from /dev/null
  
  =item a simple scalar
  
  The parameter is taken to be the name of a file to read from
  or write to. In the latter case, the file will be opened via
  
    open FH, ">", ...
  
  i.e. it is created if it doesn't exist and truncated otherwise.
  Note that the file is opened by the parent which will L<croak|Carp/croak>
  in case of failure.
  
    run3 \@cmd, \undef, "out.txt";        # child writes to file "out.txt"
  
  =item a filehandle (either a reference to a GLOB or an C<IO::Handle>)
  
  The filehandle is inherited by the child.
  
    open my $fh, ">", "out.txt";
    print $fh "prologue\n";
    ...
    run3 \@cmd, \undef, $fh;              # child writes to $fh
    ...
    print $fh "epilogue\n";
    close $fh;
  
  =item a SCALAR reference
  
  The referenced scalar is treated as a string to be read from or
  written to. In the latter case, the previous content of the string
  is overwritten.
  
    my $out;
    run3 \@cmd, \undef, \$out;           # child writes into string
    run3 \@cmd, \<<EOF;                  # child reads from string (can use "here" notation)
    Input
    to
    child
    EOF
  
  =item an ARRAY reference
  
  For C<$stdin>, the elements of C<@$stdin> are simply spooled to the child.
  
  For C<$stdout> or C<$stderr>, the child's corresponding file descriptor
  is read line by line (as determined by the current setting of C<$/>)
  into C<@$stdout> or C<@$stderr>, resp. The previous content of the array
  is overwritten.
  
    my @lines;
    run3 \@cmd, \undef, \@lines;         # child writes into array
  
  =item a CODE reference
  
  For C<$stdin>, C<&$stdin> will be called repeatedly (with no arguments) and
  the return values are spooled to the child. C<&$stdin> must signal the end of
  input by returning C<undef>.
  
  For C<$stdout> or C<$stderr>, the child's corresponding file descriptor
  is read line by line (as determined by the current setting of C<$/>)
  and C<&$stdout> or C<&$stderr>, resp., is called with the contents of the line.
  Note that there's no end-of-file indication.
  
    my $i = 0;
    sub producer {
      return $i < 10 ? "line".$i++."\n" : undef;
    }
  
    run3 \@cmd, \&producer;              # child reads 10 lines
  
  Note that this form of redirecting the child's I/O doesn't imply
  any form of concurrency between parent and child - run3()'s method of
  operation is the same no matter which form of redirection you specify.
  
  =back
  
  If the same value is passed for C<$stdout> and C<$stderr>, then the child
  will write both C<STDOUT> and C<STDERR> to the same filehandle.
  In general, this means that
  
      run3 \@cmd, \undef, "foo.txt", "foo.txt";
      run3 \@cmd, \undef, \$both, \$both;
  
  will DWIM and pass a single file handle to the child for both C<STDOUT> and
  C<STDERR>, collecting all into file "foo.txt" or C<$both>.
  
  =head3 C<\%options>
  
  The last parameter, C<\%options>, must be a hash reference if present.
  
  Currently the following keys are supported:
  
  =over 4
  
  =item C<binmode_stdin>, C<binmode_stdout>, C<binmode_stderr>
  
  The value must a "layer" as described in L<perlfunc/binmode>.  If specified the
  corresponding parameter C<$stdin>, C<$stdout> or C<$stderr>, resp., operates
  with the given layer.
  
  For backward compatibility, a true value that doesn't start with ":"
  (e.g. a number) is interpreted as ":raw". If the value is false
  or not specified, the default is ":crlf" on Windows and ":raw" otherwise.
  
  Don't expect that values other than the built-in layers ":raw", ":crlf",
  and (on newer Perls) ":bytes", ":utf8", ":encoding(...)" will work.
  
  =item C<append_stdout>, C<append_stderr>
  
  If their value is true then the corresponding parameter C<$stdout> or
  C<$stderr>, resp., will append the child's output to the existing "contents" of
  the redirector. This only makes sense if the redirector is a simple scalar (the
  corresponding file is opened in append mode), a SCALAR reference (the output is
  appended to the previous contents of the string) or an ARRAY reference (the
  output is C<push>ed onto the previous contents of the array).
  
  =item C<return_if_system_error>
  
  If this is true C<run3> does B<not> throw an exception if C<system> returns -1
  (cf. L<perlfunc/system> for possible failure scenarios.), but returns true
  instead.  In this case C<$?> has the value -1 and C<$!> contains the errno of
  the failing C<system> call.
  
  =back
  
  =head1 HOW IT WORKS
  
  =over 4
  
  =item (1)
  
  For each redirector C<$stdin>, C<$stdout>, and C<$stderr>, C<run3()> furnishes
  a filehandle:
  
  =over 4
  
  =item *
  
  if the redirector already specifies a filehandle it just uses that
  
  =item *
  
  if the redirector specifies a filename, C<run3()> opens the file
  in the appropriate mode
  
  =item *
  
  in all other cases, C<run3()> opens a temporary file (using
  L<tempfile|Temp/tempfile>)
  
  =back
  
  =item (2)
  
  If C<run3()> opened a temporary file for C<$stdin> in step (1),
  it writes the data using the specified method (either
  from a string, an array or returned by a function) to the temporary file and rewinds it.
  
  =item (3)
  
  C<run3()> saves the parent's C<STDIN>, C<STDOUT> and C<STDERR> by duplicating
  them to new filehandles. It duplicates the filehandles from step (1)
  to C<STDIN>, C<STDOUT> and C<STDERR>, resp.
  
  =item (4)
  
  C<run3()> runs the child by invoking L<system|perlfunc/system> with C<$cmd> as
  specified above.
  
  =item (5)
  
  C<run3()> restores the parent's C<STDIN>, C<STDOUT> and C<STDERR> saved in step (3).
  
  =item (6)
  
  If C<run3()> opened a temporary file for C<$stdout> or C<$stderr> in step (1),
  it rewinds it and reads back its contents using the specified method (either to
  a string, an array or by calling a function).
  
  =item (7)
  
  C<run3()> closes all filehandles that it opened explicitly in step (1).
  
  =back
  
  Note that when using temporary files, C<run3()> tries to amortize the overhead
  by reusing them (i.e. it keeps them open and rewinds and truncates them
  before the next operation).
  
  =head1 LIMITATIONS
  
  Often uses intermediate files (determined by File::Temp, and thus by the
  File::Spec defaults and the TMPDIR env. variable) for speed, portability and
  simplicity.
  
  Use extreme caution when using C<run3> in a threaded environment if concurrent
  calls of C<run3> are possible. Most likely, I/O from different invocations will
  get mixed up. The reason is that in most thread implementations all threads in
  a process share the same STDIN/STDOUT/STDERR.  Known failures are Perl ithreads
  on Linux and Win32. Note that C<fork> on Win32 is emulated via Win32 threads
  and hence I/O mix up is possible between forked children here (C<run3> is "fork
  safe" on Unix, though).
  
  =head1 DEBUGGING
  
  To enable debugging use the IPCRUN3DEBUG environment variable to
  a non-zero integer value:
  
    $ IPCRUN3DEBUG=1 myapp
  
  =head1 PROFILING
  
  To enable profiling, set IPCRUN3PROFILE to a number to enable emitting profile
  information to STDERR (1 to get timestamps, 2 to get a summary report at the
  END of the program, 3 to get mini reports after each run) or to a filename to
  emit raw data to a file for later analysis.
  
  =head1 COMPARISON
  
  Here's how it stacks up to existing APIs:
  
  =head2 compared to C<system()>, C<qx''>, C<open "...|">, C<open "|...">
  
  =over
  
  =item *
  
  better: redirects more than one file descriptor
  
  =item *
  
  better: returns TRUE on success, FALSE on failure
  
  =item *
  
  better: throws an error if problems occur in the parent process (or the
  pre-exec child)
  
  =item *
  
  better: allows a very perlish interface to Perl data structures and subroutines
  
  =item *
  
  better: allows 1 word invocations to avoid the shell easily:
  
   run3 ["foo"];  # does not invoke shell
  
  =item *
  
  worse: does not return the exit code, leaves it in $?
  
  =back
  
  =head2 compared to C<open2()>, C<open3()>
  
  =over
  
  =item *
  
  better: no lengthy, error prone polling/select loop needed
  
  =item *
  
  better: hides OS dependencies
  
  =item *
  
  better: allows SCALAR, ARRAY, and CODE references to source and sink I/O
  
  =item *
  
  better: I/O parameter order is like C<open3()>  (not like C<open2()>).
  
  =item *
  
  worse: does not allow interaction with the subprocess
  
  =back
  
  =head2 compared to L<IPC::Run::run()|IPC::Run/run>
  
  =over
  
  =item *
  
  better: smaller, lower overhead, simpler, more portable
  
  =item *
  
  better: no select() loop portability issues
  
  =item *
  
  better: does not fall prey to Perl closure leaks
  
  =item *
  
  worse: does not allow interaction with the subprocess (which IPC::Run::run()
  allows by redirecting subroutines)
  
  =item *
  
  worse: lacks many features of C<IPC::Run::run()> (filters, pipes, redirects,
  pty support)
  
  =back
  
  =head1 COPYRIGHT
  
  Copyright 2003, R. Barrie Slaymaker, Jr., All Rights Reserved
  
  =head1 LICENSE
  
  You may use this module under the terms of the BSD, Artistic, or GPL licenses,
  any version.
  
  =head1 AUTHOR
  
  Barrie Slaymaker E<lt>C<barries@slaysys.com>E<gt>
  
  Ricardo SIGNES E<lt>C<rjbs@cpan.org>E<gt> performed routine maintenance since
  2010, thanks to help from the following ticket and/or patch submitters: Jody
  Belka, Roderich Schupp, David Morel, Jeff Lavallee, and anonymous others.
  
  =cut
IPC_RUN3

$fatpacked{"IPC/Run3/ProfArrayBuffer.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'IPC_RUN3_PROFARRAYBUFFER';
  package IPC::Run3::ProfArrayBuffer;
  
  $VERSION = 0.048;
  
  =head1 NAME
  
  IPC::Run3::ProfArrayBuffer - Store profile events in RAM in an array
  
  =head1 SYNOPSIS
  
  =head1 DESCRIPTION
  
  =cut
  
  use strict;
  
  =head1 METHODS
  
  =over
  
  =item C<< IPC::Run3::ProfArrayBuffer->new() >>
  
  =cut
  
  sub new {
      my $class = ref $_[0] ? ref shift : shift;
  
      my $self = bless { @_ }, $class;
  
      $self->{Events} = [];
  
      return $self;
  }
  
  =item C<< $buffer->app_call(@events) >>
  
  =item C<< $buffer->app_exit(@events) >>
  
  =item C<< $buffer->run_exit(@events) >>
  
  The three above methods push the given events onto the stack of recorded
  events.
  
  =cut
  
  for my $subname ( qw(app_call app_exit run_exit) ) {
    no strict 'refs';
    *{$subname} = sub {
        push @{shift->{Events}}, [ $subname => @_ ];
    };
  }
  
  =item get_events
  
  Returns a list of all the events.  Each event is an ARRAY reference
  like:
  
     [ "app_call", 1.1, ... ];
  
  =cut
  
  sub get_events {
      my $self = shift;
      @{$self->{Events}};
  }
  
  =back
  
  =head1 LIMITATIONS
  
  =head1 COPYRIGHT
  
  Copyright 2003, R. Barrie Slaymaker, Jr., All Rights Reserved
  
  =head1 LICENSE
  
  You may use this module under the terms of the BSD, Artistic, or GPL licenses,
  any version.
  
  =head1 AUTHOR
  
  Barrie Slaymaker E<lt>barries@slaysys.comE<gt>
  
  =cut
  
  1;
IPC_RUN3_PROFARRAYBUFFER

$fatpacked{"IPC/Run3/ProfLogReader.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'IPC_RUN3_PROFLOGREADER';
  package IPC::Run3::ProfLogReader;
  
  $VERSION = 0.048;
  
  =head1 NAME
  
  IPC::Run3::ProfLogReader -  read and process a ProfLogger file
  
  =head1 SYNOPSIS
  
   use IPC::Run3::ProfLogReader;
  
   my $reader = IPC::Run3::ProfLogReader->new; ## use "run3.out"
   my $reader = IPC::Run3::ProfLogReader->new( Source => $fn );
  
   my $profiler = IPC::Run3::ProfPP;   ## For example
   my $reader   = IPC::Run3::ProfLogReader->new( ..., Handler => $p );
  
   $reader->read;
   $eaderr->read_all;
  
  =head1 DESCRIPTION
  
  Reads a log file.  Use the filename "-" to read from STDIN.
  
  =cut
  
  use strict;
  
  =head1 METHODS
  
  =head2 C<< IPC::Run3::ProfLogReader->new( ... ) >>
  
  =cut
  
  sub new {
      my $class = ref $_[0] ? ref shift : shift;
      my $self = bless { @_ }, $class;
      
      $self->{Source} = "run3.out"
          unless defined $self->{Source} && length $self->{Source};
  
      my $source = $self->{Source};
  
      if ( ref $source eq "GLOB" || UNIVERSAL::isa( $source, "IO::Handle" ) ) {
          $self->{FH} = $source;
      }
      elsif ( $source eq "-" ) {
          $self->{FH} = \*STDIN;
      }
      else {
          open PROFILE, "<$self->{Source}" or die "$!: $self->{Source}\n";
          $self->{FH} = *PROFILE{IO};
      }
      return $self;
  }
  
  
  =head2 C<< $reader->set_handler( $handler ) >>
  
  =cut
  
  sub set_handler { $_[0]->{Handler} = $_[1] }
  
  =head2 C<< $reader->get_handler() >>
  
  =cut
  
  sub get_handler { $_[0]->{Handler} }
  
  =head2 C<< $reader->read() >>
  
  =cut
  
  sub read {
      my $self = shift;
  
      my $fh = $self->{FH};
      my @ln = split / /, <$fh>;
  
      return 0 unless @ln;
      return 1 unless $self->{Handler};
  
      chomp $ln[-1];
  
      ## Ignore blank and comment lines.
      return 1 if @ln == 1 && ! length $ln[0] || 0 == index $ln[0], "#";
  
      if ( $ln[0] eq "\\app_call" ) {
          shift @ln;
          my @times = split /,/, pop @ln;
          $self->{Handler}->app_call(
              [
                  map {
                      s/\\\\/\\/g;
                      s/\\_/ /g;
                      $_;
                  } @ln
              ],
              @times
          );
      }
      elsif ( $ln[0] eq "\\app_exit" ) {
          shift @ln;
          $self->{Handler}->app_exit( pop @ln, @ln );
      }
      else {
          my @times = split /,/, pop @ln;
          $self->{Handler}->run_exit(
              [
                  map {
                      s/\\\\/\\/g;
                      s/\\_/ /g;
                      $_;
                  } @ln
              ],
              @times
          );
      }
  
      return 1;
  }
  
  
  =head2 C<< $reader->read_all() >>
  
  This method reads until there is nothing left to read, and then returns true.
  
  =cut
  
  sub read_all {
      my $self = shift;
  
      1 while $self->read;
  
      return 1;
  }
  
  
  =head1 LIMITATIONS
  
  =head1 COPYRIGHT
  
      Copyright 2003, R. Barrie Slaymaker, Jr., All Rights Reserved
  
  =head1 LICENSE
  
  You may use this module under the terms of the BSD, Artistic, or GPL licenses,
  any version.
  
  =head1 AUTHOR
  
  Barrie Slaymaker E<lt>barries@slaysys.comE<gt>
  
  =cut
  
  1;
IPC_RUN3_PROFLOGREADER

$fatpacked{"IPC/Run3/ProfLogger.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'IPC_RUN3_PROFLOGGER';
  package IPC::Run3::ProfLogger;
  
  $VERSION = 0.048;
  
  =head1 NAME
  
  IPC::Run3::ProfLogger - write profiling data to a log file
  
  =head1 SYNOPSIS
  
   use IPC::Run3::ProfLogger;
  
   my $logger = IPC::Run3::ProfLogger->new;  ## write to "run3.out"
   my $logger = IPC::Run3::ProfLogger->new( Destination => $fn );
  
   $logger->app_call( \@cmd, $time );
  
   $logger->run_exit( \@cmd1, @times1 );
   $logger->run_exit( \@cmd1, @times1 );
  
   $logger->app_exit( $time );
  
  =head1 DESCRIPTION
  
  Used by IPC::Run3 to write a profiling log file.  Does not
  generate reports or maintain statistics; its meant to have minimal
  overhead.
  
  Its API is compatible with a tiny subset of the other IPC::Run profiling
  classes.
  
  =cut
  
  use strict;
  
  =head1 METHODS
  
  =head2 C<< IPC::Run3::ProfLogger->new( ... ) >>
  
  =cut
  
  sub new {
      my $class = ref $_[0] ? ref shift : shift;
      my $self = bless { @_ }, $class;
      
      $self->{Destination} = "run3.out"
          unless defined $self->{Destination} && length $self->{Destination};
  
      open PROFILE, ">$self->{Destination}"
          or die "$!: $self->{Destination}\n";
      binmode PROFILE;
      $self->{FH} = *PROFILE{IO};
  
      $self->{times} = [];
      return $self;
  }
  
  =head2 C<< $logger->run_exit( ... ) >>
  
  =cut
  
  sub run_exit {
      my $self = shift;
      my $fh = $self->{FH};
      print( $fh
          join(
              " ",
              (
                  map {
                      my $s = $_;
                      $s =~ s/\\/\\\\/g;
                      $s =~ s/ /_/g;
                      $s;
                  } @{shift()}
              ),
              join(
                  ",",
                  @{$self->{times}},
                  @_,
              ),
          ),
          "\n"
      );
  }
  
  =head2 C<< $logger->app_exit( $arg ) >>
  
  =cut
  
  sub app_exit {
      my $self = shift;
      my $fh = $self->{FH};
      print $fh "\\app_exit ", shift, "\n";
  }
  
  =head2 C<< $logger->app_call( $t, @args) >>
  
  =cut
  
  sub app_call {
      my $self = shift;
      my $fh = $self->{FH};
      my $t = shift;
      print( $fh
          join(
              " ",
              "\\app_call",
              (
                  map {
                      my $s = $_;
                      $s =~ s/\\\\/\\/g;
                      $s =~ s/ /\\_/g;
                      $s;
                  } @_
              ),
              $t,
          ),
          "\n"
      );
  }
  
  =head1 LIMITATIONS
  
  =head1 COPYRIGHT
  
  Copyright 2003, R. Barrie Slaymaker, Jr., All Rights Reserved
  
  =head1 LICENSE
  
  You may use this module under the terms of the BSD, Artistic, or GPL licenses,
  any version.
  
  =head1 AUTHOR
  
  Barrie Slaymaker E<lt>barries@slaysys.comE<gt>
  
  =cut
  
  1;
IPC_RUN3_PROFLOGGER

$fatpacked{"IPC/Run3/ProfPP.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'IPC_RUN3_PROFPP';
  package IPC::Run3::ProfPP;
  
  $VERSION = 0.048;
  
  =head1 NAME
  
  IPC::Run3::ProfPP - Generate reports from IPC::Run3 profiling data
  
  =head1 SYNOPSIS
  
  =head1 DESCRIPTION
  
  Used by IPC::Run3 and/or run3profpp to print out profiling reports for
  human readers.  Use other classes for extracting data in other ways.
  
  The output methods are plain text, override these (see the source for
  now) to provide other formats.
  
  This class generates reports on each run3_exit() and app_exit() call.
  
  =cut
  
  require IPC::Run3::ProfReporter;
  @ISA = qw( IPC::Run3::ProfReporter );
  
  use strict;
  use POSIX qw( floor );
  
  =head1 METHODS
  
  =head2 C<< IPC::Run3::ProfPP->new() >>
  
  Returns a new profile reporting object.
  
  =cut
  
  sub _emit { shift; warn @_ }
  
  sub _t {
      sprintf "%10.6f secs", @_;
  }
  
  sub _r {
      my ( $num, $denom ) = @_;
      return () unless $denom;
      sprintf "%10.6f", $num / $denom;
  }
  
  sub _pct {
      my ( $num, $denom ) = @_;
      return () unless $denom;
      sprintf  " (%3d%%)", floor( 100 * $num / $denom + 0.5 );
  }
  
  =head2 C<< $profpp->handle_app_call() >>
  
  =cut
  
  sub handle_app_call {
      my $self = shift;
      $self->_emit("IPC::Run3 parent: ",
          join( " ", @{$self->get_app_cmd} ),
          "\n",
      );
  
      $self->{NeedNL} = 1;
  }
  
  =head2 C<< $profpp->handle_app_exit() >>
  
  =cut
  
  sub handle_app_exit {
      my $self = shift;
  
      $self->_emit("\n") if $self->{NeedNL} && $self->{NeedNL} != 1;
  
      $self->_emit( "IPC::Run3 total elapsed:             ",
          _t( $self->get_app_cumulative_time ),
          "\n");
      $self->_emit( "IPC::Run3 calls to run3():    ",
          sprintf( "%10d", $self->get_run_count ),
          "\n");
      $self->_emit( "IPC::Run3 total spent in run3():     ",
          _t( $self->get_run_cumulative_time ),
          _pct( $self->get_run_cumulative_time, $self->get_app_cumulative_time ),
          ", ",
          _r( $self->get_run_cumulative_time, $self->get_run_count ),
          " per call",
          "\n");
      my $exclusive = 
          $self->get_app_cumulative_time - $self->get_run_cumulative_time;
      $self->_emit( "IPC::Run3 total spent not in run3(): ",
          _t( $exclusive ),
          _pct( $exclusive, $self->get_app_cumulative_time ),
          "\n");
      $self->_emit( "IPC::Run3 total spent in children:   ",
          _t( $self->get_sys_cumulative_time ),
          _pct( $self->get_sys_cumulative_time, $self->get_app_cumulative_time ),
          ", ",
          _r( $self->get_sys_cumulative_time, $self->get_run_count ),
          " per call",
          "\n");
      my $overhead =
          $self->get_run_cumulative_time - $self->get_sys_cumulative_time;
      $self->_emit( "IPC::Run3 total overhead:            ",
          _t( $overhead ),
          _pct(
              $overhead,
              $self->get_sys_cumulative_time
          ),
          ", ",
          _r( $overhead, $self->get_run_count ),
          " per call",
          "\n");
  }
  
  =head2 C<< $profpp->handle_run_exit() >>
  
  =cut
  
  sub handle_run_exit {
      my $self = shift;
      my $overhead = $self->get_run_time - $self->get_sys_time;
  
      $self->_emit("\n") if $self->{NeedNL} && $self->{NeedNL} != 2;
      $self->{NeedNL} = 3;
  
      $self->_emit( "IPC::Run3 child: ",
          join( " ", @{$self->get_run_cmd} ),
          "\n");
      $self->_emit( "IPC::Run3 run3()  : ", _t( $self->get_run_time ), "\n",
           "IPC::Run3 child   : ", _t( $self->get_sys_time ), "\n",
           "IPC::Run3 overhead: ", _t( $overhead ),
               _pct( $overhead, $self->get_sys_time ),
               "\n");
  }
  
  =head1 LIMITATIONS
  
  =head1 COPYRIGHT
  
      Copyright 2003, R. Barrie Slaymaker, Jr., All Rights Reserved
  
  =head1 LICENSE
  
  You may use this module under the terms of the BSD, Artistic, or GPL licenses,
  any version.
  
  =head1 AUTHOR
  
  Barrie Slaymaker E<lt>barries@slaysys.comE<gt>
  
  =cut
  
  1;
IPC_RUN3_PROFPP

$fatpacked{"IPC/Run3/ProfReporter.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'IPC_RUN3_PROFREPORTER';
  package IPC::Run3::ProfReporter;
  
  $VERSION = 0.048;
  
  =head1 NAME
  
  IPC::Run3::ProfReporter - base class for handling profiling data
  
  =head1 SYNOPSIS
  
  =head1 DESCRIPTION
  
  See L<IPC::Run3::ProfPP|IPC::Run3::ProfPP> and for an example subclass.
  
  This class just notes and accumulates times; subclasses use methods like
  "handle_app_call", "handle_run_exit" and "handle_app_exit" to emit reports on
  it.  The default methods for these handlers are noops.
  
  If run from the command line, a reporter will be created and run on
  each logfile given as a command line parameter or on run3.out if none
  are given.
  
  This allows reports to be run like:
  
      perl -MIPC::Run3::ProfPP -e1
      perl -MIPC::Run3::ProfPP -e1 foo.out bar.out
  
  Use "-" to read from STDIN (the log file format is meant to be moderately
  greppable):
  
      grep "^cvs " run3.out perl -MIPC::Run3::ProfPP -e1 -
  
  Use --app to show only application level statistics (ie don't emit
  a report section for each command run).
  
  =cut
  
  use strict;
  
  my $loaded_by;
  
  sub import {
      $loaded_by = shift;
  }
  
  END {
      my @caller;
      for ( my $i = 0;; ++$i ) {
          my @c = caller $i;
          last unless @c;
          @caller = @c;
      }
  
      if ( $caller[0] eq "main"
          && $caller[1] eq "-e"
      ) {
          require IPC::Run3::ProfLogReader;
          require Getopt::Long;
          my ( $app, $run );
  
          Getopt::Long::GetOptions(
              "app" => \$app,
              "run" => \$run,
          );
  
          $app = 1, $run = 1 unless $app || $run;
  
          for ( @ARGV ? @ARGV : "" ) {
              my $r = IPC::Run3::ProfLogReader->new(
                  Source  => $_,
                  Handler => $loaded_by->new(
                      Source => $_,
                      app_report => $app,
                      run_report => $run,
                  ),
              );
              $r->read_all;
          }
      }
  }
  
  =head1 METHODS
  
  =over
  
  =item C<< IPC::Run3::ProfReporter->new >>
  
  Returns a new profile reporting object.
  
  =cut
  
  sub new {
      my $class = ref $_[0] ? ref shift : shift;
      my $self = bless { @_ }, $class;
      $self->{app_report} = 1, $self->{run_report} = 1
          unless $self->{app_report} || $self->{run_report};
  
      return $self;
  }
  
  =item C<< $reporter->handle_app_call( ... ) >>
  
  =item C<< $reporter->handle_app_exit( ... ) >>
  
  =item C<< $reporter->handle_run_exit( ... ) >>
  
  These methods are called by the handled events (see below).
  
  =cut
  
  sub handle_app_call {}
  sub handle_app_exit {}
  
  sub handle_run_exit {}
  
  =item C<< $reporter->app_call(\@cmd, $time) >>
  
  =item C<< $reporter->app_exit($time) >>
  
  =item C<< $reporter->run_exit(@times) >>
  
     $self->app_call( $time );
     my $time = $self->get_app_call_time;
  
  Sets the time (in floating point seconds) when the application, run3(),
  or system() was called or exited.  If no time parameter is passed, uses
  IPC::Run3's time routine.
  
  Use get_...() to retrieve these values (and _accum values, too).  This
  is a separate method to speed the execution time of the setters just a
  bit.
  
  =cut
  
  sub app_call {
      my $self = shift;
      ( $self->{app_cmd}, $self->{app_call_time} ) = @_;
      $self->handle_app_call if $self->{app_report};
  }
  
  sub app_exit {
      my $self = shift;
      $self->{app_exit_time} = shift;
      $self->handle_app_exit if $self->{app_report};
  }
  
  sub run_exit {
      my $self = shift;
      @{$self}{qw(
          run_cmd run_call_time sys_call_time sys_exit_time run_exit_time
      )} = @_;
  
      ++$self->{run_count};
      $self->{run_cumulative_time} += $self->get_run_time;
      $self->{sys_cumulative_time} += $self->get_sys_time;
      $self->handle_run_exit if $self->{run_report};
  }
  
  =item C<< $reporter->get_run_count() >>
  
  =item C<< $reporter->get_app_call_time() >>
  
  =item C<< $reporter->get_app_exit_time() >>
  
  =item C<< $reporter->get_app_cmd() >>
  
  =item C<< $reporter->get_app_time() >>
  
  =cut
  
  sub get_run_count     { shift->{run_count} }
  sub get_app_call_time { shift->{app_call_time} }
  sub get_app_exit_time { shift->{app_exit_time} }
  sub get_app_cmd       { shift->{app_cmd}       }
  sub get_app_time {
      my $self = shift;
      $self->get_app_exit_time - $self->get_app_call_time;
  }
  
  =item C<< $reporter->get_app_cumulative_time() >>
  
  =cut
  
  sub get_app_cumulative_time {
      my $self = shift;
      $self->get_app_exit_time - $self->get_app_call_time;
  }
  
  =item C<< $reporter->get_run_call_time() >>
  
  =item C<< $reporter->get_run_exit_time() >>
  
  =item C<< $reporter->get_run_time() >>
  
  =cut
  
  sub get_run_call_time { shift->{run_call_time} }
  sub get_run_exit_time { shift->{run_exit_time} }
  sub get_run_time {
      my $self = shift;
      $self->get_run_exit_time - $self->get_run_call_time;
  }
  
  =item C<< $reporter->get_run_cumulative_time() >>
  
  =cut
  
  sub get_run_cumulative_time { shift->{run_cumulative_time} }
  
  =item C<< $reporter->get_sys_call_time() >>
  
  =item C<< $reporter->get_sys_exit_time() >>
  
  =item C<< $reporter->get_sys_time() >>
  
  =cut
  
  sub get_sys_call_time { shift->{sys_call_time} }
  sub get_sys_exit_time { shift->{sys_exit_time} }
  sub get_sys_time {
      my $self = shift;
      $self->get_sys_exit_time - $self->get_sys_call_time;
  }
  
  =item C<< $reporter->get_sys_cumulative_time() >>
  
  =cut
  
  sub get_sys_cumulative_time { shift->{sys_cumulative_time} }
  
  =item C<< $reporter->get_run_cmd() >>
  
  =cut
  
  sub get_run_cmd { shift->{run_cmd} }
  
  =back
  
  =head1 LIMITATIONS
  
  =head1 COPYRIGHT
  
      Copyright 2003, R. Barrie Slaymaker, Jr., All Rights Reserved
  
  =head1 LICENSE
  
  You may use this module under the terms of the BSD, Artistic, or GPL licenses,
  any version.
  
  =head1 AUTHOR
  
  Barrie Slaymaker <barries@slaysys.com>
  
  =cut
  
  1;
IPC_RUN3_PROFREPORTER

$fatpacked{"YAML/PP.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'YAML_PP';
  # ABSTRACT: YAML 1.2 Processor
  use strict;
  use warnings;
  package YAML::PP;
  
  our $VERSION = '0.027'; # VERSION
  
  use YAML::PP::Schema;
  use YAML::PP::Schema::JSON;
  use YAML::PP::Loader;
  use YAML::PP::Dumper;
  use Scalar::Util qw/ blessed /;
  use Carp qw/ croak /;
  
  use base 'Exporter';
  our @EXPORT_OK = qw/ Load LoadFile Dump DumpFile /;
  
  my %YAML_VERSIONS = ('1.1' => 1, '1.2' => 1);
  
  
  sub new {
      my ($class, %args) = @_;
  
      my $bool = delete $args{boolean};
      $bool = 'perl' unless defined $bool;
      my $schemas = delete $args{schema} || ['+'];
      my $cyclic_refs = delete $args{cyclic_refs} || 'allow';
      my $indent = delete $args{indent};
      my $width = delete $args{width};
      my $writer = delete $args{writer};
      my $header = delete $args{header};
      my $footer = delete $args{footer};
      my $duplicate_keys = delete $args{duplicate_keys};
      my $yaml_version = $class->_arg_yaml_version(delete $args{yaml_version});
      my $default_yaml_version = $yaml_version->[0];
      my $version_directive = delete $args{version_directive};
      my $preserve = delete $args{preserve};
      my $parser = delete $args{parser};
      my $emitter = delete $args{emitter} || {
          indent => $indent,
          width => $width,
          writer => $writer,
      };
      if (keys %args) {
          die "Unexpected arguments: " . join ', ', sort keys %args;
      }
  
      my %schemas;
      for my $v (@$yaml_version) {
          my $schema;
          if (blessed($schemas) and $schemas->isa('YAML::PP::Schema')) {
              $schema = $schemas;
          }
          else {
              $schema = YAML::PP::Schema->new(
                  boolean => $bool,
                  yaml_version => $v,
              );
              $schema->load_subschemas(@$schemas);
          }
          $schemas{ $v } = $schema;
      }
      my $default_schema = $schemas{ $default_yaml_version };
  
      my $loader = YAML::PP::Loader->new(
          schemas => \%schemas,
          cyclic_refs => $cyclic_refs,
          parser => $parser,
          default_yaml_version => $default_yaml_version,
          preserve => $preserve,
          duplicate_keys => $duplicate_keys,
      );
      my $dumper = YAML::PP::Dumper->new(
          schema => $default_schema,
          emitter => $emitter,
          header => $header,
          footer => $footer,
          version_directive => $version_directive,
          preserve => $preserve,
      );
  
      my $self = bless {
          schema => \%schemas,
          loader => $loader,
          dumper => $dumper,
      }, $class;
      return $self;
  }
  
  sub clone {
      my ($self) = @_;
      my $clone = {
          schema => $self->schema,
          loader => $self->loader->clone,
          dumper => $self->dumper->clone,
      };
      return bless $clone, ref $self;
  }
  
  sub _arg_yaml_version {
      my ($class, $version) = @_;
      my @versions = ('1.2');
      if (defined $version) {
          @versions = ();
          if (not ref $version) {
              $version = [$version];
          }
          for my $v (@$version) {
              unless ($YAML_VERSIONS{ $v }) {
                  croak "YAML Version '$v' not supported";
              }
              push @versions, $v;
          }
      }
      return \@versions;
  }
  
  
  sub loader {
      if (@_ > 1) {
          $_[0]->{loader} = $_[1]
      }
      return $_[0]->{loader};
  }
  
  sub dumper {
      if (@_ > 1) {
          $_[0]->{dumper} = $_[1]
      }
      return $_[0]->{dumper};
  }
  
  sub schema {
      if (@_ > 1) { $_[0]->{schema}->{'1.2'} = $_[1] }
      return $_[0]->{schema}->{'1.2'};
  }
  
  sub default_schema {
      my ($self, %args) = @_;
      my $schema = YAML::PP::Schema->new(
          boolean => $args{boolean},
      );
      $schema->load_subschemas(qw/ Core /);
      return $schema;
  }
  
  sub load_string {
      my ($self, $yaml) = @_;
      return $self->loader->load_string($yaml);
  }
  
  sub load_file {
      my ($self, $file) = @_;
      return $self->loader->load_file($file);
  }
  
  sub dump {
      my ($self, @data) = @_;
      return $self->dumper->dump(@data);
  }
  
  sub dump_string {
      my ($self, @data) = @_;
      return $self->dumper->dump_string(@data);
  }
  
  sub dump_file {
      my ($self, $file, @data) = @_;
      return $self->dumper->dump_file($file, @data);
  }
  
  # legagy interface
  sub Load {
      my ($yaml) = @_;
      YAML::PP->new->load_string($yaml);
  }
  
  sub LoadFile {
      my ($file) = @_;
      YAML::PP->new->load_file($file);
  }
  
  sub Dump {
      my (@data) = @_;
      YAML::PP->new->dump_string(@data);
  }
  
  sub DumpFile {
      my ($file, @data) = @_;
      YAML::PP->new->dump_file($file, @data);
  }
  
  sub preserved_scalar {
      my ($self, $value, %args) = @_;
      my $scalar = YAML::PP::Preserve::Scalar->new(
          value => $value,
          %args,
      );
      return $scalar;
  }
  
  sub preserved_mapping {
      my ($self, $hash, %args) = @_;
      my $data = {};
      tie %$data, 'YAML::PP::Preserve::Hash';
      %$data = %$hash;
      my $t = tied %$data;
      $t->{style} = $args{style};
      $t->{alias} = $args{alias};
      return $data;
  }
  
  sub preserved_sequence {
      my ($self, $array, %args) = @_;
      my $data = [];
      tie @$data, 'YAML::PP::Preserve::Array';
      push @$data, @$array;
      my $t = tied @$data;
      $t->{style} = $args{style};
      $t->{alias} = $args{alias};
      return $data;
  }
  
  package YAML::PP::Preserve::Hash;
  # experimental
  use Tie::Hash;
  use base qw/ Tie::StdHash /;
  
  sub TIEHASH {
      my ($class) = @_;
      my $self = bless {
          keys => [],
          data => {},
      }, $class;
  }
  
  sub STORE {
      my ($self, $key, $val) = @_;
      my $keys = $self->{keys};
      unless (exists $self->{data}->{ $key }) {
          push @$keys, $key;
      }
      $self->{data}->{ $key } = $val;
  }
  
  sub FIRSTKEY {
      my ($self) = @_;
      return $self->{keys}->[0];
  }
  
  sub NEXTKEY {
      my ($self, $last) = @_;
      my $keys = $self->{keys};
      for my $i (0 .. $#$keys) {
          if ("$keys->[ $i ]" eq "$last") {
              return $keys->[ $i + 1 ];
          }
      }
      return;
  }
  
  sub FETCH {
      my ($self, $key) = @_;
      my $val = $self->{data}->{ $key };
  }
  
  sub DELETE {
      my ($self, $key) = @_;
      @{ $self->{keys} } = grep { "$_" ne "$key" } @{ $self->{keys} };
      delete $self->{data}->{ $key };
  }
  
  sub EXISTS {
      my ($self, $key) = @_;
      return exists $self->{data}->{ $key };
  }
  
  sub CLEAR {
      my ($self) = @_;
      $self->{keys} = [];
      $self->{data} = {};
  }
  
  sub SCALAR {
      my ($self) = @_;
      return scalar %{ $self->{data} };
  }
  
  package YAML::PP::Preserve::Array;
  # experimental
  use Tie::Array;
  use base qw/ Tie::StdArray /;
  
  sub TIEARRAY {
      my ($class) = @_;
      my $self = bless {
          data => [],
      }, $class;
      return $self;
  }
  
  sub FETCH {
      my ($self, $i) = @_;
      return $self->{data}->[ $i ];
  }
  sub FETCHSIZE {
      my ($self) = @_;
      return $#{ $self->{data} } + 1;
  }
  
  sub STORE {
      my ($self, $i, $val) = @_;
      $self->{data}->[ $i ] = $val;
  }
  sub PUSH {
      my ($self, @args) = @_;
      push @{ $self->{data} }, @args;
  }
  sub STORESIZE {
      my ($self, $i) = @_;
      $#{ $self->{data} } = $i - 1;
  }
  sub DELETE {
      my ($self, $i) = @_;
      delete $self->{data}->[ $i ];
  }
  sub EXISTS {
      my ($self, $i) = @_;
      return exists $self->{data}->[ $i ];
  }
  sub CLEAR {
      my ($self) = @_;
      $self->{data} = [];
  }
  sub SHIFT {
      my ($self) = @_;
      shift @{ $self->{data} };
  }
  sub UNSHIFT {
      my ($self, @args) = @_;
      unshift @{ $self->{data} }, @args;
  }
  sub SPLICE {
      my ($self, $offset, $length, @args) = @_;
      splice @{ $self->{data} }, $offset, $length, @args;
  }
  sub EXTEND {}
  
  
  package YAML::PP::Preserve::Scalar;
  
  use overload
      fallback => 1,
      '+' => \&value,
      '""' => \&value,
      'bool' => \&value,
      ;
  sub new {
      my ($class, %args) = @_;
      my $self = {
          %args,
      };
      bless $self, $class;
  }
  sub value { $_[0]->{value} }
  sub tag { $_[0]->{tag} }
  sub style { $_[0]->{style} || 0 }
  sub alias { $_[0]->{alias} }
  
  1;
  
  __END__
  
  =pod
  
  =encoding utf-8
  
  =head1 NAME
  
  YAML::PP - YAML 1.2 processor
  
  =head1 SYNOPSIS
  
  WARNING: Most of the inner API is not stable yet.
  
  Here are a few examples of the basic load and dump methods:
  
      use YAML::PP;
      my $ypp = YAML::PP->new;
  
      my $yaml = <<'EOM';
      --- # Document one is a mapping
      name: Tina
      age: 29
      favourite language: Perl
  
      --- # Document two is a sequence
      - plain string
      - 'in single quotes'
      - "in double quotes we have escapes! like \t and \n"
      - | # a literal block scalar
        line1
        line2
      - > # a folded block scalar
        this is all one
        single line because the
        linebreaks will be folded
      EOM
  
      my @documents = $ypp->load_string($yaml);
      my @documents = $ypp->load_file($filename);
  
      my $yaml = $ypp->dump_string($data1, $data2);
      $ypp->dump_file($filename, $data1, $data2);
  
      # The loader offers JSON::PP::Boolean, boolean.pm or
      # perl 1/'' (currently default) for booleans
      my $ypp = YAML::PP->new(boolean => 'JSON::PP');
      my $ypp = YAML::PP->new(boolean => 'boolean');
      my $ypp = YAML::PP->new(boolean => 'perl');
  
      # Enable perl data types and objects
      my $ypp = YAML::PP->new(schema => [qw/ + Perl /]);
      my $yaml = $yp->dump_string($data_with_perl_objects);
  
      # Legacy interface
      use YAML::PP qw/ Load Dump LoadFile DumpFile /;
      my @documents = Load($yaml);
      my @documents = LoadFile($filename);
      my @documents = LoadFile($filehandle);
      my $yaml = = Dump(@documents);
      DumpFile($filename, @documents);
      DumpFile($filenhandle @documents);
  
  
  Some utility scripts, mostly useful for debugging:
  
      # Load YAML into a data structure and dump with Data::Dumper
      yamlpp-load < file.yaml
  
      # Load and Dump
      yamlpp-load-dump < file.yaml
  
      # Print the events from the parser in yaml-test-suite format
      yamlpp-events < file.yaml
  
      # Parse and emit events directly without loading
      yamlpp-parse-emit < file.yaml
  
      # Create ANSI colored YAML. Can also be useful for invalid YAML, showing
      # you the exact location of the error
      yamlpp-highlight < file.yaml
  
  
  =head1 DESCRIPTION
  
  YAML::PP is a modular YAML processor.
  
  It aims to support C<YAML 1.2> and C<YAML 1.1>. See L<https://yaml.org/>.
  Some (rare) syntax elements are not yet supported and documented below.
  
  YAML is a serialization language. The YAML input is called "YAML Stream".
  A stream consists of one or more "Documents", separated by a line with a
  document start marker C<--->. A document optionally ends with the document
  end marker C<...>.
  
  This allows one to process continuous streams additionally to a fixed input
  file or string.
  
  The YAML::PP frontend will currently load all documents, and return only
  the first if called with scalar context.
  
  The YAML backend is implemented in a modular way that allows one to add
  custom handling of YAML tags, perl objects and data types. The inner API
  is not yet stable. Suggestions welcome.
  
  You can check out all current parse and load results from the
  yaml-test-suite here:
  L<https://perlpunk.github.io/YAML-PP-p5/test-suite.html>
  
  
  =head1 METHODS
  
  =head2 new
  
      my $ypp = YAML::PP->new;
      # load booleans via boolean.pm
      my $ypp = YAML::PP->new( boolean => 'boolean' );
      # load booleans via JSON::PP::true/false
      my $ypp = YAML::PP->new( boolean => 'JSON::PP' );
      
      # use YAML 1.2 Failsafe Schema
      my $ypp = YAML::PP->new( schema => ['Failsafe'] );
      # use YAML 1.2 JSON Schema
      my $ypp = YAML::PP->new( schema => ['JSON'] );
      # use YAML 1.2 Core Schema
      my $ypp = YAML::PP->new( schema => ['Core'] );
      
      # Die when detecting cyclic references
      my $ypp = YAML::PP->new( cyclic_refs => 'fatal' );
      
      my $ypp = YAML::PP->new(
          boolean => 'JSON::PP',
          schema => ['Core'],
          cyclic_refs => 'fatal',
          indent => 4,
          header => 1,
          footer => 1,
          version_directive => 1,
      );
  
  Options:
  
  =over
  
  =item boolean
  
  Values: C<perl> (currently default), C<JSON::PP>, C<boolean>
  
  This option is for loading and dumping.
  
  Note that when dumping, only the chosen boolean style will be recognized.
  So if you choose C<JSON::PP>, C<boolean> objects will not be recognized
  as booleans and will be dumped as ordinary objects (if you enable the
  Perl schema).
  
  =item schema
  
  Default: C<['Core']>
  
  This option is for loading and dumping.
  
  Array reference. Here you can define what schema to use.
  Supported standard Schemas are: C<Failsafe>, C<JSON>, C<Core>, C<YAML1_1>.
  
  To get an overview how the different Schemas behave, see
  L<https://perlpunk.github.io/YAML-PP-p5/schemas.html>
  
  Additionally you can add further schemas, for example C<Merge>.
  
  =item cyclic_refs
  
  Default: 'allow' but will be switched to fatal in the future for safety!
  
  This option is for loading only.
  
  Defines what to do when a cyclic reference is detected when loading.
  
      # fatal  - die
      # warn   - Just warn about them and replace with undef
      # ignore - replace with undef
      # allow  - Default
  
  =item duplicate_keys
  
  Default: 0
  
  Since version 0.027
  
  This option is for loading.
  
  The YAML Spec says duplicate mapping keys should be forbidden.
  
  When set to true, duplicate keys in mappings are allowed (and will overwrite
  the previous key).
  
  When set to false, duplicate keys will result in an error when loading.
  
  This is especially useful when you have a longer mapping and don't see
  the duplicate key in your editor:
  
      ---
      a: 1
      b: 2
      # .............
      a: 23 # error
  
  =item indent
  
  Default: 2
  
  This option is for dumping.
  
  Use that many spaces for indenting
  
  =item width
  
  Since version 0.025
  
  Default: 80
  
  This option is for dumping.
  
  Maximum columns when dumping.
  
  This is only respected when dumping flow collections right now.
  
  in the future it will be used also for wrapping long strings.
  
  =item header
  
  Default: 1
  
  This option is for dumping.
  
  Print document header C<--->
  
  =item footer
  
  Default: 0
  
  This option is for dumping.
  
  Print document footer C<...>
  
  =item yaml_version
  
  Since version 0.020
  
  This option is for loading and dumping.
  
  Default: C<1.2>
  
  Note that in this case, a directive C<%YAML 1.1> will basically be ignored
  and everything loaded with the C<1.2 Core> Schema.
  
  If you want to support both YAML 1.1 and 1.2, you have to specify that, and the
  schema (C<Core> or C<YAML1_1>) will be chosen automatically.
  
      my $yp = YAML::PP->new(
          yaml_version => ['1.2', '1.1'],
      );
  
  This is the same as
  
      my $yp = YAML::PP->new(
          schema => ['+'],
          yaml_version => ['1.2', '1.1'],
      );
  
  because the C<+> stands for the default schema per version.
  
  When loading, and there is no C<%YAML> directive, C<1.2> will be considered
  as default, and the C<Core> schema will be used.
  
  If there is a C<%YAML 1.1> directive, the C<YAML1_1> schema will be used.
  
  Of course, you can also make C<1.1> the default:
  
      my $yp = YAML::PP->new(
          yaml_version => ['1.1', '1.2'],
      );
  
  
  You can also specify C<1.1> only:
  
      my $yp = YAML::PP->new(
          yaml_version => ['1.1'],
      );
  
  In this case also documents with C<%YAML 1.2> will be loaded with the C<YAML1_1>
  schema.
  
  =item version_directive
  
  Since version 0.020
  
  This option is for dumping.
  
  Default: 0
  
  Print Version Directive C<%YAML 1.2> (or C<%YAML 1.1>) on top of each YAML
  document. It will use the first version specified in the C<yaml_version> option.
  
  =item preserve
  
  Since version 0.021
  
  Default: false
  
  This option is for loading and dumping.
  
  Preserving scalar styles is still experimental.
  
      use YAML::PP::Common qw/ PRESERVE_ORDER PRESERVE_SCALAR_STYLE /;
  
      # Preserve the order of hash keys
      my $yp = YAML::PP->new( preserve => PRESERVE_ORDER );
  
      # Preserve the quoting style of scalars
      my $yp = YAML::PP->new( preserve => PRESERVE_SCALAR_STYLE );
  
      # Preserve block/flow style (since 0.024)
      my $yp = YAML::PP->new( preserve => PRESERVE_FLOW_STYLE );
  
      # Preserve alias names (since 0.027)
      my $yp = YAML::PP->new( preserve => PRESERVE_ALIAS );
  
      # Combine, e.g. preserve order and scalar style
      my $yp = YAML::PP->new( preserve => PRESERVE_ORDER | PRESERVE_SCALAR_STYLE );
  
  Do NOT rely on the internal implementation of it.
  
  If you load the following input:
  
      ---
      z: 1
      a: 2
      ---
      - plain
      - 'single'
      - "double"
      - |
        literal
      ---
      block mapping: &alias
        flow sequence: [a, b]
      same mapping: *alias
      flow mapping: {a: b}
  
  
  with this code:
  
      my $yp = YAML::PP->new(
          preserve => PRESERVE_ORDER | PRESERVE_SCALAR_STYLE
                      | PRESERVE_FLOW_STYLE | PRESERVE_ALIAS
      );
      my ($hash, $styles, $flow) = $yp->load_file($file);
      $yp->dump_file($hash, $styles, $flow);
  
  Then dumping it will return the same output.
  Only folded block scalars '>' cannot preserve the style yet.
  
  Note that YAML allows repeated definition of anchors. They cannot be preserved
  with YAML::PP right now. Example:
  
      ---
      - &seq [a]
      - *seq
      - &seq [b]
      - *seq
  
  Because the data could be shuffled before dumping again, the anchor definition
  could be broken. In this case repeated anchor names will be discarded when
  loading and dumped with numeric anchors like usual.
  
  Implementation:
  
  When loading, hashes will be tied to an internal class
  (C<YAML::PP::Preserve::Hash>) that keeps the key order.
  
  Scalars will be returned as objects of an internal class
  (C<YAML::PP::Preserve::Scalar>) with overloading. If you assign to such
  a scalar, the object will be replaced by a simple scalar.
  
      # assignment, style gets lost
      $styles->[1] .= ' append';
  
  You can also pass C<1> as a value. In this case all preserving options will be
  enabled, also if there are new options added in the future.
  
  There are also methods to create preserved nodes from scratch. See the
  C<preserved_(scalar|mapping|sequence)> L<"METHODS"> below.
  
  =back
  
  =head2 load_string
  
      my $doc = $ypp->load_string("foo: bar");
      my @docs = $ypp->load_string("foo: bar\n---\n- a");
  
  Input should be Unicode characters.
  
  So if you read from a file, you should decode it, for example with
  C<Encode::decode()>.
  
  Note that in scalar context, C<load_string> and C<load_file> return the first
  document (like L<YAML::Syck>), while L<YAML> and L<YAML::XS> return the
  last.
  
  =head2 load_file
  
      my $doc = $ypp->load_file("file.yaml");
      my @docs = $ypp->load_file("file.yaml");
  
  Strings will be loaded as unicode characters.
  
  =head2 dump_string
  
      my $yaml = $ypp->dump_string($doc);
      my $yaml = $ypp->dump_string($doc1, $doc2);
      my $yaml = $ypp->dump_string(@docs);
  
  Input strings should be Unicode characters.
  
  Output will return Unicode characters.
  
  So if you want to write that to a file (or pass to YAML::XS, for example),
  you typically encode it via C<Encode::encode()>.
  
  =head2 dump_file
  
      $ypp->dump_file("file.yaml", $doc);
      $ypp->dump_file("file.yaml", $doc1, $doc2);
      $ypp->dump_file("file.yaml", @docs);
  
  Input data should be Unicode characters.
  
  =head2 dump
  
  This will dump to a predefined writer. By default it will just use the
  L<YAML::PP::Writer> and output a string.
  
      my $writer = MyWriter->new(\my $output);
      my $yp = YAML::PP->new(
          writer => $writer,
      );
      $yp->dump($data);
  
  =head2 preserved_scalar
  
  Since version 0.024
  
  Experimental. Please report bugs or let me know this is useful and works.
  
  You can define a certain scalar style when dumping data.
  Figuring out the best style is a hard task and practically impossible to get
  it right for all cases. It's also a matter of taste.
  
      use YAML::PP::Common qw/ PRESERVE_SCALAR_STYLE /;
      my $yp = YAML::PP->new(
          preserve => PRESERVE_SCALAR_STYLE,
      );
      # a single linebreak would normally be dumped with double quotes: "\n"
      my $scalar = $yp->preserved_scalar("\n", style => YAML_LITERAL_SCALAR_STYLE );
  
      my $data = { literal => $scalar };
      my $dump = $yp->dump_string($data);
      # output
      ---
      literal: |+
  
      ...
  
  
  =head2 preserved_mapping, preserved_sequence
  
  Since version 0.024
  
  Experimental. Please report bugs or let me know this is useful and works.
  
  With this you can define which nodes are dumped with the more compact flow
  style instead of block style.
  
  If you add C<PRESERVE_ORDER> to the C<preserve> option, it will also keep the
  order of the keys in a hash.
  
      use YAML::PP::Common qw/ PRESERVE_ORDER PRESERVE_FLOW_STYLE /;
      my $yp = YAML::PP->new(
          preserve => PRESERVE_FLOW_STYLE | PRESERVE_ORDER
      );
  
      my $hash = $yp->preserved_mapping({}, style => YAML_FLOW_MAPPING_STYLE);
      # Add values after initialization to preserve order
      %$hash = (z => 1, a => 2, y => 3, b => 4);
  
      my $array = $yp->preserved_sequence([23, 24], style => YAML_FLOW_SEQUENCE_STYLE);
  
      my $data = $yp->preserved_mapping({});
      %$data = ( map => $hash, seq => $array );
  
      my $dump = $yp->dump_string($data);
      # output
      ---
      map: {z: 1, a: 2, y: 3, b: 4}
      seq: [23, 24]
  
  
  =head2 loader
  
  Returns or sets the loader object, by default L<YAML::PP::Loader>
  
  =head2 dumper
  
  Returns or sets the dumper object, by default L<YAML::PP::Dumper>
  
  =head2 schema
  
  Returns or sets the schema object
  
  =head2 default_schema
  
  Creates and returns the default schema
  
  =head1 FUNCTIONS
  
  The functions C<Load>, C<LoadFile>, C<Dump> and C<DumpFile> are provided
  as a drop-in replacement for other existing YAML processors.
  No function is exported by default.
  
  Note that in scalar context, C<Load> and C<LoadFile> return the first
  document (like L<YAML::Syck>), while L<YAML> and L<YAML::XS> return the
  last.
  
  =over
  
  =item Load
  
      use YAML::PP qw/ Load /;
      my $doc = Load($yaml);
      my @docs = Load($yaml);
  
  Works like C<load_string>.
  
  =item LoadFile
  
      use YAML::PP qw/ LoadFile /;
      my $doc = LoadFile($file);
      my @docs = LoadFile($file);
      my @docs = LoadFile($filehandle);
  
  Works like C<load_file>.
  
  =item Dump
  
      use YAML::PP qw/ Dump /;
      my $yaml = Dump($doc);
      my $yaml = Dump(@docs);
  
  Works like C<dump_string>.
  
  =item DumpFile
  
      use YAML::PP qw/ DumpFile /;
      DumpFile($file, $doc);
      DumpFile($file, @docs);
      DumpFile($filehandle, @docs);
  
  Works like C<dump_file>.
  
  =back
  
  =head1 PLUGINS
  
  You can alter the behaviour of YAML::PP by using the following schema
  classes:
  
  =over
  
  =item L<YAML::PP::Schema::Failsafe>
  
  One of the three YAML 1.2 official schemas
  
  =item L<YAML::PP::Schema::JSON>
  
  One of the three YAML 1.2 official schemas.
  
  =item L<YAML::PP::Schema::Core>
  
  One of the three YAML 1.2 official schemas. Default
  
  =item L<YAML::PP::Schema::YAML1_1>
  
  Schema implementing the most common YAML 1.1 types
  
  =item L<YAML::PP::Schema::Perl>
  
  Serializing Perl objects and types
  
  =item L<YAML::PP::Schema::Binary>
  
  Serializing binary data
  
  =item L<YAML::PP::Schema::Tie::IxHash>
  
  Deprecated. See option C<preserve>
  
  =item L<YAML::PP::Schema::Merge>
  
  YAML 1.1 merge keys for mappings
  
  =item L<YAML::PP::Schema::Include>
  
  Include other YAML files via C<!include> tags
  
  =back
  
  To make the parsing process faster, you can plugin the libyaml parser
  with L<YAML::PP::LibYAML>.
  
  
  
  =head1 IMPLEMENTATION
  
  The process of loading and dumping is split into the following steps:
  
      Load:
  
      YAML Stream        Tokens        Event List        Data Structure
                --------->    --------->        --------->
                  lex           parse           construct
  
  
      Dump:
  
      Data Structure       Event List        YAML Stream
                  --------->        --------->
                  represent           emit
  
  
  You can dump basic perl types like hashes, arrays, scalars (strings, numbers).
  For dumping blessed objects and things like coderefs have a look at
  L<YAML::PP::Perl>/L<YAML::PP::Schema::Perl>.
  
  =over
  
  =item L<YAML::PP::Lexer>
  
  The Lexer is reading the YAML stream into tokens. This makes it possible
  to generate syntax highlighted YAML output.
  
  Note that the API to retrieve the tokens will change.
  
  =item L<YAML::PP::Parser>
  
  The Parser retrieves the tokens from the Lexer. The main YAML content is then
  parsed with the Grammar.
  
  =item L<YAML::PP::Grammar>
  
  =item L<YAML::PP::Constructor>
  
  The Constructor creates a data structure from the Parser events.
  
  =item L<YAML::PP::Loader>
  
  The Loader combines the constructor and parser.
  
  =item L<YAML::PP::Dumper>
  
  The Dumper will delegate to the Representer
  
  =item L<YAML::PP::Representer>
  
  The Representer will create Emitter events from the given data structure.
  
  =item L<YAML::PP::Emitter>
  
  The Emitter creates a YAML stream.
  
  =back
  
  =head2 YAML::PP::Parser
  
  Still TODO:
  
  =over 4
  
  =item Implicit collection keys
  
      ---
      [ a, b, c ]: value
  
  =item Implicit mapping in flow style sequences
  
      ---
      [ a, b, c: d ]
      # equals
      [ a, b, { c: d } ]
  
  =item Plain mapping keys ending with colons
  
      ---
      key ends with two colons::: value
  
  =item Supported Characters
  
  If you have valid YAML that's not parsed, or the other way round, please
  create an issue.
  
  =item Line and Column Numbers
  
  You will see line and column numbers in the error message. The column numbers
  might still be wrong in some cases.
  
  =item Error Messages
  
  The error messages need to be improved.
  
  =item Unicode Surrogate Pairs
  
  Currently loaded as single characters without validating
  
  =item Possibly more
  
  =back
  
  =head2 YAML::PP::Constructor
  
  The Constructor now supports all three YAML 1.2 Schemas, Failsafe, JSON and
  Core.  Additionally you can choose the schema for YAML 1.1 as C<YAML1_1>.
  
  Too see what strings are resolved as booleans, numbers, null etc. look at
  L<https://perlpunk.github.io/YAML-PP-p5/schema-examples.html>.
  
  You can choose the Schema like this:
  
      my $ypp = YAML::PP->new(schema => ['JSON']); # default is 'Core'
  
  The Tags C<!!seq> and C<!!map> are still ignored for now.
  
  It supports:
  
  =over 4
  
  =item Handling of Anchors/Aliases
  
  Like in modules like L<YAML>, the Constructor will use references for mappings and
  sequences, but obviously not for scalars.
  
  L<YAML::XS> uses real aliases, which allows also aliasing scalars. I might add
  an option for that since aliasing is now available in pure perl.
  
  =item Boolean Handling
  
  You can choose between C<'perl'> (1/'', currently default), C<'JSON::PP'> and
  C<'boolean'>.pm for handling boolean types.  That allows you to dump the data
  structure with one of the JSON modules without losing information about
  booleans.
  
  =item Numbers
  
  Numbers are created as real numbers instead of strings, so that they are
  dumped correctly by modules like L<JSON::PP> or L<JSON::XS>, for example.
  
  =item Complex Keys
  
  Mapping Keys in YAML can be more than just scalars. Of course, you can't load
  that into a native perl structure. The Constructor will stringify those keys
  with L<Data::Dumper> instead of just returning something like
  C<HASH(0x55dc1b5d0178)>.
  
  Example:
  
      use YAML::PP;
      use JSON::PP;
      my $ypp = YAML::PP->new;
      my $coder = JSON::PP->new->ascii->pretty->allow_nonref->canonical;
      my $yaml = <<'EOM';
      complex:
          ?
              ?
                  a: 1
                  c: 2
              : 23
          : 42
      EOM
      my $data = $yppl->load_string($yaml);
      say $coder->encode($data);
      __END__
      {
         "complex" : {
            "{'{a => 1,c => 2}' => 23}" : 42
         }
      }
  
  =back
  
  TODO:
  
  =over 4
  
  =item Parse Tree
  
  I would like to generate a complete parse tree, that allows you to manipulate
  the data structure and also dump it, including all whitespaces and comments.
  The spec says that this is throwaway content, but I read that many people
  wish to be able to keep the comments.
  
  =back
  
  =head2 YAML::PP::Dumper, YAML::PP::Emitter
  
  The Dumper should be able to dump strings correctly, adding quotes
  whenever a plain scalar would look like a special string, like C<true>,
  or when it contains or starts with characters that are not allowed.
  
  Most strings will be dumped as plain scalars without quotes. If they
  contain special characters or have a special meaning, they will be dumped
  with single quotes. If they contain control characters, including <"\n">,
  they will be dumped with double quotes.
  
  It will recognize JSON::PP::Boolean and boolean.pm objects and dump them
  correctly.
  
  Numbers which also have a C<PV> flag will be recognized as numbers and not
  as strings:
  
      my $int = 23;
      say "int: $int"; # $int will now also have a PV flag
  
  That means that if you accidentally use a string in numeric context, it will
  also be recognized as a number:
  
      my $string = "23";
      my $something = $string + 0;
      print $yp->dump_string($string);
      # will be emitted as an integer without quotes!
  
  The layout is like libyaml output:
  
      key:
      - a
      - b
      - c
      ---
      - key1: 1
        key2: 2
        key3: 3
      ---
      - - a1
        - a2
      - - b1
        - b2
  
  =head1 WHY
  
  All the available parsers and loaders for Perl are behaving differently,
  and more important, aren't conforming to the spec. L<YAML::XS> is
  doing pretty well, but C<libyaml> only handles YAML 1.1 and diverges
  a bit from the spec. The pure perl loaders lack support for a number of
  features.
  
  I was going over L<YAML>.pm issues end of 2016, integrating old patches
  from rt.cpan.org and creating some pull requests myself. I realized
  that it would be difficult to patch YAML.pm to parse YAML 1.1 or even 1.2,
  and it would also break existing usages relying on the current behaviour.
  
  
  In 2016 Ingy döt Net initiated two really cool projects:
  
  =over 4
  
  =item L<"YAML TEST SUITE">
  
  =item L<"YAML EDITOR">
  
  =back
  
  These projects are a big help for any developer. So I got the idea
  to write my own parser and started on New Year's Day 2017.
  Without the test suite and the editor I would have never started this.
  
  I also started another YAML Test project which allows one to get a quick
  overview of which frameworks support which YAML features:
  
  =over 4
  
  =item L<"YAML TEST MATRIX">
  
  =back
  
  =head2 YAML TEST SUITE
  
  L<https://github.com/yaml/yaml-test-suite>
  
  It contains about 230 test cases and expected parsing events and more.
  There will be more tests coming. This test suite allows you to write parsers
  without turning the examples from the Specification into tests yourself.
  Also the examples aren't completely covering all cases - the test suite
  aims to do that.
  
  The suite contains .tml files, and in a separate 'data' release you will
  find the content in separate files, if you can't or don't want to
  use TestML.
  
  Thanks also to Felix Krause, who is writing a YAML parser in Nim.
  He turned all the spec examples into test cases.
  
  =head2 YAML EDITOR
  
  This is a tool to play around with several YAML parsers and loaders in vim.
  
  L<https://github.com/yaml/yaml-editor>
  
  The project contains the code to build the frameworks (16 as of this
  writing) and put it into one big Docker image.
  
  It also contains the yaml-editor itself, which will start a vim in the docker
  container. It uses a lot of funky vimscript that makes playing with it easy
  and useful. You can choose which frameworks you want to test and see the
  output in a grid of vim windows.
  
  Especially when writing a parser it is extremely helpful to have all
  the test cases and be able to play around with your own examples to see
  how they are handled.
  
  =head2 YAML TEST MATRIX
  
  I was curious to see how the different frameworks handle the test cases,
  so, using the test suite and the docker image, I wrote some code that runs
  the tests, manipulates the output to compare it with the expected output,
  and created a matrix view.
  
  L<https://github.com/perlpunk/yaml-test-matrix>
  
  You can find the latest build at L<https://matrix.yaml.io>
  
  As of this writing, the test matrix only contains valid test cases.
  Invalid ones will be added.
  
  =head1 CONTRIBUTORS
  
  =over
  
  =item Ingy döt Net
  
  Ingy is one of the creators of YAML. In 2016 he started the YAML Test Suite
  and the YAML Editor. He also made useful suggestions on the class
  hierarchy of YAML::PP.
  
  =item Felix "flyx" Krause
  
  Felix answered countless questions about the YAML Specification.
  
  =back
  
  =head1 SEE ALSO
  
  =over
  
  =item L<YAML>
  
  =item L<YAML::XS>
  
  =item L<YAML::Syck>
  
  =item L<YAML::Tiny>
  
  =item L<YAML::PP::LibYAML>
  
  =item L<YAML::LibYAML::API>
  
  =item L<https://www.yaml.info>
  
  =back
  
  =head1 SPONSORS
  
  The Perl Foundation L<https://www.perlfoundation.org/> sponsored this project
  (and the YAML Test Suite) with a grant of 2500 USD in 2017-2018.
  
  =head1 COPYRIGHT AND LICENSE
  
  Copyright 2017-2020 by Tina Müller
  
  This library is free software and may be distributed under the same terms
  as perl itself.
  
  =cut
YAML_PP

$fatpacked{"YAML/PP/Common.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'YAML_PP_COMMON';
  use strict;
  use warnings;
  package YAML::PP::Common;
  
  our $VERSION = '0.027'; # VERSION
  
  use base 'Exporter';
  
  our @EXPORT_OK = qw/
      YAML_ANY_SCALAR_STYLE YAML_PLAIN_SCALAR_STYLE
      YAML_SINGLE_QUOTED_SCALAR_STYLE YAML_DOUBLE_QUOTED_SCALAR_STYLE
      YAML_LITERAL_SCALAR_STYLE YAML_FOLDED_SCALAR_STYLE
      YAML_QUOTED_SCALAR_STYLE
  
      YAML_ANY_SEQUENCE_STYLE
      YAML_BLOCK_SEQUENCE_STYLE YAML_FLOW_SEQUENCE_STYLE
  
      YAML_ANY_MAPPING_STYLE
      YAML_BLOCK_MAPPING_STYLE YAML_FLOW_MAPPING_STYLE
  
      PRESERVE_ALL PRESERVE_ORDER PRESERVE_SCALAR_STYLE PRESERVE_FLOW_STYLE
      PRESERVE_ALIAS
  /;
  
  use constant {
      YAML_ANY_SCALAR_STYLE           => 0,
      YAML_PLAIN_SCALAR_STYLE         => 1,
      YAML_SINGLE_QUOTED_SCALAR_STYLE => 2,
      YAML_DOUBLE_QUOTED_SCALAR_STYLE => 3,
      YAML_LITERAL_SCALAR_STYLE       => 4,
      YAML_FOLDED_SCALAR_STYLE        => 5,
      YAML_QUOTED_SCALAR_STYLE        => 'Q', # deprecated
  
      YAML_ANY_SEQUENCE_STYLE   => 0,
      YAML_BLOCK_SEQUENCE_STYLE => 1,
      YAML_FLOW_SEQUENCE_STYLE  => 2,
  
      YAML_ANY_MAPPING_STYLE   => 0,
      YAML_BLOCK_MAPPING_STYLE => 1,
      YAML_FLOW_MAPPING_STYLE  => 2,
  
      PRESERVE_ORDER        => 2,
      PRESERVE_SCALAR_STYLE => 4,
      PRESERVE_FLOW_STYLE   => 8,
      PRESERVE_ALIAS        => 16,
  
      PRESERVE_ALL          => 31,
  };
  
  my %scalar_style_to_string = (
      YAML_PLAIN_SCALAR_STYLE() => ':',
      YAML_SINGLE_QUOTED_SCALAR_STYLE() => "'",
      YAML_DOUBLE_QUOTED_SCALAR_STYLE() => '"',
      YAML_LITERAL_SCALAR_STYLE() => '|',
      YAML_FOLDED_SCALAR_STYLE() => '>',
  );
  
  
  sub event_to_test_suite {
      my ($event, $args) = @_;
      my $ev = $event->{name};
          my $string;
          my $content = $event->{value};
  
          my $properties = '';
          $properties .= " &$event->{anchor}" if defined $event->{anchor};
          $properties .= " <$event->{tag}>" if defined $event->{tag};
  
          if ($ev eq 'document_start_event') {
              $string = "+DOC";
              $string .= " ---" unless $event->{implicit};
          }
          elsif ($ev eq 'document_end_event') {
              $string = "-DOC";
              $string .= " ..." unless $event->{implicit};
          }
          elsif ($ev eq 'stream_start_event') {
              $string = "+STR";
          }
          elsif ($ev eq 'stream_end_event') {
              $string = "-STR";
          }
          elsif ($ev eq 'mapping_start_event') {
              $string = "+MAP";
              if ($event->{style} and $event->{style} eq YAML_FLOW_MAPPING_STYLE) {
                  $string .= ' {}' if $args->{flow};
              }
              $string .= $properties;
              if (0) {
                  # doesn't match yaml-test-suite format
              }
          }
          elsif ($ev eq 'sequence_start_event') {
              $string = "+SEQ";
              if ($event->{style} and $event->{style} eq YAML_FLOW_SEQUENCE_STYLE) {
                  $string .= ' []' if $args->{flow};
              }
              $string .= $properties;
              if (0) {
                  # doesn't match yaml-test-suite format
              }
          }
          elsif ($ev eq 'mapping_end_event') {
              $string = "-MAP";
          }
          elsif ($ev eq 'sequence_end_event') {
              $string = "-SEQ";
          }
          elsif ($ev eq 'scalar_event') {
              $string = '=VAL';
              $string .= $properties;
  
              $content =~ s/\\/\\\\/g;
              $content =~ s/\t/\\t/g;
              $content =~ s/\r/\\r/g;
              $content =~ s/\n/\\n/g;
              $content =~ s/[\b]/\\b/g;
  
              $string .= ' '
                  . $scalar_style_to_string{ $event->{style} }
                  . $content;
          }
          elsif ($ev eq 'alias_event') {
              $string = "=ALI *$content";
          }
          return $string;
  }
  
  sub test_suite_to_event {
      my ($str) = @_;
      my $event = {};
      if ($str =~ s/^\+STR//) {
          $event->{name} = 'stream_start_event';
      }
      elsif ($str =~ s/^\-STR//) {
          $event->{name} = 'stream_end_event';
      }
      elsif ($str =~ s/^\+DOC//) {
          $event->{name} = 'document_start_event';
          if ($str =~ s/^ ---//) {
              $event->{implicit} = 0;
          }
          else {
              $event->{implicit} = 1;
          }
      }
      elsif ($str =~ s/^\-DOC//) {
          $event->{name} = 'document_end_event';
          if ($str =~ s/^ \.\.\.//) {
              $event->{implicit} = 0;
          }
          else {
              $event->{implicit} = 1;
          }
      }
      elsif ($str =~ s/^\+SEQ//) {
          $event->{name} = 'sequence_start_event';
          if ($str =~ s/^ \&(\S+)//) {
              $event->{anchor} = $1;
          }
          if ($str =~ s/^ <(\S+)>//) {
              $event->{tag} = $1;
          }
      }
      elsif ($str =~ s/^\-SEQ//) {
          $event->{name} = 'sequence_end_event';
      }
      elsif ($str =~ s/^\+MAP//) {
          $event->{name} = 'mapping_start_event';
          if ($str =~ s/^ \&(\S+)//) {
              $event->{anchor} = $1;
          }
          if ($str =~ s/^ <(\S+)>//) {
              $event->{tag} = $1;
          }
      }
      elsif ($str =~ s/^\-MAP//) {
          $event->{name} = 'mapping_end_event';
      }
      elsif ($str =~ s/^=VAL//) {
          $event->{name} = 'scalar_event';
          if ($str =~ s/^ <(\S+)>//) {
              $event->{tag} = $1;
          }
          if ($str =~ s/^ [:'">|]//) {
              $event->{style} = $1;
          }
          if ($str =~ s/^(.*)//) {
              $event->{value} = $1;
          }
      }
      elsif ($str =~ s/^=ALI//) {
          $event->{name} = 'alias_event';
          if ($str =~ s/^ \*(.*)//) {
              $event->{value} = $1;
          }
      }
      else {
          die "Could not parse event '$str'";
      }
      return $event;
  }
  
  
  1;
  
  __END__
  
  =pod
  
  =encoding utf-8
  
  =head1 NAME
  
  YAML::PP::Common - Constants and common functions
  
  =head1 SYNOPSIS
  
      use YAML::PP::Common qw/
          YAML_ANY_SCALAR_STYLE YAML_PLAIN_SCALAR_STYLE
          YAML_SINGLE_QUOTED_SCALAR_STYLE YAML_DOUBLE_QUOTED_SCALAR_STYLE
          YAML_LITERAL_SCALAR_STYLE YAML_FOLDED_SCALAR_STYLE
      /;
  
  =head1 DESCRIPTION
  
  =head1 FUNCTIONS
  
  =over
  
  =item event_to_test_suite
  
      my $string = YAML::PP::Common::event_to_test_suite($event_prom_parser);
  
  For examples of the returned format look into this distributions's directory
  C<yaml-test-suite> which is a copy of
  L<https://github.com/yaml/yaml-test-suite>.
  
  =item test_suite_to_event
  
      my $event = YAML::PP::Common::test_suite_to_event($str);
  
  Turns an event string in test suite format into an event hashref. Not complete
  yet.
  
  =back
  
YAML_PP_COMMON

$fatpacked{"YAML/PP/Constructor.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'YAML_PP_CONSTRUCTOR';
  # ABSTRACT: Construct data structure from Parser Events
  use strict;
  use warnings;
  package YAML::PP::Constructor;
  
  our $VERSION = '0.027'; # VERSION
  
  use YAML::PP;
  use YAML::PP::Common qw/
      PRESERVE_ORDER PRESERVE_SCALAR_STYLE PRESERVE_FLOW_STYLE PRESERVE_ALIAS
  /;
  use Scalar::Util qw/ reftype /;
  use Carp qw/ croak /;
  
  use constant DEBUG => ($ENV{YAML_PP_LOAD_DEBUG} or $ENV{YAML_PP_LOAD_TRACE}) ? 1 : 0;
  use constant TRACE => $ENV{YAML_PP_LOAD_TRACE} ? 1 : 0;
  
  my %cyclic_refs = qw/ allow 1 ignore 1 warn 1 fatal 1 /;
  
  sub new {
      my ($class, %args) = @_;
  
      my $default_yaml_version = delete $args{default_yaml_version};
      my $duplicate_keys = delete $args{duplicate_keys};
      unless (defined $duplicate_keys) {
          $duplicate_keys = 0;
      }
      my $preserve = delete $args{preserve} || 0;
      if ($preserve == 1) {
          $preserve = PRESERVE_ORDER | PRESERVE_SCALAR_STYLE | PRESERVE_FLOW_STYLE | PRESERVE_ALIAS;
      }
      my $cyclic_refs = delete $args{cyclic_refs} || 'allow';
      die "Invalid value for cyclic_refs: $cyclic_refs"
          unless $cyclic_refs{ $cyclic_refs };
      my $schemas = delete $args{schemas};
  
      if (keys %args) {
          die "Unexpected arguments: " . join ', ', sort keys %args;
      }
  
      my $self = bless {
          default_yaml_version => $default_yaml_version,
          schemas => $schemas,
          cyclic_refs => $cyclic_refs,
          preserve => $preserve,
          duplicate_keys => $duplicate_keys,
      }, $class;
      $self->init;
      return $self;
  }
  
  sub clone {
      my ($self) = @_;
      my $clone = {
          schemas => $self->{schemas},
          schema => $self->{schema},
          default_yaml_version => $self->{default_yaml_version},
          cyclic_refs => $self->cyclic_refs,
          preserve => $self->{preserve},
      };
      return bless $clone, ref $self;
  }
  
  sub init {
      my ($self) = @_;
      $self->set_docs([]);
      $self->set_stack([]);
      $self->set_anchors({});
      $self->set_yaml_version($self->default_yaml_version);
      $self->set_schema($self->schemas->{ $self->yaml_version } );
  }
  
  sub docs { return $_[0]->{docs} }
  sub stack { return $_[0]->{stack} }
  sub anchors { return $_[0]->{anchors} }
  sub set_docs { $_[0]->{docs} = $_[1] }
  sub set_stack { $_[0]->{stack} = $_[1] }
  sub set_anchors { $_[0]->{anchors} = $_[1] }
  sub schemas { return $_[0]->{schemas} }
  sub schema { return $_[0]->{schema} }
  sub set_schema { $_[0]->{schema} = $_[1] }
  sub cyclic_refs { return $_[0]->{cyclic_refs} }
  sub set_cyclic_refs { $_[0]->{cyclic_refs} = $_[1] }
  sub yaml_version { return $_[0]->{yaml_version} }
  sub set_yaml_version { $_[0]->{yaml_version} = $_[1] }
  sub default_yaml_version { return $_[0]->{default_yaml_version} }
  sub preserve_order { return $_[0]->{preserve} & PRESERVE_ORDER }
  sub preserve_scalar_style { return $_[0]->{preserve} & PRESERVE_SCALAR_STYLE }
  sub preserve_flow_style { return $_[0]->{preserve} & PRESERVE_FLOW_STYLE }
  sub preserve_alias { return $_[0]->{preserve} & PRESERVE_ALIAS }
  sub duplicate_keys { return $_[0]->{duplicate_keys} }
  
  sub document_start_event {
      my ($self, $event) = @_;
      my $stack = $self->stack;
      if ($event->{version_directive}) {
          my $version = $event->{version_directive};
          $version = "$version->{major}.$version->{minor}";
          if ($self->{schemas}->{ $version }) {
              $self->set_yaml_version($version);
              $self->set_schema($self->schemas->{ $version });
          }
          else {
              $self->set_yaml_version($self->default_yaml_version);
              $self->set_schema($self->schemas->{ $self->default_yaml_version });
          }
      }
      my $ref = [];
      push @$stack, { type => 'document', ref => $ref, data => $ref, event => $event };
  }
  
  sub document_end_event {
      my ($self, $event) = @_;
      my $stack = $self->stack;
      my $last = pop @$stack;
      $last->{type} eq 'document' or die "Expected mapping, but got $last->{type}";
      if (@$stack) {
          die "Got unexpected end of document";
      }
      my $docs = $self->docs;
      push @$docs, $last->{ref}->[0];
      $self->set_anchors({});
      $self->set_stack([]);
  }
  
  sub mapping_start_event {
      my ($self, $event) = @_;
      my ($data, $on_data) = $self->schema->create_mapping($self, $event);
      my $ref = {
          type => 'mapping',
          ref => [],
          data => \$data,
          event => $event,
          on_data => $on_data,
      };
      my $stack = $self->stack;
  
      my $preserve_order = $self->preserve_order;
      my $preserve_style = $self->preserve_flow_style;
      my $preserve_alias = $self->preserve_alias;
      if (($preserve_order or $preserve_style or $preserve_alias) and not tied(%$data)) {
          tie %$data, 'YAML::PP::Preserve::Hash';
      }
      if ($preserve_style) {
          my $t = tied %$data;
          $t->{style} = $event->{style};
      }
  
      push @$stack, $ref;
      if (defined(my $anchor = $event->{anchor})) {
          if ($preserve_alias) {
              my $t = tied %$data;
              unless (exists $self->anchors->{ $anchor }) {
                  # Repeated anchors cannot be preserved
                  $t->{alias} = $anchor;
              }
          }
          $self->anchors->{ $anchor } = { data => $ref->{data} };
      }
  }
  
  sub mapping_end_event {
      my ($self, $event) = @_;
      my $stack = $self->stack;
  
      my $last = pop @$stack;
      my ($ref, $data) = @{ $last }{qw/ ref data /};
      $last->{type} eq 'mapping' or die "Expected mapping, but got $last->{type}";
  
      my @merge_keys;
      my @ref;
      for (my $i = 0; $i < @$ref; $i += 2) {
          my $key = $ref->[ $i ];
          if (ref $key eq 'YAML::PP::Type::MergeKey') {
              my $merge = $ref->[ $i + 1 ];
              if ((reftype($merge) || '') eq 'HASH') {
                  push @merge_keys, $merge;
              }
              elsif ((reftype($merge) || '') eq 'ARRAY') {
                  for my $item (@$merge) {
                      if ((reftype($item) || '') eq 'HASH') {
                          push @merge_keys, $item;
                      }
                      else {
                          die "Expected hash for merge key";
                      }
                  }
              }
              else {
                  die "Expected hash or array for merge key";
              }
          }
          else {
              push @ref, $key, $ref->[ $i + 1 ];
          }
      }
      for my $merge (@merge_keys) {
          for my $key (keys %$merge) {
              unless (exists $$data->{ $key }) {
                  $$data->{ $key } = $merge->{ $key };
              }
          }
      }
      my $on_data = $last->{on_data} || sub {
          my ($self, $hash, $items) = @_;
          my %seen;
          for (my $i = 0; $i < @$items; $i += 2) {
              my ($key, $value) = @$items[ $i, $i + 1 ];
              $key = '' unless defined $key;
              if (ref $key) {
                  $key = $self->stringify_complex($key);
              }
              if ($seen{ $key }++ and not $self->duplicate_keys) {
                  croak "Duplicate key '$key'";
              }
              $$hash->{ $key } = $value;
          }
      };
      $on_data->($self, $data, \@ref);
      push @{ $stack->[-1]->{ref} }, $$data;
      if (defined(my $anchor = $last->{event}->{anchor})) {
          $self->anchors->{ $anchor }->{finished} = 1;
      }
      return;
  }
  
  sub sequence_start_event {
      my ($self, $event) = @_;
      my ($data, $on_data) = $self->schema->create_sequence($self, $event);
      my $ref = {
          type => 'sequence',
          ref => [],
          data => \$data,
          event => $event,
          on_data => $on_data,
      };
      my $stack = $self->stack;
  
      my $preserve_style = $self->preserve_flow_style;
      my $preserve_alias = $self->preserve_alias;
      if ($preserve_style or $preserve_alias and not tied(@$data)) {
          tie @$data, 'YAML::PP::Preserve::Array', @$data;
          my $t = tied @$data;
          $t->{style} = $event->{style};
      }
  
      push @$stack, $ref;
      if (defined(my $anchor = $event->{anchor})) {
          if ($preserve_alias) {
              my $t = tied @$data;
              unless (exists $self->anchors->{ $anchor }) {
                  # Repeated anchors cannot be preserved
                  $t->{alias} = $anchor;
              }
          }
          $self->anchors->{ $anchor } = { data => $ref->{data} };
      }
  }
  
  sub sequence_end_event {
      my ($self, $event) = @_;
      my $stack = $self->stack;
      my $last = pop @$stack;
      $last->{type} eq 'sequence' or die "Expected mapping, but got $last->{type}";
      my ($ref, $data) = @{ $last }{qw/ ref data /};
  
      my $on_data = $last->{on_data} || sub {
          my ($self, $array, $items) = @_;
          push @$$array, @$items;
      };
      $on_data->($self, $data, $ref);
      push @{ $stack->[-1]->{ref} }, $$data;
      if (defined(my $anchor = $last->{event}->{anchor})) {
          my $test = $self->anchors->{ $anchor };
          $self->anchors->{ $anchor }->{finished} = 1;
      }
      return;
  }
  
  sub stream_start_event {}
  
  sub stream_end_event {}
  
  sub scalar_event {
      my ($self, $event) = @_;
      DEBUG and warn "CONTENT $event->{value} ($event->{style})\n";
      my $value = $self->schema->load_scalar($self, $event);
      my $last = $self->stack->[-1];
      my $preserve_alias = $self->preserve_alias;
      my $preserve_style = $self->preserve_scalar_style;
      if (($preserve_style or $preserve_alias) and not ref $value) {
          my %args = (
              value => $value,
              tag => $event->{tag},
          );
          if ($preserve_style) {
              $args{style} = $event->{style};
          }
          if ($preserve_alias and defined $event->{anchor}) {
              my $anchor = $event->{anchor};
              unless (exists $self->anchors->{ $anchor }) {
                  # Repeated anchors cannot be preserved
                  $args{alias} = $event->{anchor};
              }
          }
          $value = YAML::PP::Preserve::Scalar->new( %args );
      }
      if (defined (my $name = $event->{anchor})) {
          $self->anchors->{ $name } = { data => \$value, finished => 1 };
      }
      push @{ $last->{ref} }, $value;
  }
  
  sub alias_event {
      my ($self, $event) = @_;
      my $value;
      my $name = $event->{value};
      if (my $anchor = $self->anchors->{ $name }) {
          # We know this is a cyclic ref since the node hasn't
          # been constructed completely yet
          unless ($anchor->{finished} ) {
              my $cyclic_refs = $self->cyclic_refs;
              if ($cyclic_refs ne 'allow') {
                  if ($cyclic_refs eq 'fatal') {
                      die "Found cyclic ref for alias '$name'";
                  }
                  if ($cyclic_refs eq 'warn') {
                      $anchor = { data => \undef };
                      warn "Found cyclic ref for alias '$name'";
                  }
                  elsif ($cyclic_refs eq 'ignore') {
                      $anchor = { data => \undef };
                  }
              }
          }
          $value = $anchor->{data};
      }
      else {
          croak "No anchor defined for alias '$name'";
      }
      my $last = $self->stack->[-1];
      push @{ $last->{ref} }, $$value;
  }
  
  sub stringify_complex {
      my ($self, $data) = @_;
      return $data if (
          ref $data eq 'YAML::PP::Preserve::Scalar'
          and ($self->preserve_scalar_style or $self->preserve_alias)
      );
      require Data::Dumper;
      local $Data::Dumper::Quotekeys = 0;
      local $Data::Dumper::Terse = 1;
      local $Data::Dumper::Indent = 0;
      local $Data::Dumper::Useqq = 0;
      local $Data::Dumper::Sortkeys = 1;
      my $string = Data::Dumper->Dump([$data], ['data']);
      $string =~ s/^\$data = //;
      return $string;
  }
  
  1;
  
  __END__
  
  =pod
  
  =encoding utf-8
  
  =head1 NAME
  
  YAML::PP::Constructor - Constructing data structure from parsing events
  
  =head1 METHODS
  
  =over
  
  =item new
  
  The Constructor constructor
  
      my $constructor = YAML::PP::Constructor->new(
          schema => $schema,
          cyclic_refs => $cyclic_refs,
      );
  
  =item init
  
  Resets any data being used during construction.
  
      $constructor->init;
  
  =item document_start_event, document_end_event, mapping_start_event, mapping_end_event, sequence_start_event, sequence_end_event, scalar_event, alias_event, stream_start_event, stream_end_event
  
  These methods are called from L<YAML::PP::Parser>:
  
      $constructor->document_start_event($event);
  
  =item anchors, set_anchors
  
  Helper for storing anchors during construction
  
  =item docs, set_docs
  
  Helper for storing resulting documents during construction
  
  =item stack, set_stack
  
  Helper for storing data during construction
  
  =item cyclic_refs, set_cyclic_refs
  
  Option for controlling the behaviour when finding circular references
  
  =item schema, set_schema
  
  Holds a L<YAML::PP::Schema> object
  
  =item stringify_complex
  
  When constructing a hash and getting a non-scalar key, this method is
  used to stringify the key.
  
  It uses a terse Data::Dumper output. Other modules, like L<YAML::XS>, use
  the default stringification, C<ARRAY(0x55617c0c7398)> for example.
  
  =back
  
  =cut
YAML_PP_CONSTRUCTOR

$fatpacked{"YAML/PP/Dumper.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'YAML_PP_DUMPER';
  use strict;
  use warnings;
  package YAML::PP::Dumper;
  
  our $VERSION = '0.027'; # VERSION
  
  use Scalar::Util qw/ blessed refaddr reftype /;
  use YAML::PP;
  use YAML::PP::Emitter;
  use YAML::PP::Representer;
  use YAML::PP::Writer;
  use YAML::PP::Writer::File;
  use YAML::PP::Common qw/
      YAML_PLAIN_SCALAR_STYLE YAML_SINGLE_QUOTED_SCALAR_STYLE
      YAML_DOUBLE_QUOTED_SCALAR_STYLE
      YAML_ANY_SCALAR_STYLE
      YAML_LITERAL_SCALAR_STYLE YAML_FOLDED_SCALAR_STYLE
      YAML_FLOW_SEQUENCE_STYLE YAML_FLOW_MAPPING_STYLE
      YAML_BLOCK_MAPPING_STYLE YAML_BLOCK_SEQUENCE_STYLE
  /;
  
  sub new {
      my ($class, %args) = @_;
  
      my $header = delete $args{header};
      $header = 1 unless defined $header;
      my $footer = delete $args{footer};
      $footer = 0 unless defined $footer;
      my $version_directive = delete $args{version_directive};
      my $preserve = delete $args{preserve};
  
      my $schema = delete $args{schema} || YAML::PP->default_schema(
          boolean => 'perl',
      );
  
      my $emitter = delete $args{emitter} || YAML::PP::Emitter->new;
      unless (blessed($emitter)) {
          $emitter = YAML::PP::Emitter->new(
              %$emitter
          );
      }
  
      if (keys %args) {
          die "Unexpected arguments: " . join ', ', sort keys %args;
      }
      my $self = bless {
          representer => YAML::PP::Representer->new(
              schema => $schema,
              preserve => $preserve,
          ),
          version_directive => $version_directive,
          emitter => $emitter,
          seen => {},
          anchors => {},
          anchor_num => 0,
          header => $header,
          footer => $footer,
      }, $class;
      return $self;
  }
  
  sub clone {
      my ($self) = @_;
      my $clone = {
          representer => $self->representer->clone,
          emitter => $self->emitter->clone,
          version_directive => $self->version_directive,
          seen => {},
          anchors => {},
          anchor_num => 0,
          header => $self->header,
          footer => $self->footer,
      };
      return bless $clone, ref $self;
  }
  
  sub init {
      my ($self) = @_;
      $self->{seen} = {};
      $self->{anchors} = {};
      $self->{anchor_num} = 0;
  }
  
  sub emitter { return $_[0]->{emitter} }
  sub representer { return $_[0]->{representer} }
  sub set_representer { $_[0]->{representer} = $_[1] }
  sub header { return $_[0]->{header} }
  sub footer { return $_[0]->{footer} }
  sub version_directive { return $_[0]->{version_directive} }
  
  sub dump {
      my ($self, @docs) = @_;
      $self->emitter->init;
  
      $self->emitter->stream_start_event({});
  
      for my $i (0 .. $#docs) {
          my $header_implicit = ($i == 0 and not $self->header);
          my %args = (
              implicit => $header_implicit,
          );
          if ($self->version_directive) {
              my ($major, $minor) = split m/\./, $self->representer->schema->yaml_version;
              $args{version_directive} = { major => $major, minor => $minor };
          }
          $self->emitter->document_start_event( \%args );
          $self->init;
          $self->check_references($docs[ $i ]);
          $self->dump_node($docs[ $i ]);
          my $footer_implicit = (not $self->footer);
          $self->emitter->document_end_event({ implicit => $footer_implicit });
      }
  
      $self->emitter->stream_end_event({});
  
      my $output = $self->emitter->writer->output;
      $self->emitter->finish;
      return $output;
  }
  
  sub dump_node {
      my ($self, $value) = @_;
      my $node = {
          value => $value,
      };
      if (ref $value) {
  
          my $seen = $self->{seen};
          my $refaddr = refaddr $value;
          if ($seen->{ $refaddr } and $seen->{ $refaddr } > 1) {
              my $anchor = $self->{anchors}->{ $refaddr };
              unless (defined $anchor) {
                  if ($self->representer->preserve_alias) {
                      if (ref $node->{value} eq 'YAML::PP::Preserve::Scalar') {
                          if (defined $node->{value}->alias) {
                              $node->{anchor} = $node->{value}->alias;
                              $self->{anchors}->{ $refaddr } = $node->{value}->alias;
                          }
                      }
                      elsif (reftype $node->{value} eq 'HASH') {
                          if (my $tied = tied %{ $node->{value} } ) {
                              if (defined $tied->{alias}) {
                                  $node->{anchor} = $tied->{alias};
                                  $self->{anchors}->{ $refaddr } = $node->{anchor};
                              }
                          }
                      }
                      elsif (reftype $node->{value} eq 'ARRAY') {
                          if (my $tied = tied @{ $node->{value} } ) {
                              if (defined $tied->{alias}) {
                                  $node->{anchor} = $tied->{alias};
                                  $self->{anchors}->{ $refaddr } = $node->{anchor};
                              }
                          }
                      }
                  }
                  unless (defined $node->{anchor}) {
                      my $num = ++$self->{anchor_num};
                      $self->{anchors}->{ $refaddr } = $num;
                      $node->{anchor} = $num;
                  }
              }
              else {
                  $node->{value} = $anchor;
                  $self->emit_node([ alias => $node ]);
                  return;
              }
  
          }
      }
      $node = $self->representer->represent_node($node);
      $self->emit_node($node);
  }
  
  sub emit_node {
      my ($self, $item) = @_;
      my ($type, $node, %args) = @$item;
      if ($type eq 'alias') {
          $self->emitter->alias_event({ value => $node->{value} });
          return;
      }
      if ($type eq 'mapping') {
          my $style = $args{style} || YAML_BLOCK_MAPPING_STYLE;
          # TODO
          if ($node->{items} and @{ $node->{items} } == 0) {
  #            $style = YAML_FLOW_MAPPING_STYLE;
          }
          $self->emitter->mapping_start_event({
              anchor => $node->{anchor},
              style => $style,
              tag => $node->{tag},
          });
          for (@{ $node->{items} }) {
              $self->dump_node($_);
          }
          $self->emitter->mapping_end_event;
          return;
      }
      if ($type eq 'sequence') {
          my $style = $args{style} || YAML_BLOCK_SEQUENCE_STYLE;
          if (@{ $node->{items} } == 0) {
  #            $style = YAML_FLOW_SEQUENCE_STYLE;
          }
          $self->emitter->sequence_start_event({
              anchor => $node->{anchor},
              style => $style,
              tag => $node->{tag},
          });
          for (@{ $node->{items} }) {
              $self->dump_node($_);
          }
          $self->emitter->sequence_end_event;
          return;
      }
      $self->emitter->scalar_event({
          value => $node->{items}->[0],
          style => $node->{style},
          anchor => $node->{anchor},
          tag => $node->{tag},
      });
  }
  
  
  sub dump_string {
      my ($self, @docs) = @_;
      my $writer = YAML::PP::Writer->new;
      $self->emitter->set_writer($writer);
      my $output = $self->dump(@docs);
      return $output;
  }
  
  sub dump_file {
      my ($self, $file, @docs) = @_;
      my $writer = YAML::PP::Writer::File->new(output => $file);
      $self->emitter->set_writer($writer);
      my $output = $self->dump(@docs);
      return $output;
  }
  
  my %_reftypes = (
      HASH => 1,
      ARRAY => 1,
      Regexp => 1,
      REGEXP => 1,
      CODE => 1,
      SCALAR => 1,
      REF => 1,
      GLOB => 1,
  );
  
  sub check_references {
      my ($self, $doc) = @_;
      my $reftype = reftype $doc or return;
      my $seen = $self->{seen};
      # check which references are used more than once
      if ($reftype eq 'SCALAR' and ref $doc eq $self->representer->schema->bool_class) {
          # JSON::PP and boolean.pm always return the same reference for booleans
          # Avoid printing *aliases in those case
          if (ref $doc eq 'boolean' or ref $doc eq 'JSON::PP::Boolean') {
              return;
          }
      }
      if (++$seen->{ refaddr $doc } > 1) {
          # seen already
          return;
      }
      unless ($_reftypes{ $reftype }) {
          die sprintf "Reference %s not implemented",
              $reftype;
      }
      if ($reftype eq 'HASH') {
          $self->check_references($doc->{ $_ }) for keys %$doc;
      }
      elsif ($reftype eq 'ARRAY') {
          $self->check_references($_) for @$doc;
      }
      elsif ($reftype eq 'REF') {
          $self->check_references($$doc);
      }
  }
  
  1;
YAML_PP_DUMPER

$fatpacked{"YAML/PP/Emitter.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'YAML_PP_EMITTER';
  use strict;
  use warnings;
  package YAML::PP::Emitter;
  
  our $VERSION = '0.027'; # VERSION
  use Data::Dumper;
  
  use YAML::PP::Common qw/
      YAML_PLAIN_SCALAR_STYLE YAML_SINGLE_QUOTED_SCALAR_STYLE
      YAML_DOUBLE_QUOTED_SCALAR_STYLE
      YAML_LITERAL_SCALAR_STYLE YAML_FOLDED_SCALAR_STYLE
      YAML_FLOW_SEQUENCE_STYLE YAML_FLOW_MAPPING_STYLE
  /;
  
  use constant DEBUG => $ENV{YAML_PP_EMIT_DEBUG} ? 1 : 0;
  use constant DEFAULT_WIDTH => 80;
  
  sub new {
      my ($class, %args) = @_;
      my $self = bless {
          indent => $args{indent} || 2,
          writer => $args{writer},
          width => $args{width} || DEFAULT_WIDTH,
      }, $class;
      $self->init;
      return $self;
  }
  
  sub clone {
      my ($self) = @_;
      my $clone = {
          indent => $self->indent,
      };
      return bless $clone, ref $self;
  }
  
  sub event_stack { return $_[0]->{event_stack} }
  sub set_event_stack { $_[0]->{event_stack} = $_[1] }
  sub indent { return $_[0]->{indent} }
  sub width { return $_[0]->{width} }
  sub line { return $_[0]->{line} }
  sub column { return $_[0]->{column} }
  sub set_indent { $_[0]->{indent} = $_[1] }
  sub writer { $_[0]->{writer} }
  sub set_writer { $_[0]->{writer} = $_[1] }
  sub tagmap { return $_[0]->{tagmap} }
  sub set_tagmap { $_[0]->{tagmap} = $_[1] }
  
  sub init {
      my ($self) = @_;
      unless ($self->writer) {
          $self->set_writer(YAML::PP::Writer->new);
      }
      $self->set_tagmap({
          'tag:yaml.org,2002:' => '!!',
      });
      $self->{open_ended} = 0;
      $self->{line} = 0;
      $self->{column} = 0;
      $self->writer->init;
  }
  
  sub mapping_start_event {
      DEBUG and warn __PACKAGE__.':'.__LINE__.": +++ mapping_start_event\n";
      my ($self, $info) = @_;
      my $stack = $self->event_stack;
      my $last = $stack->[-1];
      my $indent = $last->{indent};
      my $new_indent = $indent;
      my $yaml = '';
  
      my $props = '';
      my $anchor = $info->{anchor};
      my $tag = $info->{tag};
      if (defined $anchor) {
          $anchor = "&$anchor";
      }
      if (defined $tag) {
          $tag = $self->emit_tag('map', $tag);
      }
      $props = join ' ', grep defined, ($anchor, $tag);
  
      my $flow = $last->{flow} || 0;
      $flow++ if ($info->{style} || 0) eq YAML_FLOW_MAPPING_STYLE;
  
      my $newline = 0;
      if ($flow > 1) {
          if ($last->{type} eq 'SEQ') {
              if ($last->{newline}) {
                  $yaml .= ' ';
              }
              if ($last->{index} == 0) {
                  $yaml .= "[";
              }
              else {
                  $yaml .= ",";
              }
          }
          elsif ($last->{type} eq 'MAP') {
              if ($last->{newline}) {
                  $yaml .= ' ';
              }
              if ($last->{index} == 0) {
                  $yaml .= "{";
              }
              else {
                  $yaml .= ",";
              }
          }
          elsif ($last->{type} eq 'MAPVALUE') {
              if ($last->{index} == 0) {
                  die "Should not happen (index 0 in MAPVALUE)";
              }
              $yaml .= ": ";
          }
          if ($props) {
              $yaml .= " $props ";
          }
          $new_indent .= ' ' x $self->indent;
      }
      else {
          if ($last->{type} eq 'DOC') {
              $newline = $last->{newline};
          }
          else {
              if ($last->{newline}) {
                  $yaml .= "\n";
                  $last->{column} = 0;
              }
              if ($last->{type} eq 'MAPVALUE') {
                  $new_indent .= ' ' x $self->indent;
                  $newline = 1;
              }
              else {
                  $new_indent = $indent;
                  if (not $props and $self->indent == 1) {
                      $new_indent .= ' ' x 2;
                  }
                  else {
                      $new_indent .= ' ' x $self->indent;
                  }
  
                  if ($last->{column}) {
                      my $space = $self->indent > 1 ? ' ' x ($self->indent - 1) : ' ';
                      $yaml .= $space;
                  }
                  else {
                      $yaml .= $indent;
                  }
                  if ($last->{type} eq 'SEQ') {
                      $yaml .= '-';
                  }
                  elsif ($last->{type} eq 'MAP') {
                      $yaml .= "?";
                      $last->{type} = 'COMPLEX';
                  }
                  elsif ($last->{type} eq 'COMPLEXVALUE') {
                      $yaml .= ":";
                  }
                  else {
                      die "Should not happen ($last->{type} in mapping_start)";
                  }
                  $last->{column} = 1;
              }
              $last->{newline} = 0;
          }
          if ($props) {
              $yaml .= $last->{column} ? ' ' : $indent;
              $yaml .= $props;
              $newline = 1;
          }
      }
      $self->_write($yaml);
      my $new_info = {
          index => 0, indent => $new_indent, info => $info,
          newline => $newline,
          column => $self->column,
          flow => $flow,
      };
      $new_info->{type} = 'MAP';
      push @{ $stack }, $new_info;
      $last->{index}++;
      $self->{open_ended} = 0;
  }
  
  sub mapping_end_event {
      DEBUG and warn __PACKAGE__.':'.__LINE__.": +++ mapping_end_event\n";
      my ($self, $info) = @_;
      my $stack = $self->event_stack;
  
      my $last = pop @{ $stack };
      if ($last->{index} == 0) {
          my $indent = $last->{indent};
          my $zero_indent = $last->{zero_indent};
          if ($last->{zero_indent}) {
              $indent .= ' ' x $self->indent;
          }
          if ($self->column) {
              $self->_write(" {}\n");
          }
          else {
              $self->_write("$indent\{}\n");
          }
      }
      elsif ($last->{flow}) {
          my $yaml = "}";
          if ($last->{flow} == 1) {
              $yaml .= "\n";
          }
          $self->_write("$yaml");
      }
      $last = $stack->[-1];
      $last->{column} = $self->column;
      if ($last->{type} eq 'SEQ') {
      }
      elsif ($last->{type} eq 'MAP') {
          $last->{type} = 'MAPVALUE';
      }
      elsif ($last->{type} eq 'MAPVALUE') {
          $last->{type} = 'MAP';
      }
      elsif ($last->{type} eq 'COMPLEX') {
          $last->{type} = 'COMPLEXVALUE';
      }
      elsif ($last->{type} eq 'COMPLEXVALUE') {
          $last->{type} = 'MAP';
      }
  }
  
  sub sequence_start_event {
      DEBUG and warn __PACKAGE__.':'.__LINE__.": +++ sequence_start_event\n";
      my ($self, $info) = @_;
      my $stack = $self->event_stack;
      my $last = $stack->[-1];
      my $indent = $last->{indent};
      my $new_indent = $indent;
      my $yaml = '';
  
      my $props = '';
      my $anchor = $info->{anchor};
      my $tag = $info->{tag};
      if (defined $anchor) {
          $anchor = "&$anchor";
      }
      if (defined $tag) {
          $tag = $self->emit_tag('seq', $tag);
      }
      $props = join ' ', grep defined, ($anchor, $tag);
  
      my $flow = $last->{flow} || 0;
      $flow++ if $flow or ($info->{style} || 0) eq YAML_FLOW_SEQUENCE_STYLE;
      my $newline = 0;
      my $zero_indent = 0;
      if ($flow > 1) {
          if ($last->{type} eq 'SEQ') {
              if ($last->{newline}) {
                  $yaml .= ' ';
              }
              if ($last->{index} == 0) {
                  $yaml .= "[";
              }
              else {
                  $yaml .= ",";
              }
          }
          elsif ($last->{type} eq 'MAP') {
              if ($last->{newline}) {
                  $yaml .= ' ';
              }
              if ($last->{index} == 0) {
                  $yaml .= "{";
              }
              else {
                  $yaml .= ",";
              }
          }
          elsif ($last->{type} eq 'MAPVALUE') {
              if ($last->{index} == 0) {
                  die "Should not happen (index 0 in MAPVALUE)";
              }
              $yaml .= ": ";
          }
          if ($props) {
              $yaml .= " $props ";
          }
          $new_indent .= ' ' x $self->indent;
      }
      else {
          if ($last->{type} eq 'DOC') {
              $newline = $last->{newline};
          }
          else {
              if ($last->{newline}) {
                  $yaml .= "\n";
                  $last->{column} = 0;
              }
              if ($last->{type} eq 'MAPVALUE') {
                  $zero_indent = 1;
                  $newline = 1;
              }
              else {
                  if (not $props and $self->indent == 1) {
                      $new_indent .= ' ' x 2;
                  }
                  else {
                      $new_indent .= ' ' x $self->indent;
                  }
                  if ($last->{column}) {
                      my $space = $self->indent > 1 ? ' ' x ($self->indent - 1) : ' ';
                      $yaml .= $space;
                  }
                  else {
                      $yaml .= $indent;
                  }
                  if ($last->{type} eq 'SEQ') {
                      $yaml .= "-";
                  }
                  elsif ($last->{type} eq 'MAP') {
                      $last->{type} = 'COMPLEX';
                      $zero_indent = 1;
                      $yaml .= "?";
                  }
                  elsif ($last->{type} eq 'COMPLEXVALUE') {
                      $yaml .= ":";
                      $zero_indent = 1;
                  }
                  else {
                      die "Should not happen ($last->{type} in sequence_start)";
                  }
                  $last->{column} = 1;
              }
              $last->{newline} = 0;
          }
          if ($props) {
              $yaml .= $last->{column} ? ' ' : $indent;
              $yaml .= $props;
              $newline = 1;
          }
      }
      $self->_write($yaml);
      $last->{index}++;
      my $new_info = {
          index => 0,
          indent => $new_indent,
          info => $info,
          zero_indent => $zero_indent,
          newline => $newline,
          column => $self->column,
          flow => $flow,
      };
      $new_info->{type} = 'SEQ';
      push @{ $stack }, $new_info;
      $self->{open_ended} = 0;
  }
  
  sub sequence_end_event {
      DEBUG and warn __PACKAGE__.':'.__LINE__.": +++ sequence_end_event\n";
      my ($self, $info) = @_;
      my $stack = $self->event_stack;
  
      my $last = pop @{ $stack };
      if ($last->{index} == 0) {
          my $indent = $last->{indent};
          my $zero_indent = $last->{zero_indent};
          if ($last->{zero_indent}) {
              $indent .= ' ' x $self->indent;
          }
          my $yaml .= $self->column ? ' ' : $indent;
          $yaml .= "[]";
          if ($last->{flow} < 2) {
              $yaml .= "\n";
          }
          $self->_write($yaml);
      }
      elsif ($last->{flow}) {
          my $yaml = "]";
          if ($last->{flow} == 1) {
              $yaml .= "\n";
          }
          $self->_write($yaml);
      }
      $last = $stack->[-1];
      $last->{column} = $self->column;
      if ($last->{type} eq 'SEQ') {
      }
      elsif ($last->{type} eq 'MAP') {
          $last->{type} = 'MAPVALUE';
      }
      elsif ($last->{type} eq 'MAPVALUE') {
          $last->{type} = 'MAP';
      }
      elsif ($last->{type} eq 'COMPLEX') {
          $last->{type} = 'COMPLEXVALUE';
      }
      elsif ($last->{type} eq 'COMPLEXVALUE') {
          $last->{type} = 'MAP';
      }
  }
  
  my %forbidden_first = (qw/
      ! 1 & 1 * 1 { 1 } 1 [ 1 ] 1 | 1 > 1 @ 1 ` 1 " 1 ' 1
  /, '#' => 1, '%' => 1, ',' => 1, " " => 1);
  my %forbidden_first_plus_space = (qw/
      ? 1 - 1 : 1
  /);
  
  my %control = (
      "\x00" => '\0',
      "\x01" => '\x01',
      "\x02" => '\x02',
      "\x03" => '\x03',
      "\x04" => '\x04',
      "\x05" => '\x05',
      "\x06" => '\x06',
      "\x07" => '\a',
      "\x08" => '\b',
      "\x0b" => '\v',
      "\x0c" => '\f',
      "\x0e" => '\x0e',
      "\x0f" => '\x0f',
      "\x10" => '\x10',
      "\x11" => '\x11',
      "\x12" => '\x12',
      "\x13" => '\x13',
      "\x14" => '\x14',
      "\x15" => '\x15',
      "\x16" => '\x16',
      "\x17" => '\x17',
      "\x18" => '\x18',
      "\x19" => '\x19',
      "\x1a" => '\x1a',
      "\x1b" => '\e',
      "\x1c" => '\x1c',
      "\x1d" => '\x1d',
      "\x1e" => '\x1e',
      "\x1f" => '\x1f',
      "\x7f" => '\x7f',
      "\x80" => '\x80',
      "\x81" => '\x81',
      "\x82" => '\x82',
      "\x83" => '\x83',
      "\x84" => '\x84',
      "\x86" => '\x86',
      "\x87" => '\x87',
      "\x88" => '\x88',
      "\x89" => '\x89',
      "\x8a" => '\x8a',
      "\x8b" => '\x8b',
      "\x8c" => '\x8c',
      "\x8d" => '\x8d',
      "\x8e" => '\x8e',
      "\x8f" => '\x8f',
      "\x90" => '\x90',
      "\x91" => '\x91',
      "\x92" => '\x92',
      "\x93" => '\x93',
      "\x94" => '\x94',
      "\x95" => '\x95',
      "\x96" => '\x96',
      "\x97" => '\x97',
      "\x98" => '\x98',
      "\x99" => '\x99',
      "\x9a" => '\x9a',
      "\x9b" => '\x9b',
      "\x9c" => '\x9c',
      "\x9d" => '\x9d',
      "\x9e" => '\x9e',
      "\x9f" => '\x9f',
      "\x{2029}" => '\P',
      "\x{2028}" => '\L',
      "\x85" => '\N',
      "\xa0" => '\_',
  );
  
  my $control_re = '\x00-\x08\x0b\x0c\x0e-\x1f\x7f-\x84\x86-\x9f\x{d800}-\x{dfff}\x{fffe}\x{ffff}\x{2028}\x{2029}\x85\xa0';
  my %to_escape = (
      "\n" => '\n',
      "\t" => '\t',
      "\r" => '\r',
      '\\' => '\\\\',
      '"' => '\\"',
      %control,
  );
  my $escape_re = $control_re . '\n\t\r';
  my $escape_re_without_lb = $control_re . '\t\r';
  
  
  sub scalar_event {
      DEBUG and warn __PACKAGE__.':'.__LINE__.": +++ scalar_event\n";
      my ($self, $info) = @_;
      my $stack = $self->event_stack;
      my $last = $stack->[-1];
      my $indent = $last->{indent};
      my $value = $info->{value};
      my $flow = $last->{flow};
  
      my $props = '';
      my $anchor = $info->{anchor};
      my $tag = $info->{tag};
      if (defined $anchor) {
          $anchor = "&$anchor";
      }
      if (defined $tag) {
          $tag = $self->emit_tag('scalar', $tag);
      }
      $props = join ' ', grep defined, ($anchor, $tag);
  
      my $style = $info->{style};
      DEBUG and local $Data::Dumper::Useqq = 1;
      $value = '' unless defined $value;
      my $first = substr($value, 0, 1);
  
      if ($value eq '') {
          if ($flow and $last->{type} ne 'MAPVALUE' and $last->{type} ne 'MAP') {
              $style = YAML_SINGLE_QUOTED_SCALAR_STYLE;
          }
          elsif (not $style) {
              $style = YAML_SINGLE_QUOTED_SCALAR_STYLE;
          }
      }
      # no control characters anywhere
      elsif ($value =~ m/[$control_re]/) {
          $style = YAML_DOUBLE_QUOTED_SCALAR_STYLE;
      }
      $style ||= YAML_PLAIN_SCALAR_STYLE;
  
      if ($style == YAML_SINGLE_QUOTED_SCALAR_STYLE) {
          if ($value =~ m/ \n/ or $value =~ m/\n / or $value =~ m/^\n/ or $value =~ m/\n$/) {
              $style = YAML_DOUBLE_QUOTED_SCALAR_STYLE;
          }
          elsif ($value eq "\n") {
              $style = YAML_DOUBLE_QUOTED_SCALAR_STYLE;
          }
      }
      elsif ($style == YAML_LITERAL_SCALAR_STYLE or $style == YAML_FOLDED_SCALAR_STYLE) {
          if ($value eq '') {
              $style = YAML_DOUBLE_QUOTED_SCALAR_STYLE;
          }
          elsif ($flow) {
              # no block scalars in flow
              if ($value =~ tr/\n//) {
                  $style = YAML_DOUBLE_QUOTED_SCALAR_STYLE;
              }
              else {
                  $style = YAML_SINGLE_QUOTED_SCALAR_STYLE;
              }
          }
      }
      elsif ($style == YAML_PLAIN_SCALAR_STYLE) {
          if (not length $value) {
          }
          elsif ($value =~ m/[$escape_re_without_lb]/) {
              $style = YAML_DOUBLE_QUOTED_SCALAR_STYLE;
          }
          elsif ($value eq "\n") {
              $style = YAML_DOUBLE_QUOTED_SCALAR_STYLE;
          }
          elsif ($value !~ tr/ //c) {
              $style = YAML_SINGLE_QUOTED_SCALAR_STYLE;
          }
          elsif ($value !~ tr/ \n//c) {
              $style = YAML_DOUBLE_QUOTED_SCALAR_STYLE;
          }
          elsif ($value =~ tr/\n//) {
              $style = $flow ? YAML_DOUBLE_QUOTED_SCALAR_STYLE : YAML_LITERAL_SCALAR_STYLE;
          }
          elsif ($forbidden_first{ $first }) {
              $style = YAML_SINGLE_QUOTED_SCALAR_STYLE;
          }
          elsif ($flow and $value =~ tr/,[]{}//) {
              $style = YAML_SINGLE_QUOTED_SCALAR_STYLE;
          }
          elsif (substr($value, 0, 3) =~ m/^(?:---|\.\.\.)/) {
              $style = YAML_SINGLE_QUOTED_SCALAR_STYLE;
          }
          elsif ($value =~ m/: /) {
              $style = YAML_SINGLE_QUOTED_SCALAR_STYLE;
          }
          elsif ($value =~ m/ #/) {
              $style = YAML_SINGLE_QUOTED_SCALAR_STYLE;
          }
          elsif ($value =~ m/[: \t]\z/) {
              $style = YAML_SINGLE_QUOTED_SCALAR_STYLE;
          }
          elsif ($value =~ m/[^\x20-\x3A\x3B-\x7E\x85\xA0-\x{D7FF}\x{E000}-\x{FEFE}\x{FF00}-\x{FFFD}\x{10000}-\x{10FFFF}]/) {
              $style = YAML_SINGLE_QUOTED_SCALAR_STYLE;
          }
          elsif ($forbidden_first_plus_space{ $first }) {
              if (length ($value) == 1 or substr($value, 1, 1) =~ m/^\s/) {
                  $style = YAML_SINGLE_QUOTED_SCALAR_STYLE;
              }
          }
      }
      if ($style == YAML_SINGLE_QUOTED_SCALAR_STYLE and not $info->{style}) {
          if ($value =~ tr/'// and $value !~ tr/"//) {
              $style = YAML_DOUBLE_QUOTED_SCALAR_STYLE;
          }
      }
  
      my $open_ended = 0;
  
      if ($style == YAML_PLAIN_SCALAR_STYLE) {
          $value =~ s/\n/\n\n/g;
      }
      elsif ($style == YAML_SINGLE_QUOTED_SCALAR_STYLE) {
          my $new_indent = $last->{indent} . (' ' x $self->indent);
          $value =~ s/(\n+)/"\n" x (1 + (length $1))/eg;
          my @lines = split m/\n/, $value, -1;
          if (@lines > 1) {
              for my $line (@lines[1 .. $#lines]) {
                  $line = $new_indent . $line
                      if length $line;
              }
          }
          $value = join "\n", @lines;
          $value =~ s/'/''/g;
          $value = "'" . $value . "'";
      }
      elsif ($style == YAML_LITERAL_SCALAR_STYLE) {
          DEBUG and warn __PACKAGE__.':'.__LINE__.$".Data::Dumper->Dump([\$value], ['value']);
          my $indicators = '';
          if ($value =~ m/\A\n* +/) {
              $indicators .= $self->indent;
          }
          my $indent = $indent . ' ' x $self->indent;
          if ($value !~ m/\n\z/) {
              $indicators .= '-';
              $value .= "\n";
          }
          elsif ($value =~ m/(\n|\A)\n\z/) {
              $indicators .= '+';
              $open_ended = 1;
          }
          $value =~ s/^(?=.)/$indent/gm;
          $value = "|$indicators\n$value";
      }
      elsif ($style == YAML_FOLDED_SCALAR_STYLE) {
          DEBUG and warn __PACKAGE__.':'.__LINE__.$".Data::Dumper->Dump([\$value], ['value']);
          my @lines = split /\n/, $value, -1;
          DEBUG and warn __PACKAGE__.':'.__LINE__.$".Data::Dumper->Dump([\@lines], ['lines']);
          my $eol = 0;
          my $indicators = '';
          if ($value =~ m/\A\n* +/) {
              $indicators .= $self->indent;
          }
          my $indent = $indent . ' ' x $self->indent;
          if ($lines[-1] eq '') {
              pop @lines;
              $eol = 1;
          }
          else {
              $indicators .= '-';
          }
          $value = ">$indicators\n";
          for my $i (0 .. $#lines) {
              my $line = $lines[ $i ];
              if (length $line) {
                  $value .= "$indent$line\n";
              }
              if ($i != $#lines) {
                  $value .= "\n";
              }
          }
      }
      else {
          $value =~ s/([$escape_re"\\])/$to_escape{ $1 } || sprintf '\\u%04x', ord($1)/eg;
          $value = '"' . $value . '"';
      }
  
      DEBUG and warn __PACKAGE__.':'.__LINE__.": (@$stack)\n";
      my $yaml = '';
      my $pvalue = $props;
      if ($props and length $value) {
          $pvalue .= " $value";
      }
      elsif (length $value) {
          $pvalue .= $value;
      }
      my $multiline = ($style == YAML_LITERAL_SCALAR_STYLE or $style == YAML_FOLDED_SCALAR_STYLE);
      my $newline = 0;
      if ($flow) {
          $indent = 0;
          if ($props and not length $value) {
              $pvalue .= ' ';
          }
          if ($last->{type} eq 'SEQ') {
              if ($last->{index} == 0) {
                  if ($self->column) {
                      $yaml .= ' ';
                  }
                  $yaml .= "[";
              }
              else {
                  $yaml .= ", ";
              }
          }
          elsif ($last->{type} eq 'MAP') {
              if ($last->{index} == 0) {
                  if ($self->column) {
                      $yaml .= ' ';
                  }
                  $yaml .= "{";
              }
              else {
                  $yaml .= ", ";
              }
              $last->{type} = 'MAPVALUE';
          }
          elsif ($last->{type} eq 'MAPVALUE') {
              if ($last->{index} == 0) {
                  die "Should not happen (index 0 in MAPVALUE)";
              }
              $yaml .= ": ";
              $last->{type} = 'MAP';
          }
          if ($self->column + length $pvalue > $self->width) {
              $yaml .= "\n";
              $yaml .= $last->{indent};
              $yaml .= ' ' x $self->indent;
          }
          $yaml .= $pvalue;
      }
      else {
          if ($last->{type} eq 'MAP' or $last->{type} eq 'SEQ') {
              if ($last->{index} == 0 and $last->{newline}) {
                  $yaml .= "\n";
                  $last->{column} = 0;
                  $last->{newline} = 0;
              }
          }
          my $space = ' ';
          if ($last->{type} eq 'MAP') {
  
              if ($last->{column}) {
                  my $space = $self->indent > 1 ? ' ' x ($self->indent - 1) : ' ';
                  $yaml .= $space;
              }
              else {
                  $yaml .= $indent;
              }
              if ($props and not length $value) {
                  $pvalue .= ' ';
              }
              my $new_event = 'MAPVALUE';
              $last->{type} = $new_event;
              if ($multiline) {
                  # oops, a complex key
                  $yaml .= "? ";
                  $new_event = 'COMPLEXVALUE';
                  $last->{type} = $new_event;
              }
              if (not $multiline) {
                  $pvalue .= ":";
              }
          }
          else {
              if ($last->{type} eq 'MAPVALUE') {
                  $last->{type} = 'MAP';
              }
              elsif ($last->{type} eq 'DOC') {
              }
              else {
                  if ($last->{column}) {
                      my $space = $self->indent > 1 ? ' ' x ($self->indent - 1) : ' ';
                      $yaml .= $space;
                  }
                  else {
                      $yaml .= $indent;
                  }
                  if ($last->{type} eq 'COMPLEXVALUE') {
                      $last->{type} = 'MAP';
                      $yaml .= ":";
                  }
                  elsif ($last->{type} eq 'SEQ') {
                      $yaml .= "-";
                  }
                  else {
                      die "Should not happen ($last->{type} in scalar_event)";
  
                  }
                  $last->{column} = 1;
              }
  
              if (length $pvalue) {
                  if ($last->{column}) {
                      $pvalue = "$space$pvalue";
                  }
              }
              if (not $multiline) {
                  $pvalue .= "\n";
              }
          }
          $yaml .= $pvalue;
      }
  
      $last->{index}++;
      $last->{newline} = $newline;
      $self->_write($yaml);
      $last->{column} = $self->column;
      $self->{open_ended} = $open_ended;
  }
  
  sub alias_event {
      DEBUG and warn __PACKAGE__.':'.__LINE__.": +++ alias_event\n";
      my ($self, $info) = @_;
      my $stack = $self->event_stack;
      my $last = $stack->[-1];
      my $indent = $last->{indent};
      my $flow = $last->{flow};
  
      my $alias = '*' . $info->{value};
  
      my $yaml = '';
      if ($last->{type} eq 'MAP' or $last->{type} eq 'SEQ') {
          if ($last->{index} == 0 and $last->{newline}) {
              $yaml .= "\n";
              $last->{column} = 0;
              $last->{newline} = 0;
          }
      }
      $yaml .= $last->{column} ? ' ' : $indent;
      if ($flow) {
          my $space = '';
          if ($last->{type} eq 'SEQ') {
              if ($last->{index} == 0) {
                  if ($flow == 1) {
                      $yaml .= ' ';
                  }
                  $yaml .= "[";
              }
              else {
                  $yaml .= ", ";
              }
          }
          elsif ($last->{type} eq 'MAP') {
              if ($last->{index} == 0) {
                  if ($flow == 1) {
                      $yaml .= ' ';
                  }
                  $yaml .= "{";
              }
              else {
                  $yaml .= ", ";
              }
              $last->{type} = 'MAPVALUE';
              $space = ' ';
          }
          elsif ($last->{type} eq 'MAPVALUE') {
              if ($last->{index} == 0) {
                  die 23;
                  if ($flow == 1) {
                      $yaml .= ' ';
                  }
                  $yaml .= "{";
              }
              else {
                  $yaml .= ": ";
              }
              $last->{type} = 'MAP';
          }
          $yaml .= "$alias$space";
      }
      else {
          if ($last->{type} eq 'MAP') {
              $yaml .= "$alias :";
              $last->{type} = 'MAPVALUE';
          }
          else {
  
              if ($last->{type} eq 'MAPVALUE') {
                  $last->{type} = 'MAP';
              }
              elsif ($last->{type} eq 'DOC') {
                  # TODO an alias at document level isn't actually valid
              }
              else {
                  if ($last->{type} eq 'COMPLEXVALUE') {
                      $last->{type} = 'MAP';
                      $yaml .= ": ";
                  }
                  elsif ($last->{type} eq 'COMPLEX') {
                      $yaml .= ": ";
                  }
                  elsif ($last->{type} eq 'SEQ') {
                      $yaml .= "- ";
                  }
                  else {
                      die "Unexpected";
                  }
              }
              $yaml .= "$alias\n";
          }
      }
  
      $self->_write("$yaml");
      $last->{index}++;
      $last->{column} = $self->column;
      $self->{open_ended} = 0;
  }
  
  sub document_start_event {
      DEBUG and warn __PACKAGE__.':'.__LINE__.": +++ document_start_event\n";
      my ($self, $info) = @_;
      my $newline = 0;
      my $implicit = $info->{implicit};
      if ($info->{version_directive}) {
          if ($self->{open_ended}) {
              $self->_write("...\n");
          }
          $self->_write("%YAML $info->{version_directive}->{major}.$info->{version_directive}->{minor}\n");
          $self->{open_ended} = 0;
          $implicit = 0; # we need ---
      }
      unless ($implicit) {
          $newline = 1;
          $self->_write("---");
      }
      $self->set_event_stack([
          {
          type => 'DOC', index => 0, indent => '', info => $info,
          newline => $newline, column => $self->column,
          }
      ]);
  }
  
  sub document_end_event {
      DEBUG and warn __PACKAGE__.':'.__LINE__.": +++ document_end_event\n";
      my ($self, $info) = @_;
      $self->set_event_stack([]);
      if ($self->{open_ended} or not $info->{implicit}) {
          $self->_write("...\n");
          $self->{open_ended} = 0;
      }
      else {
          $self->{open_ended} = 1;
      }
  }
  
  sub stream_start_event {
  }
  
  sub stream_end_event {
  }
  
  sub emit_tag {
      my ($self, $type, $tag) = @_;
      my $map = $self->tagmap;
      for my $key (sort keys %$map) {
          if ($tag =~ m/^\Q$key\E(.*)/) {
              $tag = $map->{ $key } . $1;
              return $tag;
          }
      }
      if ($tag =~ m/^(!.*)/) {
          $tag = "$1";
      }
      else {
          $tag = "!<$tag>";
      }
      return $tag;
  }
  
  sub finish {
      my ($self) = @_;
      $self->writer->finish;
  }
  
  sub _write {
      my ($self, $yaml) = @_;
      return unless length $yaml;
      my @lines = split m/\n/, $yaml, -1;
      my $newlines = @lines - 1;
      $self->{line} += $newlines;
      if (length $lines[-1]) {
          if ($newlines) {
              $self->{column} = length $lines[-1];
          }
          else {
              $self->{column} += length $lines[-1];
          }
      }
      else {
          $self->{column} = 0;
      }
      $self->writer->write($yaml);
  }
  
  1;
  
  __END__
  
  =pod
  
  =encoding utf-8
  
  =head1 NAME
  
  YAML::PP::Emitter - Emitting events
  
  =head1 SYNOPSIS
  
      my $emitter = YAML::PP::Emitter->new(
          indent => 4,
      );
  
      $emitter->init;
  
      $emitter->stream_start_event;
      $emitter->document_start_event({ implicit => 1 });
      $emitter->sequence_start_event;
      $emitter->scalar_event({ value => $input, style => $style });
      $emitter->sequence_end_event;
      $emitter->document_end_event({ implicit => 1 });
      $emitter->stream_end_event;
  
      my $yaml = $emitter->writer->output;
      $emitter->finish;
  
  =head1 DESCRIPTION
  
  The emitter emits events to YAML. It provides methods for each event
  type. The arguments are mostly the same as the events from L<YAML::PP::Parser>.
  
  =head1 METHODS
  
  =over
  
  =item new
  
      my $emitter = YAML::PP::Emitter->new(
          indent => 4,
      );
  
  Constructor. Currently takes these options:
  
  =over
  
  =item indent
  
  =item writer
  
  =back
  
  =item stream_start_event, stream_end_event, document_start_event, document_end_event, sequence_start_event, sequence_end_event, mapping_start_event, mapping_end_event, scalar_event, alias_event
  
  =item indent, set_indent
  
  Getter/setter for number of indentation spaces.
  
  TODO: Currently sequences are always zero-indented.
  
  =item writer, set_writer
  
  Getter/setter for the writer object. By default L<YAML::PP::Writer>.
  You can pass your own writer if you want to output the resulting YAML yourself.
  
  =item init
  
  Initialize
  
  =item finish
  
  =back
  
  =cut
YAML_PP_EMITTER

$fatpacked{"YAML/PP/Exception.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'YAML_PP_EXCEPTION';
  use strict;
  use warnings;
  package YAML::PP::Exception;
  
  our $VERSION = '0.027'; # VERSION
  
  use overload '""' => \&to_string;
  
  sub new {
      my ($class, %args) = @_;
      my $self = bless {
          line => $args{line},
          msg => $args{msg},
          next => $args{next},
          where => $args{where},
          yaml => $args{yaml},
          got => $args{got},
          expected => $args{expected},
          column => $args{column},
      }, $class;
      return $self;
  }
  
  sub to_string {
      my ($self) = @_;
      my $next = $self->{next};
      my $line = $self->{line};
      my $column = $self->{column};
  
      my $yaml = '';
      for my $token (@$next) {
          last if $token->{name} eq 'EOL';
          $yaml .= $token->{value};
      }
      $column = '???' unless defined $column;
  
      my $remaining_yaml = $self->{yaml};
      $remaining_yaml = '' unless defined $remaining_yaml;
      $yaml .= $remaining_yaml;
      {
          local $@; # avoid bug in old Data::Dumper
          require Data::Dumper;
          local $Data::Dumper::Useqq = 1;
          local $Data::Dumper::Terse = 1;
          $yaml = Data::Dumper->Dump([$yaml], ['yaml']);
          chomp $yaml;
      }
  
      my $lines = 5;
      my @fields;
  
      if ($self->{got} and $self->{expected}) {
          $lines = 6;
          $line = $self->{got}->{line};
          $column = $self->{got}->{column} + 1;
          @fields = (
              "Line" => $line,
              "Column" => $column,
              "Expected", join(" ", @{ $self->{expected} }),
              "Got", $self->{got}->{name},
              "Where", $self->{where},
              "YAML", $yaml,
          );
      }
      else {
          @fields = (
              "Line" => $line,
              "Column" => $column,
              "Message", $self->{msg},
              "Where", $self->{where},
              "YAML", $yaml,
          );
      }
      my $fmt = join "\n", ("%-10s: %s") x $lines;
      my $string = sprintf $fmt, @fields;
      return $string;
  }
  
  1;
YAML_PP_EXCEPTION

$fatpacked{"YAML/PP/Grammar.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'YAML_PP_GRAMMAR';
  use strict;
  use warnings;
  package YAML::PP::Grammar;
  
  our $VERSION = '0.027'; # VERSION
  
  use base 'Exporter';
  
  our @EXPORT_OK = qw/ $GRAMMAR /;
  
  our $GRAMMAR = {};
  
  # START OF GRAMMAR INLINE
  
  # DO NOT CHANGE THIS
  # This grammar is automatically generated from etc/grammar.yaml
  
  $GRAMMAR = {
    'DIRECTIVE' => {
      'DOC_START' => {
        'EOL' => {
          'new' => 'FULLNODE'
        },
        'WS' => {
          'new' => 'FULLNODE'
        },
        'match' => 'cb_doc_start_explicit'
      },
      'EOL' => {
        'new' => 'DIRECTIVE'
      },
      'RESERVED_DIRECTIVE' => {
        'EOL' => {
          'new' => 'DIRECTIVE'
        },
        'WS' => {
          'new' => 'DIRECTIVE'
        },
        'match' => 'cb_reserved_directive'
      },
      'TAG_DIRECTIVE' => {
        'EOL' => {
          'new' => 'DIRECTIVE'
        },
        'WS' => {
          'new' => 'DIRECTIVE'
        },
        'match' => 'cb_tag_directive'
      },
      'YAML_DIRECTIVE' => {
        'EOL' => {
          'new' => 'DIRECTIVE'
        },
        'WS' => {
          'new' => 'DIRECTIVE'
        },
        'match' => 'cb_set_yaml_version_directive'
      }
    },
    'DOCUMENT_END' => {
      'DOC_END' => {
        'EOL' => {},
        'match' => 'cb_end_document'
      },
      'DOC_START' => {
        'EOL' => {
          'new' => 'FULLNODE'
        },
        'WS' => {
          'new' => 'FULLNODE'
        },
        'match' => 'cb_end_doc_start_document'
      },
      'EOL' => {
        'new' => 'DOCUMENT_END'
      }
    },
    'FLOWMAP' => {
      'ALIAS' => {
        'match' => 'cb_send_alias',
        'return' => 1
      },
      'COLON' => {
        'EOL' => {
          'match' => 'cb_empty_flow_mapkey',
          'new' => 'RULE_FULLFLOWSCALAR'
        },
        'WS' => {
          'match' => 'cb_empty_flow_mapkey',
          'new' => 'RULE_FULLFLOWSCALAR'
        }
      },
      'FLOWMAP_START' => {
        'match' => 'cb_start_flowmap',
        'new' => 'NEWFLOWMAP'
      },
      'FLOWSEQ_START' => {
        'match' => 'cb_start_flowseq',
        'new' => 'NEWFLOWSEQ'
      },
      'PLAIN' => {
        'match' => 'cb_flowkey_plain',
        'return' => 1
      },
      'PLAIN_MULTI' => {
        'match' => 'cb_send_plain_multi',
        'return' => 1
      },
      'QUOTED' => {
        'match' => 'cb_flowkey_quoted',
        'return' => 1
      },
      'QUOTED_MULTILINE' => {
        'match' => 'cb_quoted_multiline',
        'return' => 1
      }
    },
    'FLOWSEQ' => {
      'ALIAS' => {
        'match' => 'cb_send_flow_alias',
        'new' => 'FLOWSEQ_NEXT'
      },
      'FLOWMAP_START' => {
        'match' => 'cb_start_flowmap',
        'new' => 'NEWFLOWMAP'
      },
      'FLOWSEQ_START' => {
        'match' => 'cb_start_flowseq',
        'new' => 'NEWFLOWSEQ'
      },
      'PLAIN' => {
        'match' => 'cb_flow_plain',
        'new' => 'FLOWSEQ_NEXT'
      },
      'PLAIN_MULTI' => {
        'match' => 'cb_send_plain_multi',
        'new' => 'FLOWSEQ_NEXT'
      },
      'QUOTED' => {
        'match' => 'cb_flowkey_quoted',
        'new' => 'FLOWSEQ_NEXT'
      },
      'QUOTED_MULTILINE' => {
        'match' => 'cb_quoted_multiline',
        'new' => 'FLOWSEQ_NEXT'
      }
    },
    'FLOWSEQ_NEXT' => {
      'EOL' => {
        'new' => 'FLOWSEQ_NEXT'
      },
      'FLOWSEQ_END' => {
        'match' => 'cb_end_flowseq',
        'return' => 1
      },
      'FLOW_COMMA' => {
        'match' => 'cb_flow_comma',
        'return' => 1
      },
      'WS' => {
        'new' => 'FLOWSEQ_NEXT'
      }
    },
    'FULLMAPVALUE_INLINE' => {
      'ANCHOR' => {
        'EOL' => {
          'match' => 'cb_property_eol',
          'new' => 'FULLNODE_ANCHOR'
        },
        'WS' => {
          'DEFAULT' => {
            'new' => 'NODETYPE_MAPVALUE_INLINE'
          },
          'TAG' => {
            'EOL' => {
              'match' => 'cb_property_eol',
              'new' => 'FULLNODE_TAG_ANCHOR'
            },
            'WS' => {
              'new' => 'NODETYPE_MAPVALUE_INLINE'
            },
            'match' => 'cb_tag'
          }
        },
        'match' => 'cb_anchor'
      },
      'DEFAULT' => {
        'new' => 'NODETYPE_MAPVALUE_INLINE'
      },
      'TAG' => {
        'EOL' => {
          'match' => 'cb_property_eol',
          'new' => 'FULLNODE_TAG'
        },
        'WS' => {
          'ANCHOR' => {
            'EOL' => {
              'match' => 'cb_property_eol',
              'new' => 'FULLNODE_TAG_ANCHOR'
            },
            'WS' => {
              'new' => 'NODETYPE_MAPVALUE_INLINE'
            },
            'match' => 'cb_anchor'
          },
          'DEFAULT' => {
            'new' => 'NODETYPE_MAPVALUE_INLINE'
          }
        },
        'match' => 'cb_tag'
      }
    },
    'FULLNODE' => {
      'ANCHOR' => {
        'EOL' => {
          'match' => 'cb_property_eol',
          'new' => 'FULLNODE_ANCHOR'
        },
        'WS' => {
          'DEFAULT' => {
            'new' => 'NODETYPE_SCALAR_OR_MAP'
          },
          'TAG' => {
            'EOL' => {
              'match' => 'cb_property_eol',
              'new' => 'FULLNODE_TAG_ANCHOR'
            },
            'WS' => {
              'new' => 'NODETYPE_SCALAR_OR_MAP'
            },
            'match' => 'cb_tag'
          }
        },
        'match' => 'cb_anchor'
      },
      'DEFAULT' => {
        'new' => 'NODETYPE_NODE'
      },
      'EOL' => {
        'new' => 'FULLNODE'
      },
      'TAG' => {
        'EOL' => {
          'match' => 'cb_property_eol',
          'new' => 'FULLNODE_TAG'
        },
        'WS' => {
          'ANCHOR' => {
            'EOL' => {
              'match' => 'cb_property_eol',
              'new' => 'FULLNODE_TAG_ANCHOR'
            },
            'WS' => {
              'new' => 'NODETYPE_SCALAR_OR_MAP'
            },
            'match' => 'cb_anchor'
          },
          'DEFAULT' => {
            'new' => 'NODETYPE_SCALAR_OR_MAP'
          }
        },
        'match' => 'cb_tag'
      }
    },
    'FULLNODE_ANCHOR' => {
      'ANCHOR' => {
        'WS' => {
          'DEFAULT' => {
            'new' => 'NODETYPE_SCALAR_OR_MAP'
          },
          'TAG' => {
            'WS' => {
              'new' => 'NODETYPE_SCALAR_OR_MAP'
            },
            'match' => 'cb_tag'
          }
        },
        'match' => 'cb_anchor'
      },
      'DEFAULT' => {
        'new' => 'NODETYPE_NODE'
      },
      'EOL' => {
        'new' => 'FULLNODE_ANCHOR'
      },
      'TAG' => {
        'EOL' => {
          'match' => 'cb_property_eol',
          'new' => 'FULLNODE_TAG_ANCHOR'
        },
        'WS' => {
          'ANCHOR' => {
            'WS' => {
              'new' => 'NODETYPE_SCALAR_OR_MAP'
            },
            'match' => 'cb_anchor'
          },
          'DEFAULT' => {
            'new' => 'NODETYPE_SCALAR_OR_MAP'
          }
        },
        'match' => 'cb_tag'
      }
    },
    'FULLNODE_TAG' => {
      'ANCHOR' => {
        'EOL' => {
          'match' => 'cb_property_eol',
          'new' => 'FULLNODE_TAG_ANCHOR'
        },
        'WS' => {
          'DEFAULT' => {
            'new' => 'NODETYPE_SCALAR_OR_MAP'
          },
          'TAG' => {
            'WS' => {
              'new' => 'NODETYPE_SCALAR_OR_MAP'
            },
            'match' => 'cb_tag'
          }
        },
        'match' => 'cb_anchor'
      },
      'DEFAULT' => {
        'new' => 'NODETYPE_NODE'
      },
      'EOL' => {
        'new' => 'FULLNODE_TAG'
      },
      'TAG' => {
        'WS' => {
          'ANCHOR' => {
            'WS' => {
              'new' => 'NODETYPE_SCALAR_OR_MAP'
            },
            'match' => 'cb_anchor'
          },
          'DEFAULT' => {
            'new' => 'NODETYPE_SCALAR_OR_MAP'
          }
        },
        'match' => 'cb_tag'
      }
    },
    'FULLNODE_TAG_ANCHOR' => {
      'ANCHOR' => {
        'WS' => {
          'DEFAULT' => {
            'new' => 'NODETYPE_SCALAR_OR_MAP'
          },
          'TAG' => {
            'WS' => {
              'new' => 'NODETYPE_SCALAR_OR_MAP'
            },
            'match' => 'cb_tag'
          }
        },
        'match' => 'cb_anchor'
      },
      'DEFAULT' => {
        'new' => 'NODETYPE_NODE'
      },
      'EOL' => {
        'new' => 'FULLNODE_TAG_ANCHOR'
      },
      'TAG' => {
        'WS' => {
          'ANCHOR' => {
            'WS' => {
              'new' => 'NODETYPE_SCALAR_OR_MAP'
            },
            'match' => 'cb_anchor'
          },
          'DEFAULT' => {
            'new' => 'NODETYPE_SCALAR_OR_MAP'
          }
        },
        'match' => 'cb_tag'
      }
    },
    'NEWFLOWMAP' => {
      'ANCHOR' => {
        'EOL' => {
          'new' => 'NEWFLOWMAP_ANCHOR'
        },
        'WS' => {
          'new' => 'NEWFLOWMAP_ANCHOR'
        },
        'match' => 'cb_anchor'
      },
      'COLON' => {
        'EOL' => {
          'match' => 'cb_empty_flow_mapkey',
          'new' => 'RULE_FULLFLOWSCALAR'
        },
        'WS' => {
          'match' => 'cb_empty_flow_mapkey',
          'new' => 'RULE_FULLFLOWSCALAR'
        }
      },
      'DEFAULT' => {
        'new' => 'FLOWMAP'
      },
      'EOL' => {
        'new' => 'NEWFLOWMAP'
      },
      'FLOWMAP_END' => {
        'match' => 'cb_end_flowmap',
        'return' => 1
      },
      'QUESTION' => {
        'match' => 'cb_flow_question',
        'new' => 'NEWFLOWMAP'
      },
      'TAG' => {
        'EOL' => {
          'new' => 'NEWFLOWMAP_TAG'
        },
        'WS' => {
          'new' => 'NEWFLOWMAP_TAG'
        },
        'match' => 'cb_tag'
      },
      'WS' => {
        'new' => 'NEWFLOWMAP'
      }
    },
    'NEWFLOWMAP_ANCHOR' => {
      'DEFAULT' => {
        'new' => 'FLOWMAP'
      },
      'EOL' => {
        'new' => 'NEWFLOWMAP_ANCHOR'
      },
      'TAG' => {
        'EOL' => {
          'new' => 'FLOWMAP'
        },
        'WS' => {
          'new' => 'FLOWMAP'
        },
        'match' => 'cb_tag'
      },
      'WS' => {
        'new' => 'NEWFLOWMAP_ANCHOR'
      }
    },
    'NEWFLOWMAP_TAG' => {
      'ANCHOR' => {
        'EOL' => {
          'new' => 'FLOWMAP'
        },
        'WS' => {
          'new' => 'FLOWMAP'
        },
        'match' => 'cb_anchor'
      },
      'DEFAULT' => {
        'new' => 'FLOWMAP'
      },
      'EOL' => {
        'new' => 'NEWFLOWMAP_TAG'
      },
      'WS' => {
        'new' => 'NEWFLOWMAP_TAG'
      }
    },
    'NEWFLOWSEQ' => {
      'ANCHOR' => {
        'EOL' => {
          'new' => 'NEWFLOWSEQ_ANCHOR'
        },
        'WS' => {
          'new' => 'NEWFLOWSEQ_ANCHOR'
        },
        'match' => 'cb_anchor'
      },
      'DEFAULT' => {
        'new' => 'FLOWSEQ'
      },
      'EOL' => {
        'new' => 'NEWFLOWSEQ'
      },
      'FLOWSEQ_END' => {
        'match' => 'cb_end_flowseq',
        'return' => 1
      },
      'TAG' => {
        'EOL' => {
          'new' => 'NEWFLOWSEQ_TAG'
        },
        'WS' => {
          'new' => 'NEWFLOWSEQ_TAG'
        },
        'match' => 'cb_tag'
      },
      'WS' => {
        'new' => 'NEWFLOWSEQ'
      }
    },
    'NEWFLOWSEQ_ANCHOR' => {
      'DEFAULT' => {
        'new' => 'FLOWSEQ'
      },
      'EOL' => {
        'new' => 'NEWFLOWSEQ_ANCHOR'
      },
      'TAG' => {
        'EOL' => {
          'new' => 'FLOWSEQ'
        },
        'WS' => {
          'new' => 'FLOWSEQ'
        },
        'match' => 'cb_tag'
      },
      'WS' => {
        'new' => 'NEWFLOWSEQ_ANCHOR'
      }
    },
    'NEWFLOWSEQ_TAG' => {
      'ANCHOR' => {
        'EOL' => {
          'new' => 'FLOWSEQ'
        },
        'WS' => {
          'new' => 'FLOWSEQ'
        },
        'match' => 'cb_anchor'
      },
      'DEFAULT' => {
        'new' => 'FLOWSEQ'
      },
      'EOL' => {
        'new' => 'NEWFLOWSEQ_TAG'
      },
      'WS' => {
        'new' => 'NEWFLOWSEQ_TAG'
      }
    },
    'NODETYPE_COMPLEX' => {
      'COLON' => {
        'EOL' => {
          'new' => 'FULLNODE'
        },
        'WS' => {
          'new' => 'FULLNODE'
        },
        'match' => 'cb_complexcolon'
      },
      'DEFAULT' => {
        'match' => 'cb_empty_complexvalue',
        'new' => 'NODETYPE_MAP'
      },
      'EOL' => {
        'new' => 'NODETYPE_COMPLEX'
      }
    },
    'NODETYPE_FLOWMAP' => {
      'DEFAULT' => {
        'new' => 'NEWFLOWMAP'
      },
      'EOL' => {
        'new' => 'NODETYPE_FLOWMAP'
      },
      'FLOWMAP_END' => {
        'match' => 'cb_end_flowmap',
        'return' => 1
      },
      'FLOW_COMMA' => {
        'match' => 'cb_flow_comma',
        'new' => 'NEWFLOWMAP'
      },
      'WS' => {
        'new' => 'NODETYPE_FLOWMAP'
      }
    },
    'NODETYPE_FLOWMAPVALUE' => {
      'COLON' => {
        'DEFAULT' => {
          'new' => 'RULE_FULLFLOWSCALAR'
        },
        'EOL' => {
          'new' => 'RULE_FULLFLOWSCALAR'
        },
        'WS' => {
          'new' => 'RULE_FULLFLOWSCALAR'
        },
        'match' => 'cb_flow_colon'
      },
      'EOL' => {
        'new' => 'NODETYPE_FLOWMAPVALUE'
      },
      'FLOWMAP_END' => {
        'match' => 'cb_end_flowmap_empty',
        'return' => 1
      },
      'FLOW_COMMA' => {
        'match' => 'cb_empty_flowmap_value',
        'return' => 1
      },
      'WS' => {
        'new' => 'NODETYPE_FLOWMAPVALUE'
      }
    },
    'NODETYPE_FLOWSEQ' => {
      'DEFAULT' => {
        'new' => 'NEWFLOWSEQ'
      },
      'EOL' => {
        'new' => 'NODETYPE_FLOWSEQ'
      },
      'FLOWSEQ_END' => {
        'match' => 'cb_end_flowseq',
        'return' => 1
      },
      'WS' => {
        'new' => 'NODETYPE_FLOWSEQ'
      }
    },
    'NODETYPE_MAP' => {
      'ANCHOR' => {
        'WS' => {
          'DEFAULT' => {
            'new' => 'RULE_MAPKEY'
          },
          'TAG' => {
            'WS' => {
              'new' => 'RULE_MAPKEY'
            },
            'match' => 'cb_tag'
          }
        },
        'match' => 'cb_anchor'
      },
      'DEFAULT' => {
        'new' => 'RULE_MAPKEY'
      },
      'TAG' => {
        'WS' => {
          'ANCHOR' => {
            'WS' => {
              'new' => 'RULE_MAPKEY'
            },
            'match' => 'cb_anchor'
          },
          'DEFAULT' => {
            'new' => 'RULE_MAPKEY'
          }
        },
        'match' => 'cb_tag'
      }
    },
    'NODETYPE_MAPVALUE_INLINE' => {
      'ALIAS' => {
        'EOL' => {},
        'match' => 'cb_send_alias'
      },
      'BLOCK_SCALAR' => {
        'EOL' => {},
        'match' => 'cb_send_block_scalar'
      },
      'DOC_END' => {
        'EOL' => {},
        'match' => 'cb_end_document'
      },
      'FLOWMAP_START' => {
        'match' => 'cb_start_flowmap',
        'new' => 'NEWFLOWMAP'
      },
      'FLOWSEQ_START' => {
        'match' => 'cb_start_flowseq',
        'new' => 'NEWFLOWSEQ'
      },
      'PLAIN' => {
        'EOL' => {
          'match' => 'cb_send_scalar'
        },
        'match' => 'cb_start_plain'
      },
      'PLAIN_MULTI' => {
        'EOL' => {},
        'match' => 'cb_send_plain_multi'
      },
      'QUOTED' => {
        'EOL' => {
          'match' => 'cb_send_scalar'
        },
        'match' => 'cb_take_quoted'
      },
      'QUOTED_MULTILINE' => {
        'EOL' => {},
        'match' => 'cb_quoted_multiline'
      }
    },
    'NODETYPE_NODE' => {
      'DASH' => {
        'EOL' => {
          'new' => 'FULLNODE'
        },
        'WS' => {
          'new' => 'FULLNODE'
        },
        'match' => 'cb_seqstart'
      },
      'DEFAULT' => {
        'new' => 'NODETYPE_SCALAR_OR_MAP'
      }
    },
    'NODETYPE_SCALAR_OR_MAP' => {
      'ALIAS' => {
        'EOL' => {
          'match' => 'cb_send_alias_from_stack'
        },
        'WS' => {
          'COLON' => {
            'EOL' => {
              'new' => 'FULLNODE'
            },
            'WS' => {
              'new' => 'FULLMAPVALUE_INLINE'
            },
            'match' => 'cb_insert_map_alias'
          }
        },
        'match' => 'cb_alias'
      },
      'BLOCK_SCALAR' => {
        'EOL' => {},
        'match' => 'cb_send_block_scalar'
      },
      'COLON' => {
        'EOL' => {
          'new' => 'FULLNODE'
        },
        'WS' => {
          'new' => 'FULLMAPVALUE_INLINE'
        },
        'match' => 'cb_insert_empty_map'
      },
      'DOC_END' => {
        'EOL' => {},
        'match' => 'cb_end_document'
      },
      'DOC_START' => {
        'EOL' => {
          'new' => 'FULLNODE'
        },
        'WS' => {
          'new' => 'FULLNODE'
        },
        'match' => 'cb_end_doc_start_document'
      },
      'EOL' => {
        'new' => 'NODETYPE_SCALAR_OR_MAP'
      },
      'FLOWMAP_START' => {
        'match' => 'cb_start_flowmap',
        'new' => 'NEWFLOWMAP'
      },
      'FLOWSEQ_START' => {
        'match' => 'cb_start_flowseq',
        'new' => 'NEWFLOWSEQ'
      },
      'PLAIN' => {
        'COLON' => {
          'EOL' => {
            'new' => 'FULLNODE'
          },
          'WS' => {
            'new' => 'FULLMAPVALUE_INLINE'
          },
          'match' => 'cb_insert_map'
        },
        'EOL' => {
          'match' => 'cb_send_scalar'
        },
        'WS' => {
          'COLON' => {
            'EOL' => {
              'new' => 'FULLNODE'
            },
            'WS' => {
              'new' => 'FULLMAPVALUE_INLINE'
            },
            'match' => 'cb_insert_map'
          }
        },
        'match' => 'cb_start_plain'
      },
      'PLAIN_MULTI' => {
        'EOL' => {},
        'match' => 'cb_send_plain_multi'
      },
      'QUESTION' => {
        'EOL' => {
          'new' => 'FULLNODE'
        },
        'WS' => {
          'new' => 'FULLNODE'
        },
        'match' => 'cb_questionstart'
      },
      'QUOTED' => {
        'COLON' => {
          'EOL' => {
            'new' => 'FULLNODE'
          },
          'WS' => {
            'new' => 'FULLMAPVALUE_INLINE'
          },
          'match' => 'cb_insert_map'
        },
        'EOL' => {
          'match' => 'cb_send_scalar'
        },
        'WS' => {
          'COLON' => {
            'EOL' => {
              'new' => 'FULLNODE'
            },
            'WS' => {
              'new' => 'FULLMAPVALUE_INLINE'
            },
            'match' => 'cb_insert_map'
          }
        },
        'match' => 'cb_take_quoted'
      },
      'QUOTED_MULTILINE' => {
        'EOL' => {},
        'match' => 'cb_quoted_multiline'
      },
      'WS' => {
        'new' => 'FULLMAPVALUE_INLINE'
      }
    },
    'NODETYPE_SEQ' => {
      'DASH' => {
        'EOL' => {
          'new' => 'FULLNODE'
        },
        'WS' => {
          'new' => 'FULLNODE'
        },
        'match' => 'cb_seqitem'
      },
      'DOC_END' => {
        'EOL' => {},
        'match' => 'cb_end_document'
      },
      'DOC_START' => {
        'EOL' => {
          'new' => 'FULLNODE'
        },
        'WS' => {
          'new' => 'FULLNODE'
        },
        'match' => 'cb_end_doc_start_document'
      },
      'EOL' => {
        'new' => 'NODETYPE_SEQ'
      }
    },
    'RULE_FLOWSCALAR' => {
      'ALIAS' => {
        'match' => 'cb_send_alias',
        'return' => 1
      },
      'FLOWMAP_END' => {
        'match' => 'cb_end_flowmap_empty',
        'return' => 1
      },
      'FLOWMAP_START' => {
        'match' => 'cb_start_flowmap',
        'new' => 'NEWFLOWMAP'
      },
      'FLOWSEQ_START' => {
        'match' => 'cb_start_flowseq',
        'new' => 'NEWFLOWSEQ'
      },
      'FLOW_COMMA' => {
        'match' => 'cb_empty_flow_mapkey',
        'return' => 1
      },
      'PLAIN' => {
        'DEFAULT' => {
          'match' => 'cb_send_scalar',
          'return' => 1
        },
        'EOL' => {
          'match' => 'cb_send_scalar'
        },
        'match' => 'cb_start_plain'
      },
      'PLAIN_MULTI' => {
        'match' => 'cb_send_plain_multi',
        'return' => 1
      },
      'QUOTED' => {
        'DEFAULT' => {
          'match' => 'cb_send_scalar',
          'return' => 1
        },
        'EOL' => {
          'match' => 'cb_send_scalar'
        },
        'WS' => {
          'match' => 'cb_send_scalar',
          'return' => 1
        },
        'match' => 'cb_take_quoted'
      },
      'QUOTED_MULTILINE' => {
        'match' => 'cb_quoted_multiline',
        'return' => 1
      }
    },
    'RULE_FULLFLOWSCALAR' => {
      'ANCHOR' => {
        'DEFAULT' => {
          'new' => 'RULE_FULLFLOWSCALAR_ANCHOR'
        },
        'EOL' => {
          'new' => 'RULE_FULLFLOWSCALAR_ANCHOR'
        },
        'match' => 'cb_anchor'
      },
      'DEFAULT' => {
        'new' => 'RULE_FLOWSCALAR'
      },
      'TAG' => {
        'DEFAULT' => {
          'new' => 'RULE_FULLFLOWSCALAR_TAG'
        },
        'EOL' => {
          'new' => 'RULE_FULLFLOWSCALAR_TAG'
        },
        'match' => 'cb_tag'
      }
    },
    'RULE_FULLFLOWSCALAR_ANCHOR' => {
      'DEFAULT' => {
        'new' => 'RULE_FLOWSCALAR'
      },
      'TAG' => {
        'EOL' => {
          'new' => 'RULE_FLOWSCALAR'
        },
        'WS' => {
          'new' => 'RULE_FLOWSCALAR'
        },
        'match' => 'cb_tag'
      },
      'WS' => {
        'new' => 'RULE_FULLFLOWSCALAR_ANCHOR'
      }
    },
    'RULE_FULLFLOWSCALAR_TAG' => {
      'ANCHOR' => {
        'EOL' => {
          'new' => 'RULE_FLOWSCALAR'
        },
        'WS' => {
          'new' => 'RULE_FLOWSCALAR'
        },
        'match' => 'cb_anchor'
      },
      'DEFAULT' => {
        'new' => 'RULE_FLOWSCALAR'
      },
      'WS' => {
        'new' => 'RULE_FULLFLOWSCALAR_TAG'
      }
    },
    'RULE_MAPKEY' => {
      'ALIAS' => {
        'WS' => {
          'COLON' => {
            'EOL' => {
              'new' => 'FULLNODE'
            },
            'WS' => {
              'new' => 'FULLMAPVALUE_INLINE'
            }
          }
        },
        'match' => 'cb_send_alias'
      },
      'COLON' => {
        'EOL' => {
          'new' => 'FULLNODE'
        },
        'WS' => {
          'new' => 'FULLMAPVALUE_INLINE'
        },
        'match' => 'cb_empty_mapkey'
      },
      'DOC_END' => {
        'EOL' => {},
        'match' => 'cb_end_document'
      },
      'DOC_START' => {
        'EOL' => {
          'new' => 'FULLNODE'
        },
        'WS' => {
          'new' => 'FULLNODE'
        },
        'match' => 'cb_end_doc_start_document'
      },
      'EOL' => {
        'new' => 'RULE_MAPKEY'
      },
      'PLAIN' => {
        'COLON' => {
          'EOL' => {
            'new' => 'FULLNODE'
          },
          'WS' => {
            'new' => 'FULLMAPVALUE_INLINE'
          },
          'match' => 'cb_send_mapkey'
        },
        'WS' => {
          'COLON' => {
            'EOL' => {
              'new' => 'FULLNODE'
            },
            'WS' => {
              'new' => 'FULLMAPVALUE_INLINE'
            },
            'match' => 'cb_send_mapkey'
          }
        },
        'match' => 'cb_mapkey'
      },
      'QUESTION' => {
        'EOL' => {
          'new' => 'FULLNODE'
        },
        'WS' => {
          'new' => 'FULLNODE'
        },
        'match' => 'cb_question'
      },
      'QUOTED' => {
        'COLON' => {
          'EOL' => {
            'new' => 'FULLNODE'
          },
          'WS' => {
            'new' => 'FULLMAPVALUE_INLINE'
          }
        },
        'WS' => {
          'COLON' => {
            'EOL' => {
              'new' => 'FULLNODE'
            },
            'WS' => {
              'new' => 'FULLMAPVALUE_INLINE'
            }
          }
        },
        'match' => 'cb_take_quoted_key'
      }
    },
    'STREAM' => {
      'DEFAULT' => {
        'match' => 'cb_doc_start_implicit',
        'new' => 'FULLNODE'
      },
      'DOC_END' => {
        'EOL' => {},
        'match' => 'cb_end_document_empty'
      },
      'DOC_START' => {
        'EOL' => {
          'new' => 'FULLNODE'
        },
        'WS' => {
          'new' => 'FULLNODE'
        },
        'match' => 'cb_doc_start_explicit'
      },
      'EOL' => {
        'new' => 'STREAM'
      },
      'RESERVED_DIRECTIVE' => {
        'EOL' => {
          'new' => 'DIRECTIVE'
        },
        'WS' => {
          'new' => 'DIRECTIVE'
        },
        'match' => 'cb_reserved_directive'
      },
      'TAG_DIRECTIVE' => {
        'EOL' => {
          'new' => 'DIRECTIVE'
        },
        'WS' => {
          'new' => 'DIRECTIVE'
        },
        'match' => 'cb_tag_directive'
      },
      'YAML_DIRECTIVE' => {
        'EOL' => {
          'new' => 'DIRECTIVE'
        },
        'WS' => {
          'new' => 'DIRECTIVE'
        },
        'match' => 'cb_set_yaml_version_directive'
      }
    }
  };
  
  
  # END OF GRAMMAR INLINE
  
  1;
  
  __END__
  
  =pod
  
  =encoding utf-8
  
  =head1 NAME
  
  YAML::PP::Grammar - YAML grammar
  
  =head1 GRAMMAR
  
  This is the Grammar in YAML
  
      # START OF YAML INLINE
  
      # DO NOT CHANGE THIS
      # This grammar is automatically generated from etc/grammar.yaml
  
      ---
      NODETYPE_NODE:
        DASH:
          match: cb_seqstart
          EOL: { new: FULLNODE }
          WS: { new: FULLNODE }
      
        DEFAULT: { new: NODETYPE_SCALAR_OR_MAP }
      
      NODETYPE_SCALAR_OR_MAP:
      
        # Flow nodes can follow tabs
        WS: { new: FULLMAPVALUE_INLINE }
      
        ALIAS:
          match: cb_alias
          EOL: { match: cb_send_alias_from_stack }
          WS:
            COLON:
              match: cb_insert_map_alias
              EOL: { new: FULLNODE }
              WS: { new: FULLMAPVALUE_INLINE }
      
        QUESTION:
          match: cb_questionstart
          EOL: { new: FULLNODE }
          WS: { new: FULLNODE }
      
        QUOTED:
          match: cb_take_quoted
          EOL: { match: cb_send_scalar }
          WS:
            COLON:
              match: cb_insert_map
              EOL: { new: FULLNODE }
              WS: { new: FULLMAPVALUE_INLINE }
          COLON:
            match: cb_insert_map
            EOL: { new: FULLNODE }
            WS: { new: FULLMAPVALUE_INLINE }
      
        QUOTED_MULTILINE:
          match: cb_quoted_multiline
          EOL: {  }
      
      
        PLAIN:
          match: cb_start_plain
          EOL:
            match: cb_send_scalar
          WS:
            COLON:
              match: cb_insert_map
              EOL: { new: FULLNODE }
              WS: { new: FULLMAPVALUE_INLINE }
          COLON:
            match: cb_insert_map
            EOL: { new: FULLNODE }
            WS: { new: FULLMAPVALUE_INLINE }
      
        PLAIN_MULTI:
          match: cb_send_plain_multi
          EOL: { }
      
        COLON:
          match: cb_insert_empty_map
          EOL: { new: FULLNODE }
          WS: { new: FULLMAPVALUE_INLINE }
      
        BLOCK_SCALAR:
          match: cb_send_block_scalar
          EOL: { }
      
        FLOWSEQ_START:
          match: cb_start_flowseq
          new: NEWFLOWSEQ
      
        FLOWMAP_START:
          match: cb_start_flowmap
          new: NEWFLOWMAP
      
        DOC_END:
          match: cb_end_document
          EOL: { }
      
        DOC_START:
          match: cb_end_doc_start_document
          EOL: { new: FULLNODE }
          WS: { new: FULLNODE }
      
        EOL:
          new: NODETYPE_SCALAR_OR_MAP
      
      NODETYPE_COMPLEX:
        COLON:
          match: cb_complexcolon
          EOL: { new: FULLNODE }
          WS: { new: FULLNODE }
        DEFAULT:
          match: cb_empty_complexvalue
          new: NODETYPE_MAP
        EOL:
          new: NODETYPE_COMPLEX
      
      RULE_FULLFLOWSCALAR:
        ANCHOR:
          match: cb_anchor
          EOL: { new: RULE_FULLFLOWSCALAR_ANCHOR }
          DEFAULT: { new: RULE_FULLFLOWSCALAR_ANCHOR }
        TAG:
          match: cb_tag
          EOL: { new: RULE_FULLFLOWSCALAR_TAG }
          DEFAULT: { new: RULE_FULLFLOWSCALAR_TAG }
        DEFAULT: { new: RULE_FLOWSCALAR }
      
      RULE_FULLFLOWSCALAR_ANCHOR:
        WS: { new: RULE_FULLFLOWSCALAR_ANCHOR }
        TAG:
          match: cb_tag
          WS: { new: RULE_FLOWSCALAR }
          EOL: { new: RULE_FLOWSCALAR }
        DEFAULT: { new: RULE_FLOWSCALAR }
      
      RULE_FULLFLOWSCALAR_TAG:
        WS: { new: RULE_FULLFLOWSCALAR_TAG }
        ANCHOR:
          match: cb_anchor
          WS: { new: RULE_FLOWSCALAR }
          EOL: { new: RULE_FLOWSCALAR }
        DEFAULT: { new: RULE_FLOWSCALAR }
      
      RULE_FLOWSCALAR:
        FLOWSEQ_START: { match: cb_start_flowseq, new: NEWFLOWSEQ }
        FLOWMAP_START: { match: cb_start_flowmap, new: NEWFLOWMAP }
      
        ALIAS: { match: cb_send_alias, return: 1 }
      
        QUOTED:
          match: cb_take_quoted
          EOL: { match: cb_send_scalar }
          WS: { match: cb_send_scalar, return: 1 }
          DEFAULT: { match: cb_send_scalar, return: 1 }
      
        QUOTED_MULTILINE: { match: cb_quoted_multiline, return: 1 }
      
        PLAIN:
          match: cb_start_plain
          EOL: { match: cb_send_scalar }
          DEFAULT: { match: cb_send_scalar, return: 1 }
      
        PLAIN_MULTI: { match: cb_send_plain_multi, return: 1 }
      
        FLOW_COMMA: { match: cb_empty_flow_mapkey, return: 1 }
      
        FLOWMAP_END:
          match: cb_end_flowmap_empty
          return: 1
      
      FLOWSEQ:
        FLOWSEQ_START: { match: cb_start_flowseq, new: NEWFLOWSEQ }
        FLOWMAP_START: { match: cb_start_flowmap, new: NEWFLOWMAP }
      
        ALIAS: { match: cb_send_flow_alias, new: FLOWSEQ_NEXT }
      
        PLAIN: { match: cb_flow_plain, new: FLOWSEQ_NEXT }
        PLAIN_MULTI: { match: cb_send_plain_multi, new: FLOWSEQ_NEXT }
      
        QUOTED: { match: cb_flowkey_quoted, new: FLOWSEQ_NEXT }
        QUOTED_MULTILINE: { match: cb_quoted_multiline, new: FLOWSEQ_NEXT }
      
      FLOWSEQ_NEXT:
        WS: { new: FLOWSEQ_NEXT }
        EOL: { new: FLOWSEQ_NEXT }
      
        FLOW_COMMA:
          match: cb_flow_comma
          return: 1
      
        FLOWSEQ_END:
          match: cb_end_flowseq
          return: 1
      
      FLOWMAP:
        FLOWSEQ_START: { match: cb_start_flowseq, new: NEWFLOWSEQ }
        FLOWMAP_START: { match: cb_start_flowmap, new: NEWFLOWMAP }
      
        ALIAS: { match: cb_send_alias, return: 1 }
      
        PLAIN: { match: cb_flowkey_plain, return: 1 }
        PLAIN_MULTI: { match: cb_send_plain_multi, return: 1 }
      
        QUOTED: { match: cb_flowkey_quoted, return: 1 }
        QUOTED_MULTILINE: { match: cb_quoted_multiline, return: 1 }
      
        COLON:
          WS:
            match: cb_empty_flow_mapkey
            new: RULE_FULLFLOWSCALAR
          EOL:
            match: cb_empty_flow_mapkey
            new: RULE_FULLFLOWSCALAR
      
      
      NEWFLOWSEQ:
        EOL: { new: NEWFLOWSEQ }
        WS: { new: NEWFLOWSEQ }
      
        ANCHOR:
          match: cb_anchor
          WS: { new: NEWFLOWSEQ_ANCHOR }
          EOL: { new: NEWFLOWSEQ_ANCHOR }
        TAG:
          match: cb_tag
          WS: { new: NEWFLOWSEQ_TAG }
          EOL: { new: NEWFLOWSEQ_TAG }
      
        FLOWSEQ_END:
          match: cb_end_flowseq
          return: 1
      
        DEFAULT: { new: FLOWSEQ }
      
      NODETYPE_FLOWSEQ:
        EOL: { new: NODETYPE_FLOWSEQ }
        WS: { new: NODETYPE_FLOWSEQ }
        FLOWSEQ_END:
          match: cb_end_flowseq
          return: 1
        DEFAULT: { new: NEWFLOWSEQ }
      
      NODETYPE_FLOWMAPVALUE:
        WS: { new: NODETYPE_FLOWMAPVALUE }
        EOL: { new: NODETYPE_FLOWMAPVALUE }
        COLON:
          match: cb_flow_colon
          WS: { new: RULE_FULLFLOWSCALAR }
          EOL: { new: RULE_FULLFLOWSCALAR }
          DEFAULT: { new: RULE_FULLFLOWSCALAR }
        FLOW_COMMA:
          match: cb_empty_flowmap_value
          return: 1
        FLOWMAP_END:
          match: cb_end_flowmap_empty
          return: 1
      
      NEWFLOWSEQ_ANCHOR:
        WS: { new: NEWFLOWSEQ_ANCHOR }
        EOL: { new: NEWFLOWSEQ_ANCHOR }
        TAG:
          match: cb_tag
          WS: { new: FLOWSEQ }
          EOL: { new: FLOWSEQ }
        DEFAULT: { new: FLOWSEQ }
      
      NEWFLOWSEQ_TAG:
        WS: { new: NEWFLOWSEQ_TAG }
        EOL: { new: NEWFLOWSEQ_TAG }
        ANCHOR:
          match: cb_anchor
          WS: { new: FLOWSEQ }
          EOL: { new: FLOWSEQ }
        DEFAULT: { new: FLOWSEQ }
      
      
      NEWFLOWMAP_ANCHOR:
        WS: { new: NEWFLOWMAP_ANCHOR }
        EOL: { new: NEWFLOWMAP_ANCHOR }
        TAG:
          match: cb_tag
          WS: { new: FLOWMAP }
          EOL: { new: FLOWMAP }
        DEFAULT: { new: FLOWMAP }
      
      NEWFLOWMAP_TAG:
        WS: { new: NEWFLOWMAP_TAG }
        EOL: { new: NEWFLOWMAP_TAG }
        ANCHOR:
          match: cb_anchor
          WS: { new: FLOWMAP }
          EOL: { new: FLOWMAP }
        DEFAULT: { new: FLOWMAP }
      
      NEWFLOWMAP:
        EOL: { new: NEWFLOWMAP }
        WS: { new: NEWFLOWMAP }
        # TODO
        QUESTION: { match: cb_flow_question, new: NEWFLOWMAP }
      
        ANCHOR:
          match: cb_anchor
          WS: { new: NEWFLOWMAP_ANCHOR }
          EOL: { new: NEWFLOWMAP_ANCHOR }
        TAG:
          match: cb_tag
          WS: { new: NEWFLOWMAP_TAG }
          EOL: { new: NEWFLOWMAP_TAG }
      
        FLOWMAP_END:
          match: cb_end_flowmap
          return: 1
      
        COLON:
          WS:
            match: cb_empty_flow_mapkey
            new: RULE_FULLFLOWSCALAR
          EOL:
            match: cb_empty_flow_mapkey
            new: RULE_FULLFLOWSCALAR
      
        DEFAULT: { new: FLOWMAP }
      
      NODETYPE_FLOWMAP:
        EOL: { new: NODETYPE_FLOWMAP }
        WS: { new: NODETYPE_FLOWMAP }
        FLOWMAP_END:
          match: cb_end_flowmap
          return: 1
        FLOW_COMMA: { match: cb_flow_comma, new: NEWFLOWMAP }
        DEFAULT: { new: NEWFLOWMAP }
      
      
      RULE_MAPKEY:
        QUESTION:
          match: cb_question
          EOL: { new: FULLNODE }
          WS: { new: FULLNODE }
        ALIAS:
          match: cb_send_alias
          WS:
            COLON:
              EOL: { new: FULLNODE }
              WS: { new: FULLMAPVALUE_INLINE }
      
        QUOTED:
          match: cb_take_quoted_key
          WS:
            COLON:
              EOL: { new: FULLNODE }
              WS: { new: FULLMAPVALUE_INLINE }
          COLON:
            EOL: { new: FULLNODE }
            WS: { new: FULLMAPVALUE_INLINE }
      
        PLAIN:
          match: cb_mapkey
          WS:
            COLON:
              match: cb_send_mapkey
              EOL: { new: FULLNODE }
              WS: { new: FULLMAPVALUE_INLINE }
          COLON:
            match: cb_send_mapkey
            EOL: { new: FULLNODE }
            WS: { new: FULLMAPVALUE_INLINE }
      
        COLON:
          match: cb_empty_mapkey
          EOL: { new: FULLNODE }
          WS: { new: FULLMAPVALUE_INLINE }
      
        DOC_END:
          match: cb_end_document
          EOL: { }
      
        DOC_START:
          match: cb_end_doc_start_document
          EOL: { new: FULLNODE }
          WS: { new: FULLNODE }
      
        EOL:
          new: RULE_MAPKEY
      
      
      NODETYPE_SEQ:
        DASH:
          match: cb_seqitem
          EOL: { new: FULLNODE }
          WS: { new: FULLNODE }
        DOC_END:
          match: cb_end_document
          EOL: { }
        DOC_START:
          match: cb_end_doc_start_document
          EOL: { new: FULLNODE }
          WS: { new: FULLNODE }
      
        EOL:
          new: NODETYPE_SEQ
      
      NODETYPE_MAP:
        ANCHOR:
          match: cb_anchor
          WS:
            TAG:
              match: cb_tag
              WS: { new: RULE_MAPKEY  }
            DEFAULT: { new: RULE_MAPKEY }
        TAG:
          match: cb_tag
          WS:
            ANCHOR:
              match: cb_anchor
              WS: { new: RULE_MAPKEY  }
            DEFAULT: { new: RULE_MAPKEY }
        DEFAULT: { new: RULE_MAPKEY }
      
      FULLNODE_ANCHOR:
        TAG:
          match: cb_tag
          EOL: { match: cb_property_eol, new: FULLNODE_TAG_ANCHOR }
          WS:
            ANCHOR:
              match: cb_anchor
              WS: { new: NODETYPE_SCALAR_OR_MAP  }
            DEFAULT: { new: NODETYPE_SCALAR_OR_MAP }
        ANCHOR:
          match: cb_anchor
          WS:
            TAG:
              match: cb_tag
              WS: { new: NODETYPE_SCALAR_OR_MAP  }
            DEFAULT: { new: NODETYPE_SCALAR_OR_MAP }
        EOL: { new: FULLNODE_ANCHOR }
        DEFAULT: { new: NODETYPE_NODE }
      
      FULLNODE_TAG:
        ANCHOR:
          match: cb_anchor
          EOL: { match: cb_property_eol, new: FULLNODE_TAG_ANCHOR }
          WS:
            TAG:
              match: cb_tag
              WS: { new: NODETYPE_SCALAR_OR_MAP  }
            DEFAULT: { new: NODETYPE_SCALAR_OR_MAP, }
        TAG:
          match: cb_tag
          WS:
            ANCHOR:
              match: cb_anchor
              WS: { new: NODETYPE_SCALAR_OR_MAP  }
            DEFAULT: { new: NODETYPE_SCALAR_OR_MAP }
        EOL: { new: FULLNODE_TAG }
        DEFAULT: { new: NODETYPE_NODE }
      
      FULLNODE_TAG_ANCHOR:
        ANCHOR:
          match: cb_anchor
          WS:
            TAG:
              match: cb_tag
              WS: { new: NODETYPE_SCALAR_OR_MAP  }
            DEFAULT: { new: NODETYPE_SCALAR_OR_MAP }
        TAG:
          match: cb_tag
          WS:
            ANCHOR:
              match: cb_anchor
              WS: { new: NODETYPE_SCALAR_OR_MAP  }
            DEFAULT: { new: NODETYPE_SCALAR_OR_MAP }
        EOL: { new: FULLNODE_TAG_ANCHOR }
        DEFAULT: { new: NODETYPE_NODE }
      
      FULLNODE:
        ANCHOR:
          match: cb_anchor
          EOL: { match: cb_property_eol, new: FULLNODE_ANCHOR }
          WS:
            TAG:
              match: cb_tag
              EOL: { match: cb_property_eol, new: FULLNODE_TAG_ANCHOR }
              WS: { new: NODETYPE_SCALAR_OR_MAP  }
            DEFAULT: { new: NODETYPE_SCALAR_OR_MAP }
        TAG:
          match: cb_tag
          EOL: { match: cb_property_eol, new: FULLNODE_TAG }
          WS:
            ANCHOR:
              match: cb_anchor
              EOL: { match: cb_property_eol, new: FULLNODE_TAG_ANCHOR }
              WS: { new: NODETYPE_SCALAR_OR_MAP  }
            DEFAULT: { new: NODETYPE_SCALAR_OR_MAP }
        EOL: { new: FULLNODE }
        DEFAULT: { new: NODETYPE_NODE }
      
      FULLMAPVALUE_INLINE:
        ANCHOR:
          match: cb_anchor
          EOL: { match: cb_property_eol, new: FULLNODE_ANCHOR }
          WS:
            TAG:
              match: cb_tag
              EOL: { match: cb_property_eol, new: FULLNODE_TAG_ANCHOR }
              WS: { new: NODETYPE_MAPVALUE_INLINE  }
            DEFAULT: { new: NODETYPE_MAPVALUE_INLINE }
        TAG:
          match: cb_tag
          EOL: { match: cb_property_eol, new: FULLNODE_TAG }
          WS:
            ANCHOR:
              match: cb_anchor
              EOL: { match: cb_property_eol, new: FULLNODE_TAG_ANCHOR }
              WS: { new: NODETYPE_MAPVALUE_INLINE  }
            DEFAULT: { new: NODETYPE_MAPVALUE_INLINE }
        DEFAULT: { new: NODETYPE_MAPVALUE_INLINE }
      
      
      NODETYPE_MAPVALUE_INLINE:
        ALIAS:
          match: cb_send_alias
          EOL: { }
      
        QUOTED:
          match: cb_take_quoted
          EOL: { match: cb_send_scalar }
      
        QUOTED_MULTILINE:
          match: cb_quoted_multiline
          EOL: { }
      
        PLAIN:
          match: cb_start_plain
          EOL:
            match: cb_send_scalar
      
        PLAIN_MULTI:
          match: cb_send_plain_multi
          EOL: { }
      
        BLOCK_SCALAR:
          match: cb_send_block_scalar
          EOL: { }
      
        FLOWSEQ_START:
          match: cb_start_flowseq
          new: NEWFLOWSEQ
      
        FLOWMAP_START:
          match: cb_start_flowmap
          new: NEWFLOWMAP
      
        DOC_END:
          match: cb_end_document
          EOL: { }
      
      
      DOCUMENT_END:
        DOC_END:
          match: cb_end_document
          EOL: { }
        DOC_START:
          match: cb_end_doc_start_document
          EOL: { new: FULLNODE }
          WS: { new: FULLNODE }
      
        EOL:
          new: DOCUMENT_END
      
      
      STREAM:
      
        DOC_END:
          match: cb_end_document_empty
          EOL: {  }
        DOC_START:
          match: cb_doc_start_explicit
          EOL: { new: FULLNODE }
          WS: { new: FULLNODE }
        YAML_DIRECTIVE:
          match: cb_set_yaml_version_directive
          EOL: { new: DIRECTIVE }
          WS: { new: DIRECTIVE }
        RESERVED_DIRECTIVE:
          match: cb_reserved_directive
          EOL: { new: DIRECTIVE }
          WS: { new: DIRECTIVE }
        TAG_DIRECTIVE:
          match: cb_tag_directive
          EOL: { new: DIRECTIVE }
          WS: { new: DIRECTIVE }
      
        EOL:
          new: STREAM
      
        DEFAULT:
          match: cb_doc_start_implicit
          new: FULLNODE
      
      DIRECTIVE:
        DOC_START:
          match: cb_doc_start_explicit
          EOL: { new: FULLNODE }
          WS: { new: FULLNODE }
      
        YAML_DIRECTIVE:
          match: cb_set_yaml_version_directive
          EOL: { new: DIRECTIVE }
          WS: { new: DIRECTIVE }
        RESERVED_DIRECTIVE:
          match: cb_reserved_directive
          EOL: { new: DIRECTIVE }
          WS: { new: DIRECTIVE }
        TAG_DIRECTIVE:
          match: cb_tag_directive
          EOL: { new: DIRECTIVE }
          WS: { new: DIRECTIVE }
      
        EOL:
          new: DIRECTIVE
  
  
      # END OF YAML INLINE
  
  =cut
YAML_PP_GRAMMAR

$fatpacked{"YAML/PP/Highlight.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'YAML_PP_HIGHLIGHT';
  use strict;
  use warnings;
  package YAML::PP::Highlight;
  
  our $VERSION = '0.027'; # VERSION
  
  our @EXPORT_OK = qw/ Dump /;
  
  use base 'Exporter';
  use YAML::PP;
  use YAML::PP::Parser;
  use Encode;
  
  sub Dump {
      my (@docs) = @_;
      # Dumping objects is safe, so we enable the Perl schema here
      require YAML::PP::Schema::Perl;
      my $yp = YAML::PP->new( schema => [qw/ + Perl /] );
      my $yaml = $yp->dump_string(@docs);
  
      my ($error, $tokens) = YAML::PP::Parser->yaml_to_tokens(string => $yaml);
      my $highlighted = YAML::PP::Highlight->ansicolored($tokens);
      encode_utf8 $highlighted;
  }
  
  
  my %ansicolors = (
      ANCHOR => [qw/ green /],
      ALIAS => [qw/ bold green /],
      TAG => [qw/ bold blue /],
      INDENT => [qw/ white on_grey3 /],
      COMMENT => [qw/ grey12 /],
      COLON => [qw/ bold magenta /],
      DASH => [qw/ bold magenta /],
      QUESTION => [qw/ bold magenta /],
      YAML_DIRECTIVE => [qw/ cyan /],
      TAG_DIRECTIVE => [qw/ bold cyan /],
      SINGLEQUOTE => [qw/ bold green /],
      SINGLEQUOTED => [qw/ green /],
      SINGLEQUOTED_LINE => [qw/ green /],
      DOUBLEQUOTE => [qw/ bold green /],
      DOUBLEQUOTED => [qw/ green /],
      DOUBLEQUOTED_LINE => [qw/ green /],
      LITERAL => [qw/ bold yellow /],
      FOLDED => [qw/ bold yellow /],
      DOC_START => [qw/ bold /],
      DOC_END => [qw/ bold /],
      BLOCK_SCALAR_CONTENT => [qw/ yellow /],
      TAB => [qw/ on_blue /],
      ERROR => [qw/ bold red /],
      EOL => [qw/ grey12 /],
      TRAILING_SPACE => [qw/ on_grey6 /],
      FLOWSEQ_START => [qw/ bold magenta /],
      FLOWSEQ_END => [qw/ bold magenta /],
      FLOWMAP_START => [qw/ bold magenta /],
      FLOWMAP_END => [qw/ bold magenta /],
      FLOW_COMMA => [qw/ bold magenta /],
      PLAINKEY => [qw/ bright_blue /],
  );
  
  sub ansicolored {
      my ($class, $tokens, %args) = @_;
      my $expand_tabs = $args{expand_tabs};
      $expand_tabs = 1 unless defined $expand_tabs;
      require Term::ANSIColor;
  
      local $Term::ANSIColor::EACHLINE = "\n";
      my $ansi = '';
      my $highlighted = '';
  
      my @list = $class->transform($tokens);
  
  
      for my $token (@list) {
          my $name = $token->{name};
          my $str = $token->{value};
  
          my $color = $ansicolors{ $name };
          if ($color) {
              $str = Term::ANSIColor::colored($color, $str);
          }
          $highlighted .= $str;
      }
  
      if ($expand_tabs) {
          # Tabs can't be displayed with ansicolors
          $highlighted =~ s/\t/' ' x 8/eg;
      }
      $ansi .= $highlighted;
      return $ansi;
  }
  
  my %htmlcolors = (
      ANCHOR => 'anchor',
      ALIAS => 'alias',
      SINGLEQUOTE => 'singlequote',
      DOUBLEQUOTE => 'doublequote',
      SINGLEQUOTED => 'singlequoted',
      DOUBLEQUOTED => 'doublequoted',
      SINGLEQUOTED_LINE => 'singlequoted',
      DOUBLEQUOTED_LINE => 'doublequoted',
      INDENT => 'indent',
      DASH => 'dash',
      COLON => 'colon',
      QUESTION => 'question',
      YAML_DIRECTIVE => 'yaml_directive',
      TAG_DIRECTIVE => 'tag_directive',
      TAG => 'tag',
      COMMENT => 'comment',
      LITERAL => 'literal',
      FOLDED => 'folded',
      DOC_START => 'doc_start',
      DOC_END => 'doc_end',
      BLOCK_SCALAR_CONTENT => 'block_scalar_content',
      TAB => 'tab',
      ERROR => 'error',
      EOL => 'eol',
      TRAILING_SPACE => 'trailing_space',
      FLOWSEQ_START => 'flowseq_start',
      FLOWSEQ_END => 'flowseq_end',
      FLOWMAP_START => 'flowmap_start',
      FLOWMAP_END => 'flowmap_end',
      FLOW_COMMA => 'flow_comma',
      PLAINKEY => 'plainkey',
  );
  sub htmlcolored {
      require HTML::Entities;
      my ($class, $tokens) = @_;
      my $html = '';
      my @list = $class->transform($tokens);
      for my $token (@list) {
          my $name = $token->{name};
          my $str = $token->{value};
          my $colorclass = $htmlcolors{ $name } || 'default';
          $str = HTML::Entities::encode_entities($str);
          $html .= qq{<span class="$colorclass">$str</span>};
      }
      return $html;
  }
  
  sub transform {
      my ($class, $tokens) = @_;
      my @list;
      for my $token (@$tokens) {
          my @values;
          my $value = $token->{value};
          my $subtokens = $token->{subtokens};
          if ($subtokens) {
              @values = @$subtokens;
          }
          else {
              @values = $token;
          }
          for my $token (@values) {
              my $value = defined $token->{orig} ? $token->{orig} : $token->{value};
              push @list, map {
                      $_ =~ tr/\t/\t/
                      ? { name => 'TAB', value => $_ }
                      : { name => $token->{name}, value => $_ }
                  } split m/(\t+)/, $value;
          }
      }
      for my $i (0 .. $#list) {
          my $token = $list[ $i ];
          my $name = $token->{name};
          my $str = $token->{value};
          my $trailing_space = 0;
          if ($token->{name} eq 'EOL') {
              if ($str =~ m/ +([\r\n]|\z)/) {
                  $token->{name} = "TRAILING_SPACE";
              }
          }
          elsif ($i < $#list) {
              if ($name eq 'PLAIN') {
                  for my $n ($i+1 .. $#list) {
                      my $next = $list[ $n ];
                      last if $next->{name} eq 'EOL';
                      next if $next->{name} =~ m/^(WS|SPACE)$/;
                      if ($next->{name} eq 'COLON') {
                          $token->{name} = 'PLAINKEY';
                      }
                  }
              }
              my $next = $list[ $i + 1];
              if ($next->{name} eq 'EOL') {
                  if ($str =~ m/ \z/ and $name =~ m/^(BLOCK_SCALAR_CONTENT|WS)$/) {
                      $token->{name} = "TRAILING_SPACE";
                  }
              }
          }
      }
      return @list;
  }
  
  1;
  
  __END__
  
  =pod
  
  =encoding utf-8
  
  =head1 NAME
  
  YAML::PP::Highlight - Syntax highlighting utilities
  
  =head1 SYNOPSIS
  
  
      use YAML::PP::Highlight qw/ Dump /;
  
      my $highlighted = Dump $data;
  
  =head1 FUNCTIONS
  
  =over
  
  =item Dump
  
  =back
  
      use YAML::PP::Highlight qw/ Dump /;
  
      my $highlighted = Dump $data;
      my $highlighted = Dump @docs;
  
  It will dump the given data, and then parse it again to create tokens, which
  are then highlighted with ansi colors.
  
  The return value is ansi colored YAML.
YAML_PP_HIGHLIGHT

$fatpacked{"YAML/PP/Lexer.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'YAML_PP_LEXER';
  use strict;
  use warnings;
  package YAML::PP::Lexer;
  
  our $VERSION = '0.027'; # VERSION
  
  use constant TRACE => $ENV{YAML_PP_TRACE} ? 1 : 0;
  use constant DEBUG => ($ENV{YAML_PP_DEBUG} || $ENV{YAML_PP_TRACE}) ? 1 : 0;
  
  use YAML::PP::Grammar qw/ $GRAMMAR /;
  use Carp qw/ croak /;
  
  sub new {
      my ($class, %args) = @_;
      my $self = bless {
          reader => $args{reader},
      }, $class;
      $self->init;
      return $self;
  }
  
  sub init {
      my ($self) = @_;
      $self->{next_tokens} = [];
      $self->{next_line} = undef;
      $self->{line} = 0;
      $self->{offset} = 0;
      $self->{flowcontext} = 0;
  }
  
  sub next_line { return $_[0]->{next_line} }
  sub set_next_line { $_[0]->{next_line} = $_[1] }
  sub reader { return $_[0]->{reader} }
  sub set_reader { $_[0]->{reader} = $_[1] }
  sub next_tokens { return $_[0]->{next_tokens} }
  sub line { return $_[0]->{line} }
  sub set_line { $_[0]->{line} = $_[1] }
  sub offset { return $_[0]->{offset} }
  sub set_offset { $_[0]->{offset} = $_[1] }
  sub inc_line { return $_[0]->{line}++ }
  sub context { return $_[0]->{context} }
  sub set_context { $_[0]->{context} = $_[1] }
  sub flowcontext { return $_[0]->{flowcontext} }
  sub set_flowcontext { $_[0]->{flowcontext} = $_[1] }
  
  my $RE_WS = '[\t ]';
  my $RE_LB = '[\r\n]';
  my $RE_DOC_END = qr/\A(\.\.\.)(?=$RE_WS|$)/m;
  my $RE_DOC_START = qr/\A(---)(?=$RE_WS|$)/m;
  my $RE_EOL = qr/\A($RE_WS+#.*|$RE_WS+)\z/;
  #my $RE_COMMENT_EOL = qr/\A(#.*)?(?:$RE_LB|\z)/;
  
  #ns-word-char    ::= ns-dec-digit | ns-ascii-letter | “-”
  my $RE_NS_WORD_CHAR = '[0-9A-Za-z-]';
  my $RE_URI_CHAR = '(?:' . '%[0-9a-fA-F]{2}' .'|'.  q{[0-9A-Za-z#;/?:@&=+$,_.!*'\(\)\[\]-]} . ')';
  my $RE_NS_TAG_CHAR = '(?:' . '%[0-9a-fA-F]{2}' .'|'.  q{[0-9A-Za-z#;/?:@&=+$_.*'\(\)-]} . ')';
  
  #  [#x21-#x7E]          /* 8 bit */
  # | #x85 | [#xA0-#xD7FF] | [#xE000-#xFFFD] /* 16 bit */
  # | [#x10000-#x10FFFF]                     /* 32 bit */
  
  #nb-char ::= c-printable - b-char - c-byte-order-mark
  #my $RE_NB_CHAR = '[\x21-\x7E]';
  my $RE_ANCHOR_CAR = '[\x21-\x2B\x2D-\x5A\x5C\x5E-\x7A\x7C\x7E\xA0-\xFF\x{100}-\x{10FFFF}]';
  
  my $RE_PLAIN_START = '[\x21\x22\x24-\x39\x3B-\x7E\xA0-\xFF\x{100}-\x{10FFFF}]';
  my $RE_PLAIN_END = '[\x21-\x39\x3B-\x7E\x85\xA0-\x{D7FF}\x{E000}-\x{FEFE}\x{FF00}-\x{FFFD}\x{10000}-\x{10FFFF}]';
  my $RE_PLAIN_FIRST = '[\x24\x28-\x29\x2B\x2E-\x39\x3B-\x3D\x41-\x5A\x5C\x5E-\x5F\x61-\x7A\x7E\xA0-\xFF\x{100}-\x{10FFFF}]';
  
  my $RE_PLAIN_START_FLOW = '[\x21\x22\x24-\x2B\x2D-\x39\x3B-\x5A\x5C\x5E-\x7A\x7C\x7E\xA0-\xFF\x{100}-\x{10FFFF}]';
  my $RE_PLAIN_END_FLOW = '[\x21-\x2B\x2D-\x39\x3B-\x5A\x5C\x5E-\x7A\x7C\x7E\x85\xA0-\x{D7FF}\x{E000}-\x{FEFE}\x{FF00}-\x{FFFD}\x{10000}-\x{10FFFF}]';
  my $RE_PLAIN_FIRST_FLOW = '[\x24\x28-\x29\x2B\x2E-\x39\x3B-\x3D\x41-\x5A\x5C\x5E-\x5F\x61-\x7A\x7C\x7E\xA0-\xFF\x{100}-\x{10FFFF}]';
  # c-indicators
  #! 21
  #" 22
  ## 23
  #% 25
  #& 26
  #' 27
  #* 2A
  #, 2C FLOW
  #- 2D XX
  #: 3A XX
  #> 3E
  #? 3F XX
  #@ 40
  #[ 5B FLOW
  #] 5D FLOW
  #` 60
  #{ 7B FLOW
  #| 7C
  #} 7D FLOW
  
  
  my $RE_PLAIN_WORD = "(?::+$RE_PLAIN_END|$RE_PLAIN_START)(?::+$RE_PLAIN_END|$RE_PLAIN_END)*";
  my $RE_PLAIN_FIRST_WORD = "(?:[:?-]+$RE_PLAIN_END|$RE_PLAIN_FIRST)(?::+$RE_PLAIN_END|$RE_PLAIN_END)*";
  my $RE_PLAIN_WORDS = "(?:$RE_PLAIN_FIRST_WORD(?:$RE_WS+$RE_PLAIN_WORD)*)";
  my $RE_PLAIN_WORDS2 = "(?:$RE_PLAIN_WORD(?:$RE_WS+$RE_PLAIN_WORD)*)";
  
  my $RE_PLAIN_WORD_FLOW = "(?::+$RE_PLAIN_END_FLOW|$RE_PLAIN_START_FLOW)(?::+$RE_PLAIN_END_FLOW|$RE_PLAIN_END_FLOW)*";
  my $RE_PLAIN_FIRST_WORD_FLOW = "(?:[:?-]+$RE_PLAIN_END_FLOW|$RE_PLAIN_FIRST_FLOW)(?::+$RE_PLAIN_END_FLOW|$RE_PLAIN_END_FLOW)*";
  my $RE_PLAIN_WORDS_FLOW = "(?:$RE_PLAIN_FIRST_WORD_FLOW(?:$RE_WS+$RE_PLAIN_WORD_FLOW)*)";
  my $RE_PLAIN_WORDS_FLOW2 = "(?:$RE_PLAIN_WORD_FLOW(?:$RE_WS+$RE_PLAIN_WORD_FLOW)*)";
  
  
  #c-secondary-tag-handle  ::= “!” “!”
  #c-named-tag-handle  ::= “!” ns-word-char+ “!”
  #ns-tag-char ::= ns-uri-char - “!” - c-flow-indicator
  #ns-global-tag-prefix    ::= ns-tag-char ns-uri-char*
  #c-ns-local-tag-prefix   ::= “!” ns-uri-char*
  my $RE_TAG = "!(?:$RE_NS_WORD_CHAR*!$RE_NS_TAG_CHAR+|$RE_NS_TAG_CHAR+|<$RE_URI_CHAR+>|)";
  
  #c-ns-anchor-property    ::= “&” ns-anchor-name
  #ns-char ::= nb-char - s-white
  #ns-anchor-char  ::= ns-char - c-flow-indicator
  #ns-anchor-name  ::= ns-anchor-char+
  
  my $RE_SEQSTART = qr/\A(-)(?=$RE_WS|$)/m;
  my $RE_COMPLEX = qr/(\?)(?=$RE_WS|$)/m;
  my $RE_COMPLEXCOLON = qr/\A(:)(?=$RE_WS|$)/m;
  my $RE_ANCHOR = "&$RE_ANCHOR_CAR+";
  my $RE_ALIAS = "\\*$RE_ANCHOR_CAR+";
  
  
  my %REGEXES = (
      ANCHOR => qr{($RE_ANCHOR)},
      TAG => qr{($RE_TAG)},
      ALIAS => qr{($RE_ALIAS)},
      SINGLEQUOTED => qr{(?:''|[^'\r\n]+)*},
  );
  
  sub fetch_next_line {
      my ($self) = @_;
      my $next_line = $self->next_line;
      if (defined $next_line ) {
          return $next_line;
      }
  
      my $line = $self->reader->readline;
      unless (defined $line) {
          $self->set_next_line(undef);
          return;
      }
      $self->inc_line;
      $line =~ m/\A( *)([^\r\n]*)([\r\n]|\z)/ or die "Unexpected";
      $next_line = [ $1,  $2, $3 ];
      $self->set_next_line($next_line);
      # $ESCAPE_CHAR from YAML.pm
      if ($line =~ tr/\x00-\x08\x0b-\x0c\x0e-\x1f//) {
          $self->exception("Control characters are not allowed");
      }
  
      return $next_line;
  }
  
  my %TOKEN_NAMES = (
      '"' => 'DOUBLEQUOTE',
      "'" => 'SINGLEQUOTE',
      '|' => 'LITERAL',
      '>' => 'FOLDED',
      '!' => 'TAG',
      '*' => 'ALIAS',
      '&' => 'ANCHOR',
      ':' => 'COLON',
      '-' => 'DASH',
      '?' => 'QUESTION',
      '[' => 'FLOWSEQ_START',
      ']' => 'FLOWSEQ_END',
      '{' => 'FLOWMAP_START',
      '}' => 'FLOWMAP_END',
      ',' => 'FLOW_COMMA',
      '---' => 'DOC_START',
      '...' => 'DOC_END',
  );
  
  
  sub fetch_next_tokens {
      my ($self) = @_;
      my $next = $self->next_tokens;
      return $next if @$next;
  
      my $next_line = $self->fetch_next_line;
      if (not $next_line) {
          return [];
      }
  
      my $spaces = $next_line->[0];
      my $yaml = \$next_line->[1];
      if (not length $$yaml) {
          $self->push_tokens([ EOL => join('', @$next_line), $self->line ]);
          $self->set_next_line(undef);
          return $next;
      }
      if (substr($$yaml, 0, 1) eq '#') {
          $self->push_tokens([ EOL => join('', @$next_line), $self->line ]);
          $self->set_next_line(undef);
          return $next;
      }
      if (not $spaces and substr($$yaml, 0, 1) eq "%") {
          $self->_fetch_next_tokens_directive($yaml, $next_line->[2]);
          $self->set_context(0);
          $self->set_next_line(undef);
          return $next;
      }
      if (not $spaces and $$yaml =~ s/\A(---|\.\.\.)(?=$RE_WS|\z)//) {
          $self->push_tokens([ $TOKEN_NAMES{ $1 } => $1, $self->line ]);
      }
      else {
          $self->push_tokens([ SPACE => $spaces, $self->line ]);
      }
  
      my $partial = $self->_fetch_next_tokens($next_line);
      unless ($partial) {
          $self->set_next_line(undef);
      }
      return $next;
  }
  
  my %ANCHOR_ALIAS_TAG =    ( '&' => 1, '*' => 1, '!' => 1 );
  my %BLOCK_SCALAR =        ( '|' => 1, '>' => 1 );
  my %COLON_DASH_QUESTION = ( ':' => 1, '-' => 1, '?' => 1 );
  my %QUOTED =              ( '"' => 1, "'" => 1 );
  my %FLOW =                ( '{' => 1, '[' => 1, '}' => 1, ']' => 1, ',' => 1 );
  my %CONTEXT =             ( '"' => 1, "'" => 1, '>' => 1, '|' => 1 );
  
  my $RE_ESCAPES = qr{(?:
      \\([ \\\/_0abefnrtvLNP"]) | \\x([0-9a-fA-F]{2})
      | \\u([A-Fa-f0-9]{4}) | \\U([A-Fa-f0-9]{4,8})
  )}x;
  my %CONTROL = (
      '\\' => '\\', '/' => '/', n => "\n", t => "\t", r => "\r", b => "\b",
      'a' => "\a", 'b' => "\b", 'e' => "\e", 'f' => "\f", 'v' => "\x0b",
      'P' => "\x{2029}", L => "\x{2028}", 'N' => "\x85",
      '0' => "\0", '_' => "\xa0", ' ' => ' ', q/"/ => q/"/,
  );
  
  sub _fetch_next_tokens {
      TRACE and warn __PACKAGE__.':'.__LINE__.": _fetch_next_tokens\n";
      my ($self, $next_line) = @_;
  
      my $yaml = \$next_line->[1];
      my $eol = $next_line->[2];
  
      my @tokens;
  
      while (1) {
          unless (length $$yaml) {
              push @tokens, ( EOL => $eol, $self->line );
              $self->push_tokens(\@tokens);
              return;
          }
          my $first = substr($$yaml, 0, 1);
          my $plain = 0;
  
          if ($self->context) {
              if ($$yaml =~ s/\A($RE_WS*)://) {
                  push @tokens, ( WS => $1, $self->line ) if $1;
                  push @tokens, ( COLON => ':', $self->line );
                  $self->set_context(0);
                  next;
              }
              if ($$yaml =~ s/\A($RE_WS*(?: #.*))\z//) {
                  push @tokens, ( EOL => $1 . $eol, $self->line );
                  $self->push_tokens(\@tokens);
                  return;
              }
              $self->set_context(0);
          }
          if ($CONTEXT{ $first }) {
              push @tokens, ( CONTEXT => $first, $self->line );
              $self->push_tokens(\@tokens);
              return 1;
          }
          elsif ($COLON_DASH_QUESTION{ $first }) {
              my $token_name = $TOKEN_NAMES{ $first };
              if ($$yaml =~ s/\A\Q$first\E(?:($RE_WS+)|\z)//) {
                  my $token_name = $TOKEN_NAMES{ $first };
                  push @tokens, ( $token_name => $first, $self->line );
                  if (not defined $1) {
                      push @tokens, ( EOL => $eol, $self->line );
                      $self->push_tokens(\@tokens);
                      return;
                  }
                  my $ws = $1;
                  if ($$yaml =~ s/\A(#.*|)\z//) {
                      push @tokens, ( EOL => $ws . $1 . $eol, $self->line );
                      $self->push_tokens(\@tokens);
                      return;
                  }
                  push @tokens, ( WS => $ws, $self->line );
                  next;
              }
              elsif ($self->flowcontext and $$yaml =~ s/\A:(?=[,\{\}\[\]])//) {
                  push @tokens, ( $token_name => $first, $self->line );
                  next;
              }
              $plain = 1;
          }
          elsif ($ANCHOR_ALIAS_TAG{ $first }) {
              my $token_name = $TOKEN_NAMES{ $first };
              my $REGEX = $REGEXES{ $token_name };
              if ($$yaml =~ s/\A$REGEX//) {
                  push @tokens, ( $token_name => $1, $self->line );
              }
              else {
                  push @tokens, ( "Invalid $token_name" => $$yaml, $self->line );
                  $self->push_tokens(\@tokens);
                  return;
              }
          }
          elsif ($first eq ' ' or $first eq "\t") {
              if ($$yaml =~ s/\A($RE_WS+)//) {
                  my $ws = $1;
                  if ($$yaml =~ s/\A((?:#.*)?\z)//) {
                      push @tokens, ( EOL => $ws . $1 . $eol, $self->line );
                      $self->push_tokens(\@tokens);
                      return;
                  }
                  push @tokens, ( WS => $ws, $self->line );
              }
          }
          elsif ($FLOW{ $first }) {
              push @tokens, ( $TOKEN_NAMES{ $first } => $first, $self->line );
              substr($$yaml, 0, 1, '');
              my $flowcontext = $self->flowcontext;
              if ($first eq '{' or $first eq '[') {
                  $self->set_flowcontext(++$flowcontext);
              }
              elsif ($first eq '}' or $first eq ']') {
                  $self->set_flowcontext(--$flowcontext);
              }
          }
          else {
              $plain = 1;
          }
  
          if ($plain) {
              push @tokens, ( CONTEXT => '', $self->line );
              $self->push_tokens(\@tokens);
              return 1;
          }
  
      }
  
      return;
  }
  
  sub fetch_plain {
      my ($self, $indent, $context) = @_;
      my $next_line = $self->next_line;
      my $yaml = \$next_line->[1];
      my $eol = $next_line->[2];
      my $REGEX = $RE_PLAIN_WORDS;
      if ($self->flowcontext) {
          $REGEX = $RE_PLAIN_WORDS_FLOW;
      }
  
      my @tokens;
      unless ($$yaml =~ s/\A($REGEX)//) {
          $self->push_tokens(\@tokens);
          $self->exception("Invalid plain scalar");
      }
      my $plain = $1;
      push @tokens, ( PLAIN => $plain, $self->line );
  
      if ($$yaml =~ s/\A(?:($RE_WS+#.*)|($RE_WS*))\z//) {
          if (defined $1) {
              push @tokens, ( EOL => $1 . $eol, $self->line );
              $self->push_tokens(\@tokens);
              $self->set_next_line(undef);
              return;
          }
          else {
              push @tokens, ( EOL => $2. $eol, $self->line );
              $self->set_next_line(undef);
          }
      }
      else {
          $self->push_tokens(\@tokens);
          my $partial = $self->_fetch_next_tokens($next_line);
          if (not $partial) {
              $self->set_next_line(undef);
          }
          return;
      }
  
      my $RE2 = $RE_PLAIN_WORDS2;
      if ($self->flowcontext) {
          $RE2 = $RE_PLAIN_WORDS_FLOW2;
      }
      my $fetch_next = 0;
      my @lines = ($plain);
      my @next;
      LOOP: while (1) {
          $next_line = $self->fetch_next_line;
          if (not $next_line) {
              last LOOP;
          }
          my $spaces = $next_line->[0];
          my $yaml = \$next_line->[1];
          my $eol = $next_line->[2];
  
          if (not length $$yaml) {
              push @tokens, ( EOL => $spaces . $eol, $self->line );
              $self->set_next_line(undef);
              push @lines, '';
              next LOOP;
          }
  
          if (not $spaces and $$yaml =~ s/\A(---|\.\.\.)(?=$RE_WS|\z)//) {
              push @next, $TOKEN_NAMES{ $1 } => $1, $self->line;
              $fetch_next = 1;
              last LOOP;
          }
          if ((length $spaces) < $indent) {
              last LOOP;
          }
  
          my $ws = '';
          if ($$yaml =~ s/\A($RE_WS+)//) {
              $ws = $1;
          }
          if (not length $$yaml) {
              push @tokens, ( EOL => $spaces . $ws . $eol, $self->line );
              $self->set_next_line(undef);
              push @lines, '';
              next LOOP;
          }
          if ($$yaml =~ s/\A(#.*)\z//) {
              push @tokens, ( EOL => $spaces . $ws . $1 . $eol, $self->line );
              $self->set_next_line(undef);
              last LOOP;
          }
  
          if ($$yaml =~ s/\A($RE2)//) {
              push @tokens, INDENT => $spaces, $self->line;
              push @tokens, WS => $ws, $self->line;
              push @tokens, PLAIN => $1, $self->line;
              push @lines, $1;
              my $ws = '';
              if ($$yaml =~ s/\A($RE_WS+)//) {
                  $ws = $1;
              }
              if (not length $$yaml) {
                  push @tokens, EOL => $ws . $eol, $self->line;
                  $self->set_next_line(undef);
                  next LOOP;
              }
  
              if ($$yaml =~ s/\A(#.*)\z//) {
                  push @tokens, EOL => $ws . $1 . $eol, $self->line;
                  $self->set_next_line(undef);
                  last LOOP;
              }
              else {
                  push @tokens, WS => $ws, $self->line if $ws;
                  $fetch_next = 1;
              }
          }
          else {
              push @tokens, SPACE => $spaces, $self->line;
              push @tokens, WS => $ws, $self->line;
              if ($self->flowcontext) {
                  $fetch_next = 1;
              }
              else {
                  push @tokens, ERROR => $$yaml, $self->line;
              }
          }
  
          last LOOP;
  
      }
      # remove empty lines at the end
      while (@lines > 1 and $lines[-1] eq '') {
          pop @lines;
      }
      if (@lines > 1) {
          my $value = YAML::PP::Render->render_multi_val(\@lines);
          my @eol;
          if ($tokens[-3] eq 'EOL') {
              @eol = splice @tokens, -3;
          }
          $self->push_subtokens( { name => 'PLAIN_MULTI', value => $value }, \@tokens);
          $self->push_tokens([ @eol, @next ]);
      }
      else {
          $self->push_tokens([ @tokens, @next ]);
      }
      @tokens = ();
      if ($fetch_next) {
          my $partial = $self->_fetch_next_tokens($next_line);
          if (not $partial) {
              $self->set_next_line(undef);
          }
      }
      return;
  }
  
  sub fetch_block {
      my ($self, $indent, $context) = @_;
      my $next_line = $self->next_line;
      my $yaml = \$next_line->[1];
      my $eol = $next_line->[2];
  
      my @tokens;
      my $token_name = $TOKEN_NAMES{ $context };
      $$yaml =~ s/\A\Q$context\E// or die "Unexpected";
      push @tokens, ( $token_name => $context, $self->line );
      my $current_indent = $indent;
      my $started = 0;
      my $set_indent = 0;
      my $chomp = '';
      if ($$yaml =~ s/\A([1-9]\d*)([+-]?)//) {
          push @tokens, ( BLOCK_SCALAR_INDENT => $1, $self->line );
          $set_indent = $1;
          $chomp = $2 if $2;
          push @tokens, ( BLOCK_SCALAR_CHOMP => $2, $self->line ) if $2;
      }
      elsif ($$yaml =~ s/\A([+-])([1-9]\d*)?//) {
          push @tokens, ( BLOCK_SCALAR_CHOMP => $1, $self->line );
          $chomp = $1;
          push @tokens, ( BLOCK_SCALAR_INDENT => $2, $self->line ) if $2;
          $set_indent = $2 if $2;
      }
      if ($set_indent) {
          $started = 1;
          $current_indent = $set_indent;
      }
      if (not length $$yaml) {
          push @tokens, ( EOL => $eol, $self->line );
      }
      elsif ($$yaml =~ s/\A($RE_WS*(?:$RE_WS#.*|))\z//) {
          push @tokens, ( EOL => $1 . $eol, $self->line );
      }
      else {
          $self->push_tokens(\@tokens);
          $self->exception("Invalid block scalar");
      }
  
      my @lines;
      while (1) {
          $self->set_next_line(undef);
          $next_line = $self->fetch_next_line;
          if (not $next_line) {
              last;
          }
          my $spaces = $next_line->[0];
          my $content = $next_line->[1];
          my $eol = $next_line->[2];
          if (not $spaces and $content =~ m/\A(---|\.\.\.)(?=$RE_WS|\z)/) {
              last;
          }
          if ((length $spaces) < $current_indent) {
              if (length $content) {
                  last;
              }
              else {
                  push @lines, '';
                  push @tokens, ( EOL => $spaces . $eol, $self->line );
                  next;
              }
          }
          if ((length $spaces) > $current_indent) {
              if ($started) {
                  ($spaces, my $more_spaces) = unpack "a${current_indent}a*", $spaces;
                  $content = $more_spaces . $content;
              }
          }
          unless (length $content) {
              push @lines, '';
              push @tokens, ( INDENT => $spaces, $self->line, EOL => $eol, $self->line );
              unless ($started) {
                  $current_indent = length $spaces;
              }
              next;
          }
          unless ($started) {
              $started = 1;
              $current_indent = length $spaces;
          }
          push @lines, $content;
          push @tokens, (
              INDENT => $spaces, $self->line,
              BLOCK_SCALAR_CONTENT => $content, $self->line,
              EOL => $eol, $self->line,
          );
      }
      my $value = YAML::PP::Render->render_block_scalar($context, $chomp, \@lines);
      my @eol = splice @tokens, -3;
      $self->push_subtokens( { name => 'BLOCK_SCALAR', value => $value }, \@tokens );
      $self->push_tokens([ @eol ]);
      return 0;
  }
  
  sub fetch_quoted {
      my ($self, $indent, $context) = @_;
      my $next_line = $self->next_line;
      my $yaml = \$next_line->[1];
      my $spaces = $next_line->[0];
  
      my $token_name = $TOKEN_NAMES{ $context };
      $$yaml =~ s/\A\Q$context// or die "Unexpected";;
      my @tokens = ( $token_name => $context, $self->line );
  
      my $start = 1;
      my @values;
      while (1) {
  
          unless ($start) {
              $next_line = $self->fetch_next_line or do {
                      for (my $i = 0; $i < @tokens; $i+= 3) {
                          my $token = $tokens[ $i + 1 ];
                          if (ref $token) {
                              $tokens[ $i + 1 ] = $token->{orig};
                          }
                      }
                      $self->push_tokens(\@tokens);
                      $self->exception("Missing closing quote <$context> at EOF");
                  };
              $start = 0;
              $spaces = $next_line->[0];
              $yaml = \$next_line->[1];
  
              if (not length $$yaml) {
                  push @tokens, ( EOL => $spaces . $next_line->[2], $self->line );
                  $self->set_next_line(undef);
                  push @values, { value => '', orig => '' };
                  next;
              }
              elsif (not $spaces and $$yaml =~ m/\A(---|\.\.\.)(?=$RE_WS|\z)/) {
                      for (my $i = 0; $i < @tokens; $i+= 3) {
                          my $token = $tokens[ $i + 1 ];
                          if (ref $token) {
                              $tokens[ $i + 1 ] = $token->{orig};
                          }
                      }
                  $self->push_tokens(\@tokens);
                  $self->exception("Missing closing quote <$context> or invalid document marker");
              }
              elsif ((length $spaces) < $indent) {
                  for (my $i = 0; $i < @tokens; $i+= 3) {
                      my $token = $tokens[ $i + 1 ];
                      if (ref $token) {
                          $tokens[ $i + 1 ] = $token->{orig};
                      }
                  }
                  $self->push_tokens(\@tokens);
                  $self->exception("Wrong indendation or missing closing quote <$context>");
              }
  
              if ($$yaml =~ s/\A($RE_WS+)//) {
                  $spaces .= $1;
              }
              push @tokens, ( WS => $spaces, $self->line );
          }
  
          my $v = $self->_read_quoted_tokens($start, $context, $yaml, \@tokens);
          push @values, $v;
          if ($tokens[-3] eq $token_name) {
              if ($start) {
                  $self->push_subtokens(
                      { name => 'QUOTED', value => $v->{value} }, \@tokens
                  );
              }
              else {
                  my $value = YAML::PP::Render->render_quoted($context, \@values);
                  $self->push_subtokens(
                      { name => 'QUOTED_MULTILINE', value => $value }, \@tokens
                  );
              }
              $self->set_context(1) if $self->flowcontext;
              if (length $$yaml) {
                  my $partial = $self->_fetch_next_tokens($next_line);
                  if (not $partial) {
                      $self->set_next_line(undef);
                  }
                  return 0;
              }
              else {
                  @tokens = ();
                  push @tokens, ( EOL => $next_line->[2], $self->line );
                  $self->push_tokens(\@tokens);
                  $self->set_next_line(undef);
                  return;
              }
          }
          $tokens[-2] .= $next_line->[2];
          $self->set_next_line(undef);
          $start = 0;
      }
  }
  
  sub _read_quoted_tokens {
      my ($self, $start, $first, $yaml, $tokens) = @_;
      my $quoted = '';
      my $decoded = '';
      my $token_name = $TOKEN_NAMES{ $first };
      if ($first eq "'") {
          my $regex = $REGEXES{SINGLEQUOTED};
          if ($$yaml =~ s/\A($regex)//) {
              $quoted .= $1;
              $decoded .= $1;
              $decoded =~ s/''/'/g;
          }
      }
      else {
          ($quoted, $decoded) = $self->_read_doublequoted($yaml);
      }
      my $eol = '';
      unless (length $$yaml) {
          if ($quoted =~ s/($RE_WS+)\z//) {
              $eol = $1;
              $decoded =~ s/($eol)\z//;
          }
      }
      my $value = { value => $decoded, orig => $quoted };
  
      if ($$yaml =~ s/\A$first//) {
          if ($start) {
              push @$tokens, ( $token_name . 'D' => $value, $self->line );
          }
          else {
              push @$tokens, ( $token_name . 'D_LINE' => $value, $self->line );
          }
          push @$tokens, ( $token_name => $first, $self->line );
          return $value;
      }
      if (length $$yaml) {
          push @$tokens, ( $token_name . 'D' => $value->{orig}, $self->line );
          $self->push_tokens($tokens);
          $self->exception("Invalid quoted <$first> string");
      }
  
      push @$tokens, ( $token_name . 'D_LINE' => $value, $self->line );
      push @$tokens, ( EOL => $eol, $self->line );
  
      return $value;
  }
  
  sub _read_doublequoted {
      my ($self, $yaml) = @_;
      my $quoted = '';
      my $decoded = '';
      while (1) {
          my $last = 1;
          if ($$yaml =~ s/\A([^"\\]+)//) {
              $quoted .= $1;
              $decoded .= $1;
              $last = 0;
          }
          if ($$yaml =~ s/\A($RE_ESCAPES)//) {
              $quoted .= $1;
              my $dec = defined $2 ? $CONTROL{ $2 }
                          : defined $3 ? chr hex $3
                          : defined $4 ? chr hex $4
                          : chr hex $5;
              $decoded .= $dec;
              $last = 0;
          }
          if ($$yaml =~ s/\A(\\)\z//) {
              $quoted .= $1;
              $decoded .= $1;
              last;
          }
          last if $last;
      }
      return ($quoted, $decoded);
  }
  
  sub _fetch_next_tokens_directive {
      my ($self, $yaml, $eol) = @_;
      my @tokens;
  
      if ($$yaml =~ s/\A(\s*%YAML)//) {
          my $dir = $1;
          if ($$yaml =~ s/\A( )//) {
              $dir .= $1;
              if ($$yaml =~ s/\A(1\.[12]$RE_WS*)//) {
                  $dir .= $1;
                  push @tokens, ( YAML_DIRECTIVE => $dir, $self->line );
              }
              else {
                  $$yaml =~ s/\A(.*)//;
                  $dir .= $1;
                  my $warn = $ENV{YAML_PP_RESERVED_DIRECTIVE} || 'warn';
                  if ($warn eq 'warn') {
                      warn "Found reserved directive '$dir'";
                  }
                  elsif ($warn eq 'fatal') {
                      die "Found reserved directive '$dir'";
                  }
                  push @tokens, ( RESERVED_DIRECTIVE => "$dir", $self->line );
              }
          }
          else {
              $$yaml =~ s/\A(.*)//;
              $dir .= $1;
              push @tokens, ( 'Invalid directive' => $dir, $self->line );
              push @tokens, ( EOL => $eol, $self->line );
              $self->push_tokens(\@tokens);
              return;
          }
      }
      elsif ($$yaml =~ s/\A(\s*%TAG +(!$RE_NS_WORD_CHAR*!|!) +(tag:\S+|!$RE_URI_CHAR+)$RE_WS*)//) {
          push @tokens, ( TAG_DIRECTIVE => $1, $self->line );
          # TODO
          my $tag_alias = $2;
          my $tag_url = $3;
      }
      elsif ($$yaml =~ s/\A(\s*\A%(?:\w+).*)//) {
          push @tokens, ( RESERVED_DIRECTIVE => $1, $self->line );
          my $warn = $ENV{YAML_PP_RESERVED_DIRECTIVE} || 'warn';
          if ($warn eq 'warn') {
              warn "Found reserved directive '$1'";
          }
          elsif ($warn eq 'fatal') {
              die "Found reserved directive '$1'";
          }
      }
      else {
          push @tokens, ( 'Invalid directive' => $$yaml, $self->line );
          push @tokens, ( EOL => $eol, $self->line );
          $self->push_tokens(\@tokens);
          return;
      }
      if (not length $$yaml) {
          push @tokens, ( EOL => $eol, $self->line );
      }
      else {
          push @tokens, ( 'Invalid directive' => $$yaml, $self->line );
          push @tokens, ( EOL => $eol, $self->line );
      }
      $self->push_tokens(\@tokens);
      return;
  }
  
  sub push_tokens {
      my ($self, $new_tokens) = @_;
      my $next = $self->next_tokens;
      my $line = $self->line;
      my $column = $self->offset;
  
      for (my $i = 0; $i < @$new_tokens; $i += 3) {
          my $value = $new_tokens->[ $i + 1 ];
          my $name = $new_tokens->[ $i ];
          my $line = $new_tokens->[ $i + 2 ];
          my $push = {
              name => $name,
              line => $line,
              column => $column,
              value => $value,
          };
          $column += length $value unless $name eq 'CONTEXT';
          push @$next, $push;
          if ($name eq 'EOL') {
              $column = 0;
          }
      }
      $self->set_offset($column);
      return $next;
  }
  
  sub push_subtokens {
      my ($self, $token, $subtokens) = @_;
      my $next = $self->next_tokens;
      my $line = $self->line;
      my $column = $self->offset;
      $token->{column} = $column;
      $token->{subtokens} = \my @sub;
  
      for (my $i = 0; $i < @$subtokens; $i+=3) {
          my $name = $subtokens->[ $i ];
          my $value = $subtokens->[ $i + 1 ];
          my $line = $subtokens->[ $i + 2 ];
          my $push = {
              name => $subtokens->[ $i ],
              line => $line,
              column => $column,
          };
          if (ref $value eq 'HASH') {
              %$push = ( %$push, %$value );
              $column += length $value->{orig};
          }
          else {
              $push->{value} = $value;
              $column += length $value;
          }
          if ($push->{name} eq 'EOL') {
              $column = 0;
          }
          push @sub, $push;
      }
      $token->{line} = $sub[0]->{line};
      push @$next, $token;
      $self->set_offset($column);
      return $next;
  }
  
  sub exception {
      my ($self, $msg) = @_;
      my $next = $self->next_tokens;
      $next = [];
      my $line = @$next ? $next->[0]->{line} : $self->line;
      my @caller = caller(0);
      my $yaml = '';
      if (my $nl = $self->next_line) {
          $yaml = join '', @$nl;
          $yaml = $nl->[1];
      }
      my $e = YAML::PP::Exception->new(
          line => $line,
          column => $self->offset + 1,
          msg => $msg,
          next => $next,
          where => $caller[1] . ' line ' . $caller[2],
          yaml => $yaml,
      );
      croak $e;
  }
  
  1;
YAML_PP_LEXER

$fatpacked{"YAML/PP/Loader.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'YAML_PP_LOADER';
  # ABSTRACT: Load YAML into data with Parser and Constructor
  use strict;
  use warnings;
  package YAML::PP::Loader;
  
  our $VERSION = '0.027'; # VERSION
  
  use YAML::PP::Parser;
  use YAML::PP::Constructor;
  use YAML::PP::Reader;
  
  sub new {
      my ($class, %args) = @_;
  
      my $cyclic_refs = delete $args{cyclic_refs} || 'allow';
      my $default_yaml_version = delete $args{default_yaml_version} || '1.2';
      my $preserve = delete $args{preserve};
      my $duplicate_keys = delete $args{duplicate_keys};
      my $schemas = delete $args{schemas};
      $schemas ||= {
          '1.2' => YAML::PP->default_schema(
              boolean => 'perl',
          )
      };
  
      my $constructor = delete $args{constructor} || YAML::PP::Constructor->new(
          schemas => $schemas,
          cyclic_refs => $cyclic_refs,
          default_yaml_version => $default_yaml_version,
          preserve => $preserve,
          duplicate_keys => $duplicate_keys,
      );
      my $parser = delete $args{parser};
      unless ($parser) {
          $parser = YAML::PP::Parser->new(
              default_yaml_version => $default_yaml_version,
          );
      }
      unless ($parser->receiver) {
          $parser->set_receiver($constructor);
      }
  
      if (keys %args) {
          die "Unexpected arguments: " . join ', ', sort keys %args;
      }
      my $self = bless {
          parser => $parser,
          constructor => $constructor,
      }, $class;
      return $self;
  }
  
  sub clone {
      my ($self) = @_;
      my $clone = {
          parser => $self->parser->clone,
          constructor => $self->constructor->clone,
      };
      bless $clone, ref $self;
      $clone->parser->set_receiver($clone->constructor);
      return $clone;
  }
  
  sub parser { return $_[0]->{parser} }
  sub constructor { return $_[0]->{constructor} }
  
  sub filename {
      my ($self) = @_;
      my $reader = $self->parser->reader;
      if ($reader->isa('YAML::PP::Reader::File')) {
          return $reader->input;
      }
      die "Reader is not a YAML::PP::Reader::File";
  }
  
  sub load_string {
      my ($self, $yaml) = @_;
      $self->parser->set_reader(YAML::PP::Reader->new( input => $yaml ));
      $self->load();
  }
  
  sub load_file {
      my ($self, $file) = @_;
      $self->parser->set_reader(YAML::PP::Reader::File->new( input => $file ));
      $self->load();
  }
  
  sub load {
      my ($self) = @_;
      my $parser = $self->parser;
      my $constructor = $self->constructor;
  
      $constructor->init;
      $parser->parse();
  
      my $docs = $constructor->docs;
      return wantarray ? @$docs : $docs->[0];
  }
  
  
  1;
YAML_PP_LOADER

$fatpacked{"YAML/PP/Parser.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'YAML_PP_PARSER';
  # ABSTRACT: YAML Parser
  use strict;
  use warnings;
  package YAML::PP::Parser;
  
  our $VERSION = '0.027'; # VERSION
  
  use constant TRACE => $ENV{YAML_PP_TRACE} ? 1 : 0;
  use constant DEBUG => ($ENV{YAML_PP_DEBUG} || $ENV{YAML_PP_TRACE}) ? 1 : 0;
  
  use YAML::PP::Common qw/
      YAML_PLAIN_SCALAR_STYLE YAML_SINGLE_QUOTED_SCALAR_STYLE
      YAML_DOUBLE_QUOTED_SCALAR_STYLE
      YAML_LITERAL_SCALAR_STYLE YAML_FOLDED_SCALAR_STYLE
      YAML_FLOW_SEQUENCE_STYLE YAML_FLOW_MAPPING_STYLE
  /;
  use YAML::PP::Render;
  use YAML::PP::Lexer;
  use YAML::PP::Grammar qw/ $GRAMMAR /;
  use YAML::PP::Exception;
  use YAML::PP::Reader;
  use Carp qw/ croak /;
  
  
  sub new {
      my ($class, %args) = @_;
      my $reader = delete $args{reader} || YAML::PP::Reader->new;
      my $default_yaml_version = delete $args{default_yaml_version};
      my $self = bless {
          default_yaml_version => $default_yaml_version || '1.2',
          lexer => YAML::PP::Lexer->new(
              reader => $reader,
          ),
      }, $class;
      my $receiver = delete $args{receiver};
      if ($receiver) {
          $self->set_receiver($receiver);
      }
      return $self;
  }
  
  sub clone {
      my ($self) = @_;
      my $clone = {
          default_yaml_version => $self->default_yaml_version,
          lexer => YAML::PP::Lexer->new(),
      };
      return bless $clone, ref $self;
  }
  
  sub receiver { return $_[0]->{receiver} }
  sub set_receiver {
      my ($self, $receiver) = @_;
      my $callback;
      if (ref $receiver eq 'CODE') {
          $callback = $receiver;
      }
      else {
          $callback = sub {
              my ($self, $event, $info) = @_;
              return $receiver->$event($info);
          };
      }
      $self->{callback} = $callback;
      $self->{receiver} = $receiver;
  }
  sub reader { return $_[0]->lexer->{reader} }
  sub set_reader {
      my ($self, $reader) = @_;
      $self->lexer->set_reader($reader);
  }
  sub lexer { return $_[0]->{lexer} }
  sub callback { return $_[0]->{callback} }
  sub set_callback { $_[0]->{callback} = $_[1] }
  sub level { return $#{ $_[0]->{offset} } }
  sub offset { return $_[0]->{offset} }
  sub set_offset { $_[0]->{offset} = $_[1] }
  sub events { return $_[0]->{events} }
  sub set_events { $_[0]->{events} = $_[1] }
  sub new_node { return $_[0]->{new_node} }
  sub set_new_node { $_[0]->{new_node} = $_[1] }
  sub tagmap { return $_[0]->{tagmap} }
  sub set_tagmap { $_[0]->{tagmap} = $_[1] }
  sub tokens { return $_[0]->{tokens} }
  sub set_tokens { $_[0]->{tokens} = $_[1] }
  sub event_stack { return $_[0]->{event_stack} }
  sub set_event_stack { $_[0]->{event_stack} = $_[1] }
  sub default_yaml_version { return $_[0]->{default_yaml_version} }
  sub yaml_version { return $_[0]->{yaml_version} }
  sub set_yaml_version { $_[0]->{yaml_version} = $_[1] }
  sub yaml_version_directive { return $_[0]->{yaml_version_directive} }
  sub set_yaml_version_directive { $_[0]->{yaml_version_directive} = $_[1] }
  
  sub rule { return $_[0]->{rule} }
  sub set_rule {
      my ($self, $name) = @_;
      no warnings 'uninitialized';
      DEBUG and $self->info("set_rule($name)");
      $self->{rule} = $name;
  }
  
  sub init {
      my ($self) = @_;
      $self->set_offset([]);
      $self->set_events([]);
      $self->set_new_node(0);
      $self->set_tagmap({
          '!!' => "tag:yaml.org,2002:",
      });
      $self->set_tokens([]);
      $self->set_rule(undef);
      $self->set_event_stack([]);
      $self->set_yaml_version($self->default_yaml_version);
      $self->set_yaml_version_directive(undef);
      $self->lexer->init;
  }
  
  sub parse_string {
      my ($self, $yaml) = @_;
      $self->set_reader(YAML::PP::Reader->new( input => $yaml ));
      $self->parse();
  }
  
  sub parse_file {
      my ($self, $file) = @_;
      $self->set_reader(YAML::PP::Reader::File->new( input => $file ));
      $self->parse();
  }
  
  my %nodetypes = (
      MAPVALUE     => 'NODETYPE_COMPLEX',
      MAP          => 'NODETYPE_MAP',
      SEQ          => 'NODETYPE_SEQ',
      SEQ0         => 'NODETYPE_SEQ',
      FLOWMAP      => 'NODETYPE_FLOWMAP',
      FLOWMAPVALUE => 'NODETYPE_FLOWMAPVALUE',
      FLOWSEQ      => 'NODETYPE_FLOWSEQ',
      FLOWSEQ_NEXT => 'FLOWSEQ_NEXT',
      DOC          => 'FULLNODE',
      DOC_END      => 'DOCUMENT_END',
      STR          => 'STREAM',
  );
  
  sub parse {
      my ($self) = @_;
      TRACE and warn "=== parse()\n";
      TRACE and $self->debug_yaml;
      $self->init;
      $self->lexer->init;
      eval {
          $self->start_stream;
          $self->set_rule( 'STREAM' );
  
          $self->parse_tokens();
  
          $self->end_stream;
      };
      if (my $error = $@) {
          if (ref $error) {
              croak "$error\n ";
          }
          croak $error;
      }
  
      DEBUG and $self->highlight_yaml;
      TRACE and $self->debug_tokens;
  }
  
  sub lex_next_tokens {
      my ($self) = @_;
  
      DEBUG and $self->info("----------------> lex_next_tokens");
      TRACE and $self->debug_events;
  
      my $indent = $self->offset->[-1];
      my $event_types = $self->events;
      my $next_tokens = $self->lexer->fetch_next_tokens($indent);
      return unless @$next_tokens;
  
      my $next = $next_tokens->[0];
  
      return 1 if ($next->{name} ne 'SPACE');
      my $flow = $event_types->[-1] =~ m/^FLOW/;
      my $space = length $next->{value};
      my $tokens = $self->tokens;
  
      if (not $space) {
          shift @$next_tokens;
      }
      else {
          push @$tokens, shift @$next_tokens;
      }
      if ($flow) {
          if ($space >= $indent) {
              return 1;
          }
          $self->exception("Bad indendation in " . $self->events->[-1]);
      }
      $next = $next_tokens->[0];
      if ($space > $indent ) {
          return 1 if $indent < 0;
          unless ($self->new_node) {
              $self->exception("Bad indendation in " . $self->events->[-1]);
          }
          return 1;
      }
      if ($self->new_node) {
          if ($space < $indent) {
              $self->scalar_event({ style => YAML_PLAIN_SCALAR_STYLE, value => '' });
              $self->remove_nodes($space);
          }
          else {
              # unindented sequence starts
              my $exp = $self->events->[-1];
              my $seq_start = $next->{name} eq 'DASH';
              if ( $seq_start and ($exp eq 'MAPVALUE' or $exp eq 'MAP')) {
              }
              else {
                  $self->scalar_event({ style => YAML_PLAIN_SCALAR_STYLE, value => '' });
              }
          }
      }
      else {
          if ($space < $indent) {
              $self->remove_nodes($space);
          }
      }
  
      my $exp = $self->events->[-1];
  
      if ($exp eq 'SEQ0' and $next->{name} ne 'DASH') {
          TRACE and $self->info("In unindented sequence");
          $self->end_sequence;
          $exp = $self->events->[-1];
      }
  
      if ($self->offset->[-1] != $space) {
          $self->exception("Expected " . $self->events->[-1]);
      }
      return 1;
  }
  
  my %next_event = (
      MAP => 'MAPVALUE',
      MAPVALUE => 'MAP',
      SEQ => 'SEQ',
      SEQ0 => 'SEQ0',
      DOC => 'DOC_END',
      STR => 'STR',
      FLOWSEQ => 'FLOWSEQ_NEXT',
      FLOWSEQ_NEXT => 'FLOWSEQ',
      FLOWMAP => 'FLOWMAPVALUE',
      FLOWMAPVALUE => 'FLOWMAP',
  );
  
  my %event_to_method = (
      MAP => 'mapping',
      FLOWMAP => 'mapping',
      SEQ => 'sequence',
      SEQ0 => 'sequence',
      FLOWSEQ => 'sequence',
      DOC => 'document',
      STR => 'stream',
      VAL => 'scalar',
      ALI => 'alias',
      MAPVALUE => 'mapping',
  );
  
  #sub process_events {
  #    my ($self, $res) = @_;
  #
  #    my $event_stack = $self->event_stack;
  #    return unless @$event_stack;
  #
  #    if (@$event_stack == 1 and $event_stack->[0]->[0] eq 'properties') {
  #        return;
  #    }
  #
  #    my $event_types = $self->events;
  #    my $properties;
  #    my @send_events;
  #    for my $event (@$event_stack) {
  #        TRACE and warn __PACKAGE__.':'.__LINE__.$".Data::Dumper->Dump([\$event], ['event']);
  #        my ($type, $info) = @$event;
  #        if ($type eq 'properties') {
  #            $properties = $info;
  #        }
  #        elsif ($type eq 'scalar') {
  #            $info->{name} = 'scalar_event';
  #            $event_types->[-1] = $next_event{ $event_types->[-1] };
  #            push @send_events, $info;
  #        }
  #        elsif ($type eq 'begin') {
  #            my $name = $info->{name};
  #            $info->{name} = $event_to_method{ $name } . '_start_event';
  #            push @{ $event_types }, $name;
  #            push @{ $self->offset }, $info->{offset};
  #            push @send_events, $info;
  #        }
  #        elsif ($type eq 'end') {
  #            my $name = $info->{name};
  #            $info->{name} = $event_to_method{ $name } . '_end_event';
  #            $self->$type($name, $info);
  #            push @send_events, $info;
  #            if (@$event_types) {
  #                $event_types->[-1] = $next_event{ $event_types->[-1] };
  #            }
  #        }
  #        elsif ($type eq 'alias') {
  #            if ($properties) {
  #                $self->exception("Parse error: Alias not allowed in this context");
  #            }
  #            $info->{name} = 'alias_event';
  #            $event_types->[-1] = $next_event{ $event_types->[-1] };
  #            push @send_events, $info;
  #        }
  #    }
  #    @$event_stack = ();
  #    for my $info (@send_events) {
  #        DEBUG and $self->debug_event( $info );
  #        $self->callback->($self, $info->{name}, $info);
  #    }
  #}
  
  my %fetch_method = (
      '"' => 'fetch_quoted',
      "'" => 'fetch_quoted',
      '|' => 'fetch_block',
      '>' => 'fetch_block',
      ''  => 'fetch_plain',
  );
  
  sub parse_tokens {
      my ($self) = @_;
      my $event_types = $self->events;
      my $offsets = $self->offset;
      my $tokens = $self->tokens;
      my $next_tokens = $self->lexer->next_tokens;
  
      unless ($self->lex_next_tokens) {
          $self->end_document(1);
          return 0;
      }
      unless ($self->new_node) {
          if ($self->level > 0) {
              my $new_rule = $nodetypes{ $event_types->[-1] }
                  or die "Did not find '$event_types->[-1]'";
              $self->set_rule( $new_rule );
          }
      }
  
      my $rule_name = $self->rule;
      DEBUG and $self->info("----------------> parse_tokens($rule_name)");
      my $rule = $GRAMMAR->{ $rule_name }
          or die "Could not find rule $rule_name";
  
      TRACE and $self->debug_rules($rule);
      TRACE and $self->debug_yaml;
      DEBUG and $self->debug_next_line;
  
      RULE: while ($rule_name) {
          DEBUG and $self->info("RULE: $rule_name");
          TRACE and $self->debug_tokens($next_tokens);
  
          unless (@$next_tokens) {
              $self->exception("No more tokens");
          }
          TRACE and warn __PACKAGE__.':'.__LINE__.$".Data::Dumper->Dump([\$next_tokens->[0]], ['next_token']);
          my $got = $next_tokens->[0]->{name};
          if ($got eq 'CONTEXT') {
              my $context = shift @$next_tokens;
              my $indent = $offsets->[-1];
              $indent++ unless $self->lexer->flowcontext;
              my $method = $fetch_method{ $context->{value} };
              my $partial = $self->lexer->$method($indent, $context->{value});
              next RULE;
          }
          my $def = $rule->{ $got };
          if ($def) {
              push @$tokens, shift @$next_tokens;
          }
          elsif ($def = $rule->{DEFAULT}) {
              $got = 'DEFAULT';
          }
          else {
              $self->expected(
                  expected => [keys %$rule],
                  got => $next_tokens->[0],
              );
          }
  
          DEBUG and $self->got("---got $got");
          if (my $sub = $def->{match}) {
              DEBUG and $self->info("CALLBACK $sub");
              $self->$sub(@$tokens ? $tokens->[-1] : ());
          }
          my $eol = $got eq 'EOL';
          my $new = $def->{new};
          if ($new) {
              DEBUG and $self->got("NEW: $new");
              $rule_name = $new;
              $self->set_rule($rule_name);
          }
          elsif ($eol) {
          }
          elsif ($def->{return}) {
              $rule_name = $nodetypes{ $event_types->[-1] }
                  or die "Unexpected event type $event_types->[-1]";
              $self->set_rule($rule_name);
          }
          else {
              $rule_name .= " - $got"; # for debugging
              $rule = $def;
              next RULE;
          }
          if ($eol) {
              unless ($self->lex_next_tokens) {
                  $self->end_document(1);
                  return 0;
              }
              unless ($self->new_node) {
                  if ($self->level > 0) {
                      $rule_name = $nodetypes{ $event_types->[-1] }
                          or die "Did not find '$event_types->[-1]'";
                      $self->set_rule( $rule_name );
                  }
              }
              $rule_name = $self->rule;
          }
          $rule = $GRAMMAR->{ $rule_name }
              or die "Unexpected rule $rule_name";
  
      }
  
      die "Unexpected";
  }
  
  sub end_sequence {
      my ($self) = @_;
      my $event_types = $self->events;
      pop @{ $event_types };
      pop @{ $self->offset };
      my $info = { name => 'sequence_end_event' };
      $self->callback->($self, $info->{name} => $info );
      $event_types->[-1] = $next_event{ $event_types->[-1] };
  }
  
  sub remove_nodes {
      my ($self, $space) = @_;
      my $offset = $self->offset;
      my $event_types = $self->events;
  
      my $exp = $event_types->[-1];
      while (@$offset) {
          if ($offset->[ -1 ] <= $space) {
              last;
          }
          if ($exp eq 'MAPVALUE') {
              $self->scalar_event({ style => YAML_PLAIN_SCALAR_STYLE, value => '' });
              $exp = 'MAP';
          }
          my $info = { name => $exp };
          $info->{name} = $event_to_method{ $exp } . '_end_event';
          pop @{ $event_types };
          pop @{ $offset };
          $self->callback->($self, $info->{name} => $info );
          $event_types->[-1] = $next_event{ $event_types->[-1] };
          $exp = $event_types->[-1];
      }
      return $exp;
  }
  
  sub start_stream {
      my ($self) = @_;
      push @{ $self->events }, 'STR';
      push @{ $self->offset }, -1;
      $self->callback->($self, 'stream_start_event', {
          name => 'stream_start_event',
      });
  }
  
  sub start_document {
      my ($self, $implicit) = @_;
      push @{ $self->events }, 'DOC';
      push @{ $self->offset }, -1;
      my $directive = $self->yaml_version_directive;
      my %directive;
      if ($directive) {
          my ($major, $minor) = split m/\./, $self->yaml_version;
          %directive = ( version_directive => { major => $major, minor => $minor } );
      }
      $self->callback->($self, 'document_start_event', {
          name => 'document_start_event',
          implicit => $implicit,
          %directive,
      });
      $self->set_yaml_version_directive(undef);
      $self->set_rule( 'FULLNODE' );
      $self->set_new_node(1);
  }
  
  sub start_sequence {
      my ($self, $offset) = @_;
      my $offsets = $self->offset;
      if ($offsets->[-1] == $offset) {
          push @{ $self->events }, 'SEQ0';
      }
      else {
          push @{ $self->events }, 'SEQ';
      }
      push @{ $offsets }, $offset;
      my $event_stack = $self->event_stack;
      my $info = { name => 'sequence_start_event' };
      if (@$event_stack and $event_stack->[-1]->[0] eq 'properties') {
          my $properties = pop @$event_stack;
          $self->node_properties($properties->[1], $info);
      }
      $self->callback->($self, 'sequence_start_event', $info);
  }
  
  sub start_flow_sequence {
      my ($self, $offset) = @_;
      my $offsets = $self->offset;
      my $new_offset = $offsets->[-1];
      my $event_types = $self->events;
      if ($new_offset < 0) {
          $new_offset = 0;
      }
      elsif ($self->new_node) {
          if ($event_types->[-1] !~ m/^FLOW/) {
              $new_offset++;
          }
      }
      push @{ $self->events }, 'FLOWSEQ';
      push @{ $offsets }, $new_offset;
  
      my $event_stack = $self->event_stack;
      my $info = { style => YAML_FLOW_SEQUENCE_STYLE, name => 'sequence_start_event'  };
      if (@$event_stack and $event_stack->[-1]->[0] eq 'properties') {
          $self->fetch_inline_properties($event_stack, $info);
      }
      $self->callback->($self, 'sequence_start_event', $info);
  }
  
  sub start_flow_mapping {
      my ($self, $offset) = @_;
      my $offsets = $self->offset;
      my $new_offset = $offsets->[-1];
      my $event_types = $self->events;
      if ($new_offset < 0) {
          $new_offset = 0;
      }
      elsif ($self->new_node) {
          if ($event_types->[-1] !~ m/^FLOW/) {
              $new_offset++;
          }
      }
      push @{ $self->events }, 'FLOWMAP';
      push @{ $offsets }, $new_offset;
  
      my $event_stack = $self->event_stack;
      my $info = { name => 'mapping_start_event', style => YAML_FLOW_MAPPING_STYLE };
      if (@$event_stack and $event_stack->[-1]->[0] eq 'properties') {
          $self->fetch_inline_properties($event_stack, $info);
      }
      $self->callback->($self, 'mapping_start_event', $info);
  }
  
  sub end_flow_sequence {
      my ($self) = @_;
      my $event_types = $self->events;
      pop @{ $event_types };
      pop @{ $self->offset };
      my $info = { name => 'sequence_end_event' };
      $self->callback->($self, $info->{name}, $info);
      $event_types->[-1] = $next_event{ $event_types->[-1] };
  }
  
  sub end_flow_mapping {
      my ($self) = @_;
      my $event_types = $self->events;
      pop @{ $event_types };
      pop @{ $self->offset };
      my $info = { name => 'mapping_end_event' };
      $self->callback->($self, $info->{name}, $info);
      $event_types->[-1] = $next_event{ $event_types->[-1] };
  }
  
  sub start_mapping {
      my ($self, $offset) = @_;
      my $offsets = $self->offset;
      push @{ $self->events }, 'MAP';
      push @{ $offsets }, $offset;
      my $event_stack = $self->event_stack;
      my $info = { name => 'mapping_start_event' };
      if (@$event_stack and $event_stack->[-1]->[0] eq 'properties') {
          my $properties = pop @$event_stack;
          $self->node_properties($properties->[1], $info);
      }
      $self->callback->($self, 'mapping_start_event', $info);
  }
  
  sub end_document {
      my ($self, $implicit) = @_;
  
      my $event_types = $self->events;
      if ($event_types->[-1] =~ m/FLOW/) {
          die "Unexpected end of flow context";
      }
      if ($self->new_node) {
          $self->scalar_event({ style => YAML_PLAIN_SCALAR_STYLE, value => '' });
      }
      $self->remove_nodes(-1);
  
      if ($event_types->[-1] eq 'STR') {
          return;
      }
      my $last = pop @{ $event_types };
      if ($last ne 'DOC' and $last ne 'DOC_END') {
          $self->exception("Unexpected event type $last");
      }
      pop @{ $self->offset };
      $self->callback->($self, 'document_end_event', {
          name => 'document_end_event',
          implicit => $implicit,
      });
      if ($self->yaml_version eq '1.2') {
          # In YAML 1.2, directives are only for the following
          # document. In YAML 1.1, they are global
          $self->set_tagmap({ '!!' => "tag:yaml.org,2002:" });
      }
      $event_types->[-1] = $next_event{ $event_types->[-1] };
      $self->set_rule('STREAM');
  }
  
  sub end_stream {
      my ($self) = @_;
      my $last = pop @{ $self->events };
      $self->exception("Unexpected event type $last") unless $last eq 'STR';
      pop @{ $self->offset };
      $self->callback->($self, 'stream_end_event', {
          name => 'stream_end_event',
      });
  }
  
  sub fetch_inline_properties {
      my ($self, $stack, $info) = @_;
      my $properties = $stack->[-1];
  
      $properties = $properties->[1];
      my $property_offset;
      if ($properties) {
          for my $p (@{ $properties->{inline} }) {
              my $type = $p->{type};
              if (exists $info->{ $type }) {
                  $self->exception("A node can only have one $type");
              }
              $info->{ $type } = $p->{value};
              unless (defined $property_offset) {
                  $property_offset = $p->{offset};
                  $info->{offset} = $p->{offset};
              }
          }
          delete $properties->{inline};
          undef $properties unless $properties->{newline};
      }
  
      unless ($properties) {
          pop @$stack;
      }
  }
  
  sub node_properties {
      my ($self, $properties, $info) = @_;
      if ($properties) {
          for my $p (@{ $properties->{newline} }) {
              my $type = $p->{type};
              if (exists $info->{ $type }) {
                  $self->exception("A node can only have one $type");
              }
              $info->{ $type } = $p->{value};
          }
          undef $properties;
      }
  }
  
  sub scalar_event {
      my ($self, $info) = @_;
      my $event_types = $self->events;
      my $event_stack = $self->event_stack;
      if (@$event_stack and $event_stack->[-1]->[0] eq 'properties') {
          my $properties = pop @$event_stack;
          $properties = $self->node_properties($properties->[1], $info);
      }
  
      $info->{name} = 'scalar_event';
      $self->callback->($self, 'scalar_event', $info);
      $self->set_new_node(0);
      $event_types->[-1] = $next_event{ $event_types->[-1] };
  }
  
  sub alias_event {
      my ($self, $info) = @_;
      my $event_stack = $self->event_stack;
      if (@$event_stack and $event_stack->[-1]->[0] eq 'properties') {
          $self->exception("Parse error: Alias not allowed in this context");
      }
      my $event_types = $self->events;
      $info->{name} = 'alias_event';
      $self->callback->($self, 'alias_event', $info);
      $self->set_new_node(0);
      $event_types->[-1] = $next_event{ $event_types->[-1] };
  }
  
  sub yaml_to_tokens {
      my ($class, $type, $input) = @_;
      my $yp = YAML::PP::Parser->new( receiver => sub {} );
      my @docs = eval {
          $type eq 'string' ? $yp->parse_string($input) : $yp->parse_file($input);
      };
      my $error = $@;
  
      my $tokens = $yp->tokens;
      if ($error) {
          my $remaining_tokens = $yp->_remaining_tokens;
          push @$tokens, map { +{ %$_, name => 'ERROR' } } @$remaining_tokens;
      }
      return $error, $tokens;
  }
  
  sub _remaining_tokens {
      my ($self) = @_;
      my @tokens;
      my $next = $self->lexer->next_tokens;
      push @tokens, @$next;
      my $next_line = $self->lexer->next_line;
      my $remaining = '';
      if ($next_line) {
          if ($self->lexer->offset > 0) {
              $remaining = $next_line->[1] . $next_line->[2];
          }
          else {
              $remaining = join '', @$next_line;
          }
      }
      $remaining .= $self->reader->read;
      $remaining = '' unless defined $remaining;
      push @tokens, { name => "ERROR", value => $remaining };
      return \@tokens;
  }
  
  sub event_to_test_suite {
      my ($self, $event) = @_;
      if (ref $event eq 'ARRAY') {
          return YAML::PP::Common::event_to_test_suite($event->[1]);
      }
      return YAML::PP::Common::event_to_test_suite($event);
  }
  
  sub debug_events {
      my ($self) = @_;
      $self->note("EVENTS: ("
          . join (' | ', @{ $_[0]->events }) . ')'
      );
      $self->debug_offset;
  }
  
  sub debug_offset {
      my ($self) = @_;
      $self->note(
          qq{OFFSET: (}
          . join (' | ', map { defined $_ ? sprintf "%-3d", $_ : '?' } @{ $_[0]->offset })
          . qq/) level=@{[ $_[0]->level ]}]}/
      );
  }
  
  sub debug_yaml {
      my ($self) = @_;
      my $line = $self->lexer->line;
      $self->note("LINE NUMBER: $line");
      my $next_tokens = $self->lexer->next_tokens;
      if (@$next_tokens) {
          $self->debug_tokens($next_tokens);
      }
  }
  
  sub debug_next_line {
      my ($self) = @_;
      my $next_line = $self->lexer->next_line || [];
      my $line = $next_line->[0];
      $line = '' unless defined $line;
      $line =~ s/( +)$/'·' x length $1/e;
      $line =~ s/\t/▸/g;
      $self->note("NEXT LINE: >>$line<<");
  }
  
  sub note {
      my ($self, $msg) = @_;
      $self->_colorize_warn(["yellow"], "============ $msg");
  }
  
  sub info {
      my ($self, $msg) = @_;
      $self->_colorize_warn(["cyan"], "============ $msg");
  }
  
  sub got {
      my ($self, $msg) = @_;
      $self->_colorize_warn(["green"], "============ $msg");
  }
  
  sub _colorize_warn {
      my ($self, $colors, $text) = @_;
      require Term::ANSIColor;
      warn Term::ANSIColor::colored($colors, $text), "\n";
  }
  
  sub debug_event {
      my ($self, $event) = @_;
      my $str = YAML::PP::Common::event_to_test_suite($event);
      require Term::ANSIColor;
      warn Term::ANSIColor::colored(["magenta"], "============ $str"), "\n";
  }
  
  sub debug_rules {
      my ($self, $rules) = @_;
      local $Data::Dumper::Maxdepth = 2;
      $self->note("RULES:");
      for my $rule ($rules) {
          if (ref $rule eq 'ARRAY') {
              my $first = $rule->[0];
              if (ref $first eq 'SCALAR') {
                  $self->info("-> $$first");
              }
              else {
                  if (ref $first eq 'ARRAY') {
                      $first = $first->[0];
                  }
                  $self->info("TYPE $first");
              }
          }
          else {
              eval {
                  my @keys = sort keys %$rule;
                  $self->info("@keys");
              };
          }
      }
  }
  
  sub debug_tokens {
      my ($self, $tokens) = @_;
      $tokens ||= $self->tokens;
      require Term::ANSIColor;
      for my $token (@$tokens) {
          my $type = Term::ANSIColor::colored(["green"],
              sprintf "%-22s L %2d C %2d ",
                  $token->{name}, $token->{line}, $token->{column} + 1
          );
          local $Data::Dumper::Useqq = 1;
          local $Data::Dumper::Terse = 1;
          require Data::Dumper;
          my $str = Data::Dumper->Dump([$token->{value}], ['str']);
          chomp $str;
          $str =~ s/(^.|.$)/Term::ANSIColor::colored(['blue'], $1)/ge;
          warn "$type$str\n";
      }
  
  }
  
  sub highlight_yaml {
      my ($self) = @_;
      require YAML::PP::Highlight;
      my $tokens = $self->tokens;
      my $highlighted = YAML::PP::Highlight->ansicolored($tokens);
      warn $highlighted;
  }
  
  sub exception {
      my ($self, $msg, %args) = @_;
      my $next = $self->lexer->next_tokens;
      my $line = @$next ? $next->[0]->{line} : $self->lexer->line;
      my $offset = @$next ? $next->[0]->{column} : $self->lexer->offset;
      $offset++;
      my $next_line = $self->lexer->next_line;
      my $remaining = '';
      if ($next_line) {
          if ($self->lexer->offset > 0) {
              $remaining = $next_line->[1] . $next_line->[2];
          }
          else {
              $remaining = join '', @$next_line;
          }
      }
      my $caller = $args{caller} || [ caller(0) ];
      my $e = YAML::PP::Exception->new(
          got => $args{got},
          expected => $args{expected},
          line => $line,
          column => $offset,
          msg => $msg,
          next => $next,
          where => $caller->[1] . ' line ' . $caller->[2],
          yaml => $remaining,
      );
      croak $e;
  }
  
  sub expected {
      my ($self, %args) = @_;
      my $expected = $args{expected};
      @$expected = sort grep { m/^[A-Z_]+$/ } @$expected;
      my $got = $args{got}->{name};
      my @caller = caller(0);
      $self->exception("Expected (@$expected), but got $got",
          caller => \@caller,
          expected => $expected,
          got => $args{got},
      );
  }
  
  sub cb_tag {
      my ($self, $token) = @_;
      my $stack = $self->event_stack;
      if (! @$stack or $stack->[-1]->[0] ne 'properties') {
          push @$stack, [ properties => {} ];
      }
      my $last = $stack->[-1]->[1];
      my $tag = $self->_read_tag($token->{value}, $self->tagmap);
      $last->{inline} ||= [];
      push @{ $last->{inline} }, {
          type => 'tag',
          value => $tag,
          offset => $token->{column},
      };
  }
  
  sub _read_tag {
      my ($self, $tag, $map) = @_;
      if ($tag eq '!') {
          return "!";
      }
      elsif ($tag =~ m/^!<(.*)>/) {
          return $1;
      }
      elsif ($tag =~ m/^(![^!]*!|!)(.+)/) {
          my $alias = $1;
          my $name = $2;
          $name =~ s/%([0-9a-fA-F]{2})/chr hex $1/eg;
          if (exists $map->{ $alias }) {
              $tag = $map->{ $alias }. $name;
          }
          else {
              if ($alias ne '!' and $alias ne '!!') {
                  die "Found undefined tag handle '$alias'";
              }
              $tag = "!$name";
          }
      }
      else {
          die "Invalid tag";
      }
      return $tag;
  }
  
  sub cb_anchor {
      my ($self, $token) = @_;
      my $anchor = $token->{value};
      $anchor = substr($anchor, 1);
      my $stack = $self->event_stack;
      if (! @$stack or $stack->[-1]->[0] ne 'properties') {
          push @$stack, [ properties => {} ];
      }
      my $last = $stack->[-1]->[1];
      $last->{inline} ||= [];
      push @{ $last->{inline} }, {
          type => 'anchor',
          value => $anchor,
          offset => $token->{column},
      };
  }
  
  sub cb_property_eol {
      my ($self, $res) = @_;
      my $stack = $self->event_stack;
      my $last = $stack->[-1]->[1];
      my $inline = delete $last->{inline} or return;
      my $newline = $last->{newline} ||= [];
      push @$newline, @$inline;
  }
  
  sub cb_mapkey {
      my ($self, $token) = @_;
      my $stack = $self->event_stack;
      my $info = {
          style => YAML_PLAIN_SCALAR_STYLE,
          value => $token->{value},
          offset => $token->{column},
      };
      if (@$stack and $stack->[-1]->[0] eq 'properties') {
          $self->fetch_inline_properties($stack, $info);
      }
      push @{ $stack }, [ scalar => $info ];
  }
  
  sub cb_send_mapkey {
      my ($self, $res) = @_;
      my $last = pop @{ $self->event_stack };
      $self->scalar_event($last->[1]);
      $self->set_new_node(1);
  }
  
  sub cb_send_scalar {
      my ($self, $res) = @_;
      my $last = pop @{ $self->event_stack };
      $self->scalar_event($last->[1]);
  }
  
  sub cb_empty_mapkey {
      my ($self, $token) = @_;
      my $stack = $self->event_stack;
      my $info = {
          style => YAML_PLAIN_SCALAR_STYLE,
          value => '',
          offset => $token->{column},
      };
      if (@$stack and $stack->[-1]->[0] eq 'properties') {
          $self->fetch_inline_properties($stack, $info);
      }
      $self->scalar_event($info);
      $self->set_new_node(1);
  }
  
  sub cb_send_flow_alias {
      my ($self, $token) = @_;
      my $alias = substr($token->{value}, 1);
      $self->alias_event({ value => $alias });
  }
  
  sub cb_send_alias {
      my ($self, $token) = @_;
      my $alias = substr($token->{value}, 1);
      $self->alias_event({ value => $alias });
  }
  
  sub cb_send_alias_from_stack {
      my ($self, $token) = @_;
      my $last = pop @{ $self->event_stack };
      $self->alias_event($last->[1]);
  }
  
  sub cb_alias {
      my ($self, $token) = @_;
      my $alias = substr($token->{value}, 1);
      push @{ $self->event_stack }, [ alias => {
          value => $alias,
          offset => $token->{column},
      }];
  }
  
  sub cb_question {
      my ($self, $res) = @_;
      $self->set_new_node(1);
  }
  
  sub cb_flow_question {
      my ($self, $res) = @_;
  }
  
  sub cb_empty_complexvalue {
      my ($self, $res) = @_;
      $self->scalar_event({ style => YAML_PLAIN_SCALAR_STYLE, value => '' });
  }
  
  sub cb_questionstart {
      my ($self, $token) = @_;
      $self->start_mapping($token->{column});
  }
  
  sub cb_complexcolon {
      my ($self, $res) = @_;
      $self->set_new_node(1);
  }
  
  sub cb_seqstart {
      my ($self, $token) = @_;
      my $column = $token->{column};
      $self->start_sequence($column);
      $self->set_new_node(1);
  }
  
  sub cb_seqitem {
      my ($self, $res) = @_;
      $self->set_new_node(1);
  }
  
  sub cb_take_quoted {
      my ($self, $token) = @_;
      my $subtokens = $token->{subtokens};
      my $stack = $self->event_stack;
      my $info = {
          style => $subtokens->[0]->{value} eq '"'
              ? YAML_DOUBLE_QUOTED_SCALAR_STYLE
              : YAML_SINGLE_QUOTED_SCALAR_STYLE,
          value => $token->{value},
          offset => $token->{column},
      };
      if (@$stack and $stack->[-1]->[0] eq 'properties') {
          $self->fetch_inline_properties($stack, $info);
      }
      push @{ $stack }, [ scalar => $info ];
  }
  
  sub cb_quoted_multiline {
      my ($self, $token) = @_;
      my $subtokens = $token->{subtokens};
      my $stack = $self->event_stack;
      my $info = {
          style => $subtokens->[0]->{value} eq '"'
              ? YAML_DOUBLE_QUOTED_SCALAR_STYLE
              : YAML_SINGLE_QUOTED_SCALAR_STYLE,
          value => $token->{value},
          offset => $token->{column},
      };
      if (@$stack and $stack->[-1]->[0] eq 'properties') {
          $self->fetch_inline_properties($stack, $info);
      }
      push @{ $stack }, [ scalar => $info ];
      $self->cb_send_scalar;
  }
  
  sub cb_take_quoted_key {
      my ($self, $token) = @_;
      $self->cb_take_quoted($token);
      $self->cb_send_mapkey;
  }
  
  sub cb_send_plain_multi {
      my ($self, $token) = @_;
      my $stack = $self->event_stack;
      my $info = {
          style => YAML_PLAIN_SCALAR_STYLE,
          value => $token->{value},
          offset => $token->{column},
      };
      if (@$stack and $stack->[-1]->[0] eq 'properties') {
          $self->fetch_inline_properties($stack, $info);
      }
      push @{ $stack }, [ scalar => $info ];
      $self->cb_send_scalar;
  }
  
  sub cb_start_plain {
      my ($self, $token) = @_;
      my $stack = $self->event_stack;
      my $info = {
              style => YAML_PLAIN_SCALAR_STYLE,
              value => $token->{value},
              offset => $token->{column},
      };
      if (@$stack and $stack->[-1]->[0] eq 'properties') {
          $self->fetch_inline_properties($stack, $info);
      }
      push @{ $stack }, [ scalar => $info ];
  }
  
  sub cb_start_flowseq {
      my ($self, $token) = @_;
      $self->start_flow_sequence($token->{column});
  }
  
  sub cb_start_flowmap {
      my ($self, $token) = @_;
      $self->start_flow_mapping($token->{column});
  }
  
  sub cb_end_flowseq {
      my ($self, $res) = @_;
      $self->end_flow_sequence;
      $self->set_new_node(0);
  }
  
  sub cb_flow_comma {
      my ($self) = @_;
      my $event_types = $self->events;
      $self->set_new_node(0);
      if ($event_types->[-1] =~ m/^FLOWSEQ/) {
          $event_types->[-1] = $next_event{ $event_types->[-1] };
      }
  }
  
  sub cb_flow_colon {
      my ($self) = @_;
      $self->set_new_node(1);
  }
  
  sub cb_empty_flow_mapkey {
      my ($self, $token) = @_;
      my $stack = $self->event_stack;
      my $info = {
          style => YAML_PLAIN_SCALAR_STYLE,
          value => '',
          offset => $token->{column},
      };
      if (@$stack and $stack->[-1]->[0] eq 'properties') {
          $self->fetch_inline_properties($stack, $info);
      }
      $self->scalar_event($info);
  }
  
  sub cb_end_flowmap {
      my ($self, $res) = @_;
      $self->end_flow_mapping;
      $self->set_new_node(0);
  }
  
  sub cb_end_flowmap_empty {
      my ($self, $res) = @_;
      $self->cb_empty_flowmap_value;
      $self->end_flow_mapping;
      $self->set_new_node(0);
  }
  
  sub cb_flow_plain {
      my ($self, $token) = @_;
      my $stack = $self->event_stack;
      my $info = {
          style => YAML_PLAIN_SCALAR_STYLE,
          value => $token->{value},
          offset => $token->{column},
      };
      if (@$stack and $stack->[-1]->[0] eq 'properties') {
          $self->fetch_inline_properties($stack, $info);
      }
      $self->scalar_event($info);
  }
  
  sub cb_flowkey_plain {
      my ($self, $token) = @_;
      my $stack = $self->event_stack;
      my $info = {
          style => YAML_PLAIN_SCALAR_STYLE,
          value => $token->{value},
          offset => $token->{column},
      };
      if (@$stack and $stack->[-1]->[0] eq 'properties') {
          $self->fetch_inline_properties($stack, $info);
      }
      $self->scalar_event($info);
  }
  
  sub cb_flowkey_quoted {
      my ($self, $token) = @_;
      my $stack = $self->event_stack;
      my $subtokens = $token->{subtokens};
      my $info = {
          style => $subtokens->[0]->{value} eq '"'
              ? YAML_DOUBLE_QUOTED_SCALAR_STYLE
              : YAML_SINGLE_QUOTED_SCALAR_STYLE,
          value => $token->{value},
          offset => $token->{column},
      };
      if (@$stack and $stack->[-1]->[0] eq 'properties') {
          $self->fetch_inline_properties($stack, $info);
      }
      $self->scalar_event($info);
  }
  
  sub cb_empty_flowmap_value {
      my ($self, $token) = @_;
      my $stack = $self->event_stack;
      my $info = {
          style => YAML_PLAIN_SCALAR_STYLE,
          value => '',
          offset => $token->{column},
      };
      if (@$stack and $stack->[-1]->[0] eq 'properties') {
          $self->fetch_inline_properties($stack, $info);
      }
      $self->scalar_event($info);
  }
  
  sub cb_insert_map_alias {
      my ($self, $res) = @_;
      my $stack = $self->event_stack;
      my $scalar = pop @$stack;
      my $info = $scalar->[1];
      $self->start_mapping($info->{offset});
      $self->alias_event($info);
      $self->set_new_node(1);
  }
  
  sub cb_insert_map {
      my ($self, $res) = @_;
      my $stack = $self->event_stack;
      my $scalar = pop @$stack;
      my $info = $scalar->[1];
      $self->start_mapping($info->{offset});
      $self->scalar_event($info);
      $self->set_new_node(1);
  }
  
  sub cb_insert_empty_map {
      my ($self, $token) = @_;
      my $stack = $self->event_stack;
      my $info = {
          style => YAML_PLAIN_SCALAR_STYLE,
          value => '',
          offset => $token->{column},
      };
      if (@$stack and $stack->[-1]->[0] eq 'properties') {
          $self->fetch_inline_properties($stack, $info);
      }
      $self->start_mapping($info->{offset});
      $self->scalar_event($info);
      $self->set_new_node(1);
  }
  
  sub cb_send_block_scalar {
      my ($self, $token) = @_;
      my $type = $token->{subtokens}->[0]->{value};
      my $stack = $self->event_stack;
      my $info = {
          style => $type eq '|'
              ? YAML_LITERAL_SCALAR_STYLE
              : YAML_FOLDED_SCALAR_STYLE,
          value => $token->{value},
          offset => $token->{column},
      };
      if (@$stack and $stack->[-1]->[0] eq 'properties') {
          $self->fetch_inline_properties($stack, $info);
      }
      push @{ $self->event_stack }, [ scalar => $info ];
      $self->cb_send_scalar;
  }
  
  sub cb_end_document {
      my ($self, $token) = @_;
      $self->end_document(0);
  }
  
  sub cb_end_document_empty {
      my ($self, $token) = @_;
      $self->end_document(0);
  }
  
  sub cb_doc_start_implicit {
      my ($self, $token) = @_;
      $self->start_document(1);
  }
  
  sub cb_doc_start_explicit {
      my ($self, $token) = @_;
      $self->start_document(0);
  }
  
  sub cb_end_doc_start_document {
      my ($self, $token) = @_;
      $self->end_document(1);
      $self->start_document(0);
  }
  
  sub cb_tag_directive {
      my ($self, $token) = @_;
      my ($name, $tag_alias, $tag_url) = split ' ', $token->{value};
      $self->tagmap->{ $tag_alias } = $tag_url;
  }
  
  sub cb_reserved_directive {
  }
  
  sub cb_set_yaml_version_directive {
      my ($self, $token) = @_;
      if ($self->yaml_version_directive) {
          croak "Found duplicate YAML directive";
      }
      my ($version) = $token->{value} =~ m/^%YAML (1\.[12])/;
      $self->set_yaml_version($version);
      $self->set_yaml_version_directive(1);
  }
  
  1;
YAML_PP_PARSER

$fatpacked{"YAML/PP/Perl.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'YAML_PP_PERL';
  use strict;
  use warnings;
  package YAML::PP::Perl;
  
  our $VERSION = '0.027'; # VERSION
  
  use base 'Exporter';
  use base 'YAML::PP';
  our @EXPORT_OK = qw/ Load Dump LoadFile DumpFile /;
  
  use YAML::PP;
  use YAML::PP::Schema::Perl;
  
  sub new {
      my ($class, %args) = @_;
      $args{schema} ||= [qw/ Core Perl /];
      $class->SUPER::new(%args);
  }
  
  sub Load {
      my ($yaml) = @_;
      __PACKAGE__->new->load_string($yaml);
  }
  
  sub LoadFile {
      my ($file) = @_;
      __PACKAGE__->new->load_file($file);
  }
  
  sub Dump {
      my (@data) = @_;
      __PACKAGE__->new->dump_string(@data);
  }
  
  sub DumpFile {
      my ($file, @data) = @_;
      __PACKAGE__->new->dump_file($file, @data);
  }
  
  1;
  
  __END__
  
  =pod
  
  =encoding utf-8
  
  =head1 NAME
  
  YAML::PP::Perl - Convenience module for loading and dumping Perl objects
  
  =head1 SYNOPSIS
  
      use YAML::PP::Perl;
      my @docs = YAML::PP::Perl->new->load_string($yaml);
      my @docs = YAML::PP::Perl::Load($yaml);
  
      # same as
      use YAML::PP;
      my $yp = YAML::PP->new( schema => [qw/ Core Perl /] );
      my @docs = $yp->load_string($yaml);
  
  =head1 DESCRIPTION
  
  This is just for convenience. It will create a YAML::PP object using the
  default schema (C<Core>) and the L<YAML::PP::Schema::Perl> schema.
  
  See L<YAML::PP::Schema::Perl> for documentation.
  
  =head1 METHODS
  
  =over
  
  =item Load, Dump, LoadFile, DumpFile
  
  These work like the functions in L<YAML::PP>, just adding the C<Perl> schema.
  
  =item new
  
  Constructor, works like in L<YAML::PP>, just adds the C<Perl> schema to the
  list of arguments.
  
  =back
YAML_PP_PERL

$fatpacked{"YAML/PP/Reader.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'YAML_PP_READER';
  # ABSTRACT: Reader class for YAML::PP representing input data
  use strict;
  use warnings;
  package YAML::PP::Reader;
  
  our $VERSION = '0.027'; # VERSION
  
  sub input { return $_[0]->{input} }
  sub set_input { $_[0]->{input} = $_[1] }
  
  sub new {
      my ($class, %args) = @_;
      my $input = delete $args{input};
      return bless {
          input => $input,
      }, $class;
  }
  
  sub read {
      my ($self) = @_;
      my $pos = pos $self->{input} || 0;
      my $yaml = substr($self->{input}, $pos);
      $self->{input} = '';
      return $yaml;
  }
  
  sub readline {
      my ($self) = @_;
      unless (length $self->{input}) {
          return;
      }
      if ( $self->{input} =~ m/\G([^\r\n]*(?:\n|\r\n|\r|\z))/g ) {
          my $line = $1;
          unless (length $line) {
              $self->{input} = '';
              return;
          }
          return $line;
      }
      return;
  }
  
  package YAML::PP::Reader::File;
  
  use Scalar::Util qw/ openhandle /;
  
  our @ISA = qw/ YAML::PP::Reader /;
  
  use Carp qw/ croak /;
  
  sub open_handle {
      if (openhandle( $_[0]->{input} )) {
          return $_[0]->{input};
      }
      open my $fh, '<:encoding(UTF-8)', $_[0]->{input}
          or croak "Could not open '$_[0]->{input}' for reading: $!";
      return $fh;
  }
  
  sub read {
      my $fh = $_[0]->{filehandle} ||= $_[0]->open_handle;
      if (wantarray) {
          my @yaml = <$fh>;
          return @yaml;
      }
      else {
          local $/;
          my $yaml = <$fh>;
          return $yaml;
      }
  }
  
  sub readline {
      my $fh = $_[0]->{filehandle} ||= $_[0]->open_handle;
      return scalar <$fh>;
  }
  
  1;
YAML_PP_READER

$fatpacked{"YAML/PP/Render.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'YAML_PP_RENDER';
  # ABSTRACT: YAML::PP Rendering functions
  use strict;
  use warnings;
  package YAML::PP::Render;
  
  our $VERSION = '0.027'; # VERSION
  
  use constant TRACE => $ENV{YAML_PP_TRACE} ? 1 : 0;
  
  sub render_quoted {
      my ($self, $style, $lines) = @_;
  
      my $quoted = '';
      my $addspace = 0;
  
      for my $i (0 .. $#$lines) {
          my $line = $lines->[ $i ];
          my $value = $line->{value};
          my $last = $i == $#$lines;
          my $first = $i == 0;
          if ($value eq '') {
              if ($first) {
                  $addspace = 1;
              }
              elsif ($last) {
                  $quoted .= ' ' if $addspace;
              }
              else {
                  $addspace = 0;
                  $quoted .= "\n";
              }
              next;
          }
  
          $quoted .= ' ' if $addspace;
          $addspace = 1;
          if ($style eq '"') {
              if ($line->{orig} =~ m/\\$/) {
                  $line->{value} =~ s/\\$//;
                  $value =~ s/\\$//;
                  $addspace = 0;
              }
          }
          $quoted .= $value;
      }
      return $quoted;
  }
  
  sub render_block_scalar {
      my ($self, $block_type, $chomp, $lines) = @_;
  
      my ($folded, $keep, $trim);
      if ($block_type eq '>') {
          $folded = 1;
      }
      if ($chomp eq '+') {
          $keep = 1;
      }
      elsif ($chomp eq '-') {
          $trim = 1;
      }
  
      my $string = '';
      if (not $keep) {
          # remove trailing empty lines
          while (@$lines) {
              last if $lines->[-1] ne '';
              pop @$lines;
          }
      }
      if ($folded) {
  
          my $prev = 'START';
          for my $i (0 .. $#$lines) {
              my $line = $lines->[ $i ];
  
              my $type = $line eq ''
                  ? 'EMPTY'
                  : $line =~ m/\A[ \t]/
                      ? 'MORE'
                      : 'CONTENT';
  
              if ($prev eq 'MORE' and $type eq 'EMPTY') {
                  $type = 'MORE';
              }
              elsif ($prev eq 'CONTENT') {
                  if ($type ne 'CONTENT') {
                      $string .= "\n";
                  }
                  elsif ($type eq 'CONTENT') {
                      $string .= ' ';
                  }
              }
              elsif ($prev eq 'START' and $type eq 'EMPTY') {
                  $string .= "\n";
                  $type = 'START';
              }
              elsif ($prev eq 'EMPTY' and $type ne 'CONTENT') {
                  $string .= "\n";
              }
  
              $string .= $line;
  
              if ($type eq 'MORE' and $i < $#$lines) {
                  $string .= "\n";
              }
  
              $prev = $type;
          }
          $string .= "\n" if @$lines and not $trim;
      }
      else {
          for my $i (0 .. $#$lines) {
              $string .= $lines->[ $i ];
              $string .= "\n" if ($i != $#$lines or not $trim);
          }
      }
      TRACE and warn __PACKAGE__.':'.__LINE__.$".Data::Dumper->Dump([\$string], ['string']);
      return $string;
  }
  
  sub render_multi_val {
      my ($self, $multi) = @_;
      my $string = '';
      my $start = 1;
      for my $line (@$multi) {
          if (not $start) {
              if ($line eq '') {
                  $string .= "\n";
                  $start = 1;
              }
              else {
                  $string .= " $line";
              }
          }
          else {
              $string .= $line;
              $start = 0;
          }
      }
      return $string;
  }
  
  
  1;
YAML_PP_RENDER

$fatpacked{"YAML/PP/Representer.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'YAML_PP_REPRESENTER';
  use strict;
  use warnings;
  package YAML::PP::Representer;
  
  our $VERSION = '0.027'; # VERSION
  
  use Scalar::Util qw/ reftype blessed refaddr /;
  
  use YAML::PP::Common qw/
      YAML_PLAIN_SCALAR_STYLE YAML_SINGLE_QUOTED_SCALAR_STYLE
      YAML_DOUBLE_QUOTED_SCALAR_STYLE
      YAML_ANY_SCALAR_STYLE
      YAML_LITERAL_SCALAR_STYLE YAML_FOLDED_SCALAR_STYLE
      YAML_FLOW_SEQUENCE_STYLE YAML_FLOW_MAPPING_STYLE
      YAML_BLOCK_MAPPING_STYLE YAML_BLOCK_SEQUENCE_STYLE
      PRESERVE_ORDER PRESERVE_SCALAR_STYLE PRESERVE_FLOW_STYLE PRESERVE_ALIAS
  /;
  use B;
  
  sub new {
      my ($class, %args) = @_;
      my $preserve = delete $args{preserve} || 0;
      if ($preserve == 1) {
          $preserve = PRESERVE_ORDER | PRESERVE_SCALAR_STYLE | PRESERVE_FLOW_STYLE | PRESERVE_ALIAS;
      }
      my $self = bless {
          schema => delete $args{schema},
          preserve => $preserve,
      }, $class;
      if (keys %args) {
          die "Unexpected arguments: " . join ', ', sort keys %args;
      }
      return $self;
  }
  
  sub clone {
      my ($self) = @_;
      my $clone = {
          schema => $self->schema,
          preserve => $self->{preserve},
      };
      return bless $clone, ref $self;
  }
  
  sub schema { return $_[0]->{schema} }
  sub preserve_order { return $_[0]->{preserve} & PRESERVE_ORDER }
  sub preserve_scalar_style { return $_[0]->{preserve} & PRESERVE_SCALAR_STYLE }
  sub preserve_flow_style { return $_[0]->{preserve} & PRESERVE_FLOW_STYLE }
  sub preserve_alias { return $_[0]->{preserve} & PRESERVE_ALIAS }
  
  sub represent_node {
      my ($self, $node) = @_;
  
      my $preserve_alias = $self->preserve_alias;
      my $preserve_style = $self->preserve_scalar_style;
      if ($preserve_style or $preserve_alias) {
          if (ref $node->{value} eq 'YAML::PP::Preserve::Scalar') {
              my $value = $node->{value}->value;
              if ($preserve_style and $node->{value}->style != YAML_FOLDED_SCALAR_STYLE) {
                  $node->{style} = $node->{value}->style;
              }
  #            $node->{tag} = $node->{value}->tag;
              $node->{value} = $value;
          }
      }
      $node->{reftype} = reftype($node->{value});
      if (not $node->{reftype} and reftype(\$node->{value}) eq 'GLOB') {
          $node->{reftype} = 'GLOB';
      }
  
      if ($node->{reftype}) {
          $self->represent_noderef($node);
      }
      else {
          $self->represent_node_nonref($node);
      }
      $node->{reftype} = (reftype $node->{data}) || '';
  
      if ($node->{reftype} eq 'HASH' and my $tied = tied(%{ $node->{data} })) {
          my $representers = $self->schema->representers;
          $tied = ref $tied;
          if (my $def = $representers->{tied_equals}->{ $tied }) {
              my $code = $def->{code};
              my $done = $code->($self, $node);
          }
      }
  
      if ($node->{reftype} eq 'HASH') {
          unless (defined $node->{items}) {
              # by default we sort hash keys
              my @keys;
              if ($self->preserve_order) {
                  @keys = keys %{ $node->{data} };
              }
              else {
                  @keys = sort keys %{ $node->{data} };
              }
              for my $key (@keys) {
                  push @{ $node->{items} }, $key, $node->{data}->{ $key };
              }
          }
          my %args;
          if ($self->preserve_flow_style and reftype $node->{value} eq 'HASH') {
              if (my $tied = tied %{ $node->{value} } ) {
                  $args{style} = $tied->{style};
              }
          }
          return [ mapping => $node, %args ];
      }
      elsif ($node->{reftype} eq 'ARRAY') {
          unless (defined $node->{items}) {
              @{ $node->{items} } = @{ $node->{data} };
          }
          my %args;
          if ($self->preserve_flow_style and reftype $node->{value} eq 'ARRAY') {
              if (my $tied = tied @{ $node->{value} } ) {
                  $args{style} = $tied->{style};
              }
          }
          return [ sequence => $node, %args ];
      }
      elsif ($node->{reftype}) {
          die "Cannot handle reftype '$node->{reftype}' (you might want to enable YAML::PP::Schema::Perl)";
      }
      else {
          unless (defined $node->{items}) {
              $node->{items} = [$node->{data}];
          }
          return [ scalar => $node ];
      }
  
  }
  
  sub represent_node_nonref {
      my ($self, $node) = @_;
      my $representers = $self->schema->representers;
  
      if (not defined $node->{value}) {
          if (my $undef = $representers->{undef}) {
              return 1 if $undef->($self, $node);
          }
          else {
              $node->{style} = YAML_SINGLE_QUOTED_SCALAR_STYLE;
              $node->{data} = '';
              return 1;
          }
      }
      for my $rep (@{ $representers->{flags} }) {
          my $check_flags = $rep->{flags};
          my $flags = B::svref_2object(\$node->{value})->FLAGS;
          if ($flags & $check_flags) {
              return 1 if $rep->{code}->($self, $node);
          }
  
      }
      if (my $rep = $representers->{equals}->{ $node->{value} }) {
          return 1 if $rep->{code}->($self, $node);
      }
      for my $rep (@{ $representers->{regex} }) {
          if ($node->{value} =~ $rep->{regex}) {
              return 1 if $rep->{code}->($self, $node);
          }
      }
      unless (defined $node->{data}) {
          $node->{data} = $node->{value};
      }
      unless (defined $node->{style}) {
          $node->{style} = YAML_ANY_SCALAR_STYLE;
          $node->{style} = "";
      }
  }
  
  sub represent_noderef {
      my ($self, $node) = @_;
      my $representers = $self->schema->representers;
  
      if (my $classname = blessed($node->{value})) {
          if (my $def = $representers->{class_equals}->{ $classname }) {
              my $code = $def->{code};
              return 1 if $code->($self, $node);
          }
          for my $matches (@{ $representers->{class_matches} }) {
              my ($re, $code) = @$matches;
              if (ref $re and $classname =~ $re or $re) {
                  return 1 if $code->($self, $node);
              }
          }
          for my $isa (@{ $representers->{class_isa} }) {
              my ($class_name, $code) = @$isa;
              if ($node->{ value }->isa($class_name)) {
                  return 1 if $code->($self, $node);
              }
          }
      }
      if ($node->{reftype} eq 'SCALAR' and my $scalarref = $representers->{scalarref}) {
          my $code = $scalarref->{code};
          return 1 if $code->($self, $node);
      }
      if ($node->{reftype} eq 'REF' and my $refref = $representers->{refref}) {
          my $code = $refref->{code};
          return 1 if $code->($self, $node);
      }
      if ($node->{reftype} eq 'CODE' and my $coderef = $representers->{coderef}) {
          my $code = $coderef->{code};
          return 1 if $code->($self, $node);
      }
      if ($node->{reftype} eq 'GLOB' and my $glob = $representers->{glob}) {
          my $code = $glob->{code};
          return 1 if $code->($self, $node);
      }
      $node->{data} = $node->{value};
  
  }
  
  1;
YAML_PP_REPRESENTER

$fatpacked{"YAML/PP/Schema.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'YAML_PP_SCHEMA';
  use strict;
  use warnings;
  package YAML::PP::Schema;
  use B;
  use Module::Load qw//;
  
  our $VERSION = '0.027'; # VERSION
  
  use YAML::PP::Common qw/ YAML_PLAIN_SCALAR_STYLE /;
  
  use Scalar::Util qw/ blessed /;
  
  sub new {
      my ($class, %args) = @_;
  
      my $yaml_version = delete $args{yaml_version};
      my $bool = delete $args{boolean};
      $bool = 'perl' unless defined $bool;
      if (keys %args) {
          die "Unexpected arguments: " . join ', ', sort keys %args;
      }
      my $true;
      my $false;
      my $bool_class = '';
      if ($bool eq 'JSON::PP') {
          require JSON::PP;
          $true = \&bool_jsonpp_true;
          $false = \&bool_jsonpp_false;
          $bool_class = 'JSON::PP::Boolean';
      }
      elsif ($bool eq 'boolean') {
          require boolean;
          $true = \&bool_booleanpm_true;
          $false = \&bool_booleanpm_false;
          $bool_class = 'boolean';
      }
      elsif ($bool eq 'perl') {
          $true = \&bool_perl_true;
          $false = \&bool_perl_false;
      }
      else {
          die "Invalid value for 'boolean': '$bool'. Allowed: ('perl', 'boolean', 'JSON::PP')";
      }
  
      my %representers = (
          'undef' => undef,
          flags => [],
          equals => {},
          regex => [],
          class_equals => {},
          class_matches => [],
          class_isa => [],
          scalarref => undef,
          refref => undef,
          coderef => undef,
          glob => undef,
          tied_equals => {},
      );
      my $self = bless {
          yaml_version => $yaml_version,
          resolvers => {},
          representers => \%representers,
          true => $true,
          false => $false,
          bool_class => $bool_class,
      }, $class;
      return $self;
  }
  
  sub resolvers { return $_[0]->{resolvers} }
  sub representers { return $_[0]->{representers} }
  
  sub true { return $_[0]->{true} }
  sub false { return $_[0]->{false} }
  sub bool_class { return $_[0]->{bool_class} }
  sub yaml_version { return $_[0]->{yaml_version} }
  
  my %LOADED_SCHEMA = (
      JSON => 1,
  );
  my %DEFAULT_SCHEMA = (
      '1.2' => 'Core',
      '1.1' => 'YAML1_1',
  );
  
  sub load_subschemas {
      my ($self, @schemas) = @_;
      my $yaml_version = $self->yaml_version;
      my $i = 0;
      while ($i < @schemas) {
          my $item = $schemas[ $i ];
          if ($item eq '+') {
              $item = $DEFAULT_SCHEMA{ $yaml_version };
          }
          $i++;
          if (blessed($item)) {
              $item->register(
                  schema => $self,
              );
              next;
          }
          my @options;
          while ($i < @schemas
              and (
                  $schemas[ $i ] =~ m/^[^A-Za-z]/
                  or
                  $schemas[ $i ] =~ m/^[a-zA-Z0-9]+=/
                  )
              ) {
              push @options, $schemas[ $i ];
              $i++;
          }
  
          my $class;
          if ($item =~ m/^\:(.*)/) {
              $class = "$1";
              unless ($class =~ m/\A[A-Za-z0-9_:]+\z/) {
                  die "Module name '$class' is invalid";
              }
              Module::Load::load $class;
          }
          else {
              $class = "YAML::PP::Schema::$item";
              unless ($class =~ m/\A[A-Za-z0-9_:]+\z/) {
                  die "Module name '$class' is invalid";
              }
              $LOADED_SCHEMA{ $item } ||= Module::Load::load $class;
          }
          $class->register(
              schema => $self,
              options => \@options,
          );
  
      }
  }
  
  sub add_resolver {
      my ($self, %args) = @_;
      my $tag = $args{tag};
      my $rule = $args{match};
      my $resolvers = $self->resolvers;
      my ($type, @rule) = @$rule;
      my $implicit = $args{implicit};
      $implicit = 1 unless defined $implicit;
      my $resolver_list = [];
      if ($tag) {
          if (ref $tag eq 'Regexp') {
              my $res = $resolvers->{tags} ||= [];
              push @$res, [ $tag, {} ];
              push @$resolver_list, $res->[-1]->[1];
          }
          else {
              my $res = $resolvers->{tag}->{ $tag } ||= {};
              push @$resolver_list, $res;
          }
      }
      if ($implicit) {
          push @$resolver_list, $resolvers->{value} ||= {};
      }
      for my $res (@$resolver_list) {
          if ($type eq 'equals') {
              my ($match, $value) = @rule;
              unless (exists $res->{equals}->{ $match }) {
                  $res->{equals}->{ $match } = $value;
              }
              next;
          }
          elsif ($type eq 'regex') {
              my ($match, $value) = @rule;
              push @{ $res->{regex} }, [ $match => $value ];
          }
          elsif ($type eq 'all') {
              my ($value) = @rule;
              $res->{all} = $value;
          }
      }
  }
  
  sub add_sequence_resolver {
      my ($self, %args) = @_;
      return $self->add_collection_resolver(sequence => %args);
  }
  
  sub add_mapping_resolver {
      my ($self, %args) = @_;
      return $self->add_collection_resolver(mapping => %args);
  }
  
  sub add_collection_resolver {
      my ($self, $type, %args) = @_;
      my $tag = $args{tag};
      my $implicit = $args{implicit};
      my $resolvers = $self->resolvers;
  
      if ($tag and ref $tag eq 'Regexp') {
          my $res = $resolvers->{ $type }->{tags} ||= [];
          push @$res, [ $tag, {
              on_create => $args{on_create},
              on_data => $args{on_data},
          } ];
      }
      elsif ($tag) {
          my $res = $resolvers->{ $type }->{tag}->{ $tag } ||= {
              on_create => $args{on_create},
              on_data => $args{on_data},
          };
      }
  }
  
  sub add_representer {
      my ($self, %args) = @_;
  
      my $representers = $self->representers;
      if (my $flags = $args{flags}) {
          my $rep = $representers->{flags};
          push @$rep, \%args;
          return;
      }
      if (my $regex = $args{regex}) {
          my $rep = $representers->{regex};
          push @$rep, \%args;
          return;
      }
      if (my $regex = $args{class_matches}) {
          my $rep = $representers->{class_matches};
          push @$rep, [ $args{class_matches}, $args{code} ];
          return;
      }
      if (my $class_equals = $args{class_equals}) {
          my $rep = $representers->{class_equals};
          $rep->{ $class_equals } = {
              code => $args{code},
          };
          return;
      }
      if (my $class_isa = $args{class_isa}) {
          my $rep = $representers->{class_isa};
          push @$rep, [ $args{class_isa}, $args{code} ];
          return;
      }
      if (my $tied_equals = $args{tied_equals}) {
          my $rep = $representers->{tied_equals};
          $rep->{ $tied_equals } = {
              code => $args{code},
          };
          return;
      }
      if (defined(my $equals = $args{equals})) {
          my $rep = $representers->{equals};
          $rep->{ $equals } = {
              code => $args{code},
          };
          return;
      }
      if (defined(my $scalarref = $args{scalarref})) {
          $representers->{scalarref} = {
              code => $args{code},
          };
          return;
      }
      if (defined(my $refref = $args{refref})) {
          $representers->{refref} = {
              code => $args{code},
          };
          return;
      }
      if (defined(my $coderef = $args{coderef})) {
          $representers->{coderef} = {
              code => $args{code},
          };
          return;
      }
      if (defined(my $glob = $args{glob})) {
          $representers->{glob} = {
              code => $args{code},
          };
          return;
      }
      if (my $undef = $args{undefined}) {
          $representers->{undef} = $undef;
          return;
      }
  }
  
  sub load_scalar {
      my ($self, $constructor, $event) = @_;
      my $tag = $event->{tag};
      my $value = $event->{value};
  
      my $resolvers = $self->resolvers;
      my $res;
      if ($tag) {
          $res = $resolvers->{tag}->{ $tag };
          if (not $res and my $matches = $resolvers->{tags}) {
              for my $match (@$matches) {
                  my ($re, $rule) = @$match;
                  if ($tag =~ $re) {
                      $res = $rule;
                      last;
                  }
              }
          }
      }
      else {
          $res = $resolvers->{value};
          if ($event->{style} ne YAML_PLAIN_SCALAR_STYLE) {
              return $value;
          }
      }
  
      if (my $equals = $res->{equals}) {
          if (exists $equals->{ $value }) {
              my $res = $equals->{ $value };
              if (ref $res eq 'CODE') {
                  return $res->($constructor, $event);
              }
              return $res;
          }
      }
      if (my $regex = $res->{regex}) {
          for my $item (@$regex) {
              my ($re, $sub) = @$item;
              my @matches = $value =~ $re;
              if (@matches) {
                  return $sub->($constructor, $event, \@matches);
              }
          }
      }
      if (my $catch_all = $res->{all}) {
          if (ref $catch_all eq 'CODE') {
              return $catch_all->($constructor, $event);
          }
          return $catch_all;
      }
      return $value;
  }
  
  sub create_sequence {
      my ($self, $constructor, $event) = @_;
      my $tag = $event->{tag};
      my $data = [];
      my $on_data;
  
      my $resolvers = $self->resolvers->{sequence};
      if ($tag) {
          if (my $equals = $resolvers->{tag}->{ $tag }) {
              my $on_create = $equals->{on_create};
              $on_data = $equals->{on_data};
              $on_create and $data = $on_create->($constructor, $event);
              return ($data, $on_data);
          }
          if (my $matches = $resolvers->{tags}) {
              for my $match (@$matches) {
                  my ($re, $actions) = @$match;
                  my $on_create = $actions->{on_create};
                  if ($tag =~ $re) {
                      $on_data = $actions->{on_data};
                      $on_create and $data = $on_create->($constructor, $event);
                      return ($data, $on_data);
                  }
              }
          }
      }
  
      return ($data, $on_data);
  }
  
  sub create_mapping {
      my ($self, $constructor, $event) = @_;
      my $tag = $event->{tag};
      my $data = {};
      my $on_data;
  
      my $resolvers = $self->resolvers->{mapping};
      if ($tag) {
          if (my $equals = $resolvers->{tag}->{ $tag }) {
              my $on_create = $equals->{on_create};
              $on_data = $equals->{on_data};
              $on_create and $data = $on_create->($constructor, $event);
              return ($data, $on_data);
          }
          if (my $matches = $resolvers->{tags}) {
              for my $match (@$matches) {
                  my ($re, $actions) = @$match;
                  my $on_create = $actions->{on_create};
                  if ($tag =~ $re) {
                      $on_data = $actions->{on_data};
                      $on_create and $data = $on_create->($constructor, $event);
                      return ($data, $on_data);
                  }
              }
          }
      }
  
      return ($data, $on_data);
  }
  
  sub bool_jsonpp_true { JSON::PP::true() }
  
  sub bool_booleanpm_true { boolean::true() }
  
  sub bool_perl_true { 1 }
  
  sub bool_jsonpp_false { JSON::PP::false() }
  
  sub bool_booleanpm_false { boolean::false() }
  
  sub bool_perl_false { !1 }
  
  1;
  
  __END__
  
  =pod
  
  =encoding utf-8
  
  =head1 NAME
  
  YAML::PP::Schema - Schema for YAML::PP
  
  
YAML_PP_SCHEMA

$fatpacked{"YAML/PP/Schema/Binary.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'YAML_PP_SCHEMA_BINARY';
  use strict;
  use warnings;
  package YAML::PP::Schema::Binary;
  
  our $VERSION = '0.027'; # VERSION
  
  use MIME::Base64 qw/ decode_base64 encode_base64 /;
  use YAML::PP::Common qw/ YAML_ANY_SCALAR_STYLE /;
  
  sub register {
      my ($self, %args) = @_;
      my $schema = $args{schema};
  
      $schema->add_resolver(
          tag => 'tag:yaml.org,2002:binary',
          match => [ all => sub {
              my ($constructor, $event) = @_;
              my $base64 = $event->{value};
              my $binary = decode_base64($base64);
              return $binary;
          }],
          implicit => 0,
      );
  
      $schema->add_representer(
          regex => qr{.*},
          code => sub {
              my ($rep, $node) = @_;
              my $binary = $node->{value};
              unless ($binary =~ m/[\x{7F}-\x{10FFFF}]/) {
                  # ASCII
                  return;
              }
              if (utf8::is_utf8($binary)) {
                  # utf8
                  return;
              }
              # everything else must be base64 encoded
              my $base64 = encode_base64($binary);
              $node->{style} = YAML_ANY_SCALAR_STYLE;
              $node->{data} = $base64;
              $node->{tag} = "tag:yaml.org,2002:binary";
              return 1;
          },
      );
  }
  
  1;
  
  __END__
  
  =pod
  
  =encoding utf-8
  
  =head1 NAME
  
  YAML::PP::Schema::Binary - Schema for loading and binary data
  
  =head1 SYNOPSIS
  
      use YAML::PP;
      my $yp = YAML::PP->new( schema => [qw/ + Binary /] );
      # or
  
      my ($binary, $same_binary) = $yp->load_string(<<'EOM');
      --- !!binary "\
        R0lGODlhDAAMAIQAAP//9/X17unp5WZmZgAAAOfn515eXvPz7Y6OjuDg4J+fn5\
        OTk6enp56enmlpaWNjY6Ojo4SEhP/++f/++f/++f/++f/++f/++f/++f/++f/+\
        +f/++f/++f/++f/++f/++SH+Dk1hZGUgd2l0aCBHSU1QACwAAAAADAAMAAAFLC\
        AgjoEwnuNAFOhpEMTRiggcz4BNJHrv/zCFcLiwMWYNG84BwwEeECcgggoBADs="
      --- !!binary |
        R0lGODlhDAAMAIQAAP//9/X17unp5WZmZgAAAOfn515eXvPz7Y6OjuDg4J+fn5
        OTk6enp56enmlpaWNjY6Ojo4SEhP/++f/++f/++f/++f/++f/++f/++f/++f/+
        +f/++f/++f/++f/++f/++SH+Dk1hZGUgd2l0aCBHSU1QACwAAAAADAAMAAAFLC
        AgjoEwnuNAFOhpEMTRiggcz4BNJHrv/zCFcLiwMWYNG84BwwEeECcgggoBADs=
      # The binary value above is a tiny arrow encoded as a gif image.
      EOM
  
  =head1 DESCRIPTION
  
  See <https://yaml.org/type/binary.html>
  
  By prepending a base64 encoded binary string with the C<!!binary> tag, it can
  be automatically decoded when loading.
  
  Note that the logic for dumping is probably broken, see
  L<https://github.com/perlpunk/YAML-PP-p5/issues/28>.
  
  Suggestions welcome.
  
  =head1 METHODS
  
  =over
  
  =item register
  
  Called by L<YAML::PP::Schema>
  
  =back
  
  =cut
YAML_PP_SCHEMA_BINARY

$fatpacked{"YAML/PP/Schema/Core.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'YAML_PP_SCHEMA_CORE';
  use strict;
  use warnings;
  package YAML::PP::Schema::Core;
  
  our $VERSION = '0.027'; # VERSION
  
  use YAML::PP::Schema::JSON qw/
      represent_int represent_float represent_literal represent_bool
      represent_undef
  /;
  
  use B;
  
  use YAML::PP::Common qw/ YAML_PLAIN_SCALAR_STYLE /;
  
  my $RE_INT_CORE = qr{^([+-]?(?:[0-9]+))$};
  my $RE_FLOAT_CORE = qr{^([+-]?(?:\.[0-9]+|[0-9]+(?:\.[0-9]*)?)(?:[eE][+-]?[0-9]+)?)$};
  my $RE_INT_OCTAL = qr{^0o([0-7]+)$};
  my $RE_INT_HEX = qr{^0x([0-9a-fA-F]+)$};
  
  sub _from_oct { oct $_[2]->[0] }
  sub _from_hex { hex $_[2]->[0] }
  
  sub register {
      my ($self, %args) = @_;
      my $schema = $args{schema};
  
      $schema->add_resolver(
          tag => 'tag:yaml.org,2002:null',
          match => [ equals => $_ => undef ],
      ) for (qw/ null NULL Null ~ /, '');
      $schema->add_resolver(
          tag => 'tag:yaml.org,2002:bool',
          match => [ equals => $_ => $schema->true ],
      ) for (qw/ true TRUE True /);
      $schema->add_resolver(
          tag => 'tag:yaml.org,2002:bool',
          match => [ equals => $_ => $schema->false ],
      ) for (qw/ false FALSE False /);
      $schema->add_resolver(
          tag => 'tag:yaml.org,2002:int',
          match => [ regex => $RE_INT_CORE => \&YAML::PP::Schema::JSON::_to_int ],
      );
      $schema->add_resolver(
          tag => 'tag:yaml.org,2002:int',
          match => [ regex => $RE_INT_OCTAL => \&_from_oct ],
      );
      $schema->add_resolver(
          tag => 'tag:yaml.org,2002:int',
          match => [ regex => $RE_INT_HEX => \&_from_hex ],
      );
      $schema->add_resolver(
          tag => 'tag:yaml.org,2002:float',
          match => [ regex => $RE_FLOAT_CORE => \&YAML::PP::Schema::JSON::_to_float ],
      );
      $schema->add_resolver(
          tag => 'tag:yaml.org,2002:float',
          match => [ equals => $_ => 0 + "inf" ],
      ) for (qw/ .inf .Inf .INF +.inf +.Inf +.INF /);
      $schema->add_resolver(
          tag => 'tag:yaml.org,2002:float',
          match => [ equals => $_ => 0 - "inf" ],
      ) for (qw/ -.inf -.Inf -.INF /);
      $schema->add_resolver(
          tag => 'tag:yaml.org,2002:float',
          match => [ equals => $_ => 0 + "nan" ],
      ) for (qw/ .nan .NaN .NAN /);
      $schema->add_resolver(
          tag => 'tag:yaml.org,2002:str',
          match => [ all => sub { $_[1]->{value} } ],
      );
  
      my $int_flags = B::SVp_IOK;
      my $float_flags = B::SVp_NOK;
      $schema->add_representer(
          flags => $int_flags,
          code => \&represent_int,
      );
      $schema->add_representer(
          flags => $float_flags,
          code => \&represent_float,
      );
      $schema->add_representer(
          undefined => \&represent_undef,
      );
      $schema->add_representer(
          equals => $_,
          code => \&represent_literal,
      ) for ("", qw/
          true TRUE True false FALSE False null NULL Null ~
          .inf .Inf .INF +.inf +.Inf +.INF -.inf -.Inf -.INF .nan .NaN .NAN
      /);
      $schema->add_representer(
          regex => qr{$RE_INT_CORE|$RE_FLOAT_CORE|$RE_INT_OCTAL|$RE_INT_HEX},
          code => \&represent_literal,
      );
  
      if ($schema->bool_class) {
          $schema->add_representer(
              class_equals => $schema->bool_class,
              code => \&represent_bool,
          );
      }
  
      return;
  }
  
  1;
  
  __END__
  
  =pod
  
  =encoding utf-8
  
  =head1 NAME
  
  YAML::PP::Schema::Core - YAML 1.2 Core Schema
  
  =head1 SYNOPSIS
  
      my $yp = YAML::PP->new( schema => ['Core'] );
  
  =head1 DESCRIPTION
  
  This schema is the official recommended Core Schema for YAML 1.2.
  It loads additional values to the JSON schema as special types, for
  example C<TRUE> and C<True> additional to C<true>.
  
  Official Schema:
  L<https://yaml.org/spec/1.2/spec.html#id2804923>
  
  Here you can see all Schemas and examples implemented by YAML::PP:
  L<https://perlpunk.github.io/YAML-PP-p5/schemas.html>
  
  =head1 METHODS
  
  =over
  
  =item register
  
  Called by YAML::PP::Schema
  
  =back
  
  =cut
YAML_PP_SCHEMA_CORE

$fatpacked{"YAML/PP/Schema/Failsafe.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'YAML_PP_SCHEMA_FAILSAFE';
  use strict;
  use warnings;
  package YAML::PP::Schema::Failsafe;
  
  our $VERSION = '0.027'; # VERSION
  
  sub register {
      my ($self, %args) = @_;
  
      return;
  }
  
  1;
  
  __END__
  
  =pod
  
  =encoding utf-8
  
  =head1 NAME
  
  YAML::PP::Schema::Failsafe - YAML 1.2 Failsafe Schema
  
  =head1 SYNOPSIS
  
      my $yp = YAML::PP->new( schema => ['Failsafe'] );
  
  =head1 DESCRIPTION
  
  With this schema, everything will be treated as a string. There are no booleans,
  integers, floats or undefined values.
  
  Here you can see all Schemas and examples implemented by YAML::PP:
  L<https://perlpunk.github.io/YAML-PP-p5/schemas.html>
  
  Official Schema: L<https://yaml.org/spec/1.2/spec.html#id2802346>
  
  =head1 METHODS
  
  =over
  
  =item register
  
  Called by YAML::PP::Schema
  
  =back
  
  =cut
YAML_PP_SCHEMA_FAILSAFE

$fatpacked{"YAML/PP/Schema/Include.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'YAML_PP_SCHEMA_INCLUDE';
  use strict;
  use warnings;
  package YAML::PP::Schema::Include;
  
  our $VERSION = '0.027'; # VERSION
  
  use Carp qw/ croak /;
  use Scalar::Util qw/ weaken /;
  use File::Basename qw/ dirname /;
  
  sub new {
      my ($class, %args) = @_;
  
      my $paths = delete $args{paths};
      if (defined $paths) {
          unless (ref $paths eq 'ARRAY') {
              $paths = [$paths];
          }
      }
      else {
          $paths = [];
      }
      my $allow_absolute = $args{allow_absolute} || 0;
      my $loader = $args{loader} || \&default_loader;
  
      my $self = bless {
          paths => $paths,
          allow_absolute => $allow_absolute,
          last_includes => [],
          cached => {},
          loader => $loader,
      }, $class;
      return $self;
  }
  
  sub init {
      my ($self) = @_;
      $self->{last_includes} = [];
      $self->{cached} = [];
  }
  
  sub paths { $_[0]->{paths} }
  sub allow_absolute { $_[0]->{allow_absolute} }
  sub yp {
      my ($self, $yp) = @_;
      if (@_ == 2) {
          $self->{yp} = $yp;
          weaken $self->{yp};
          return $yp;
      }
      return $self->{yp};
  }
  
  sub register {
      my ($self, %args) = @_;
      my $schema = $args{schema};
  
      $schema->add_resolver(
          tag => '!include',
          match => [ all => sub { $self->include(@_) } ],
          implicit => 0,
      );
  }
  
  sub include {
      my ($self, $constructor, $event) = @_;
      my $yp = $self->yp;
      my $search_paths = $self->paths;
      my $allow_absolute = $self->allow_absolute;
  
      my $relative = not @$search_paths;
      if ($relative) {
          my $last_includes = $self->{last_includes};
          if (@$last_includes) {
              $search_paths = [ $last_includes->[-1] ];
          }
          else {
              # we are in the top-level file and need to look into
              # the original YAML::PP instance
              my $filename = $yp->loader->filename;
              $search_paths = [dirname $filename];
          }
      }
      my $filename = $event->{value};
  
      my $fullpath;
      if (File::Spec->file_name_is_absolute($filename)) {
          unless ($allow_absolute) {
              croak "Absolute filenames not allowed";
          }
          $fullpath = $filename;
      }
      else {
          my @paths = File::Spec->splitdir($filename);
          unless ($allow_absolute) {
              # if absolute paths are not allowed, we also may not use upwards ..
              @paths = File::Spec->no_upwards(@paths);
          }
          for my $candidate (@$search_paths) {
              my $test = File::Spec->catfile( $candidate, @paths );
              if (-e $test) {
                  $fullpath = $test;
                  last;
              }
          }
          croak "File '$filename' not found" unless defined $fullpath;
      }
  
      if ($self->{cached}->{ $fullpath }++) {
          croak "Circular include '$fullpath'";
      }
      if ($relative) {
          push @{ $self->{last_includes} }, dirname $fullpath;
      }
  
      # We need a new object because we are still in the parsing and
      # constructing process
      my $clone = $yp->clone;
      my ($data) = $self->loader->($clone, $fullpath);
  
      if ($relative) {
          pop @{ $self->{last_includes} };
      }
      unless (--$self->{cached}->{ $fullpath }) {
          delete $self->{cached}->{ $fullpath };
      }
      return $data;
  }
  
  sub loader {
      my ($self, $code) = @_;
      if (@_ == 2) {
          $self->{loader} = $code;
          return $code;
      }
      return $self->{loader};
  }
  sub default_loader {
      my ($yp, $filename) = @_;
      $yp->load_file($filename);
  }
  
  1;
  
  __END__
  
  =pod
  
  =encoding utf-8
  
  =head1 NAME
  
  YAML::PP::Schema::Include - Include YAML files
  
  =head1 SYNOPSIS
  
      # /path/to/file.yaml
      # ---
      # included: !include include/file2.yaml
  
      # /path/to/include/file2.yaml
      # ---
      # a: b
  
      my $include = YAML::PP::Schema::Include->new;
  
      my $yp = YAML::PP->new( schema => ['JSON', $include] );
      # we need the original YAML::PP object for getting the current filename
      # and for loading another file
      $include->yp($yp);
  
      my ($data) = $yp->load_file("/path/to/file.yaml");
  
      # The result will be:
      $data = {
          included => { a => 'b' }
      };
  
  Allow absolute filenames and upwards C<'..'>:
  
      my $include = YAML::PP::Schema::Include->new(
          allow_absolute => 1, # default: 0
      );
  
  Specify paths to search for includes:
  
      my @include_paths = ("/path/to/include/yaml/1", "/path/to/include/yaml/2");
      my $include = YAML::PP::Schema::Include->new(
          paths => \@include_paths,
      );
      my $yp = YAML::PP->new( schema => ['JSON', $include] );
      $include->yp($yp);
  
      # /path/to/include/yaml/1/file1.yaml
      # ---
      # a: b
  
      my $yaml = <<'EOM';
      - included: !include file1.yaml
      EOM
      my ($data) = $yp->load_string($yaml);
  
  
  =head1 DESCRIPTION
  
  This plugin allows you to split a large YAML file into smaller ones.
  You can then include these files with the C<!include> tag.
  
  It will search for the specified filename relative to the currently processed
  filename.
  
  You can also specify the paths where to search for files to include. It iterates
  through the paths and returns the first filename that exists.
  
  By default, only relative paths are allowed. Any C<../> in the path will be
  removed. You can change that behaviour by setting the option C<allow_absolute>
  to true.
  
  If the included file contains more than one document, only the first one
  will be included.
  
  I will probably add a possibility to return all documents as an arrayref.
  
  The included YAML file will be loaded by creating a new L<YAML::PP> object
  with the schema from the existing object. This way you can recursively include
  files.
  
  You can even reuse the same include via an alias:
  
      ---
      invoice:
          shipping address: &address !include address.yaml
          billing address: *address
  
  Circular includes will be detected, and will be fatal.
  
  It's possible to specify what to do with the included file:
  
      my $include = YAML::PP::Schema::Include->new(
          loader => sub {
              my ($yp, $filename);
              if ($filename =~ m/\.txt$/) {
                  # open file and just return text
              }
              else {
                  # default behaviour
                  return $yp->load_file($filename);
              }
          },
      );
  
  For example, RAML defines an C<!include> tag which depends on the file
  content. If it contains a special RAML directive, it will be loaded as
  YAML, otherwise the content of the file will be included as a string.
  
  So with this plugin you are able to read RAML specifications.
  
  
  =cut
YAML_PP_SCHEMA_INCLUDE

$fatpacked{"YAML/PP/Schema/JSON.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'YAML_PP_SCHEMA_JSON';
  use strict;
  use warnings;
  package YAML::PP::Schema::JSON;
  
  our $VERSION = '0.027'; # VERSION
  
  use base 'Exporter';
  our @EXPORT_OK = qw/
      represent_int represent_float represent_literal represent_bool
      represent_undef
  /;
  
  use B;
  use Carp qw/ croak /;
  
  use YAML::PP::Common qw/ YAML_PLAIN_SCALAR_STYLE YAML_SINGLE_QUOTED_SCALAR_STYLE /;
  
  my $RE_INT = qr{^(-?(?:0|[1-9][0-9]*))$};
  my $RE_FLOAT = qr{^(-?(?:0|[1-9][0-9]*)(?:\.[0-9]*)?(?:[eE][+-]?[0-9]+)?)$};
  
  sub _to_int { 0 + $_[2]->[0] }
  
  # DaTa++ && shmem++
  sub _to_float { unpack F => pack F => $_[2]->[0] }
  
  sub register {
      my ($self, %args) = @_;
      my $schema = $args{schema};
      my $options = $args{options};
      my $empty_null = 0;
      for my $opt (@$options) {
          if ($opt eq 'empty=str') {
          }
          elsif ($opt eq 'empty=null') {
              $empty_null = 1;
          }
          else {
              croak "Invalid option for JSON Schema: '$opt'";
          }
      }
  
      $schema->add_resolver(
          tag => 'tag:yaml.org,2002:null',
          match => [ equals => null => undef ],
      );
      if ($empty_null) {
          $schema->add_resolver(
              tag => 'tag:yaml.org,2002:null',
              match => [ equals => '' => undef ],
              implicit => 1,
          );
      }
      else {
          $schema->add_resolver(
              tag => 'tag:yaml.org,2002:str',
              match => [ equals => '' => '' ],
              implicit => 1,
          );
      }
      $schema->add_resolver(
          tag => 'tag:yaml.org,2002:bool',
          match => [ equals => true => $schema->true ],
      );
      $schema->add_resolver(
          tag => 'tag:yaml.org,2002:bool',
          match => [ equals => false => $schema->false ],
      );
      $schema->add_resolver(
          tag => 'tag:yaml.org,2002:int',
          match => [ regex => $RE_INT => \&_to_int ],
      );
      $schema->add_resolver(
          tag => 'tag:yaml.org,2002:float',
          match => [ regex => $RE_FLOAT => \&_to_float ],
      );
      $schema->add_resolver(
          tag => 'tag:yaml.org,2002:str',
          match => [ all => sub { $_[1]->{value} } ],
      );
  
      $schema->add_representer(
          undefined => \&represent_undef,
      );
  
      my $int_flags = B::SVp_IOK;
      my $float_flags = B::SVp_NOK;
      $schema->add_representer(
          flags => $int_flags,
          code => \&represent_int,
      );
      my %special = ( (0+'nan').'' => '.nan', (0+'inf').'' => '.inf', (0-'inf').'' => '-.inf' );
      $schema->add_representer(
          flags => $float_flags,
          code => \&represent_float,
      );
      $schema->add_representer(
          equals => $_,
          code => \&represent_literal,
      ) for ("", qw/ true false null /);
      $schema->add_representer(
          regex => qr{$RE_INT|$RE_FLOAT},
          code => \&represent_literal,
      );
  
      if ($schema->bool_class) {
          $schema->add_representer(
              class_equals => $schema->bool_class,
              code => \&represent_bool,
          );
      }
  
      return;
  }
  
  sub represent_undef {
      my ($rep, $node) = @_;
      $node->{style} = YAML_PLAIN_SCALAR_STYLE;
      $node->{data} = 'null';
      return 1;
  }
  
  sub represent_literal {
      my ($rep, $node) = @_;
      $node->{style} ||= YAML_SINGLE_QUOTED_SCALAR_STYLE;
      $node->{data} = "$node->{value}";
      return 1;
  }
  
  
  sub represent_int {
      my ($rep, $node) = @_;
      if (int($node->{value}) ne $node->{value}) {
          return 0;
      }
      $node->{style} = YAML_PLAIN_SCALAR_STYLE;
      $node->{data} = "$node->{value}";
      return 1;
  }
  
  my %special = (
      (0+'nan').'' => '.nan',
      (0+'inf').'' => '.inf',
      (0-'inf').'' => '-.inf'
  );
  sub represent_float {
      my ($rep, $node) = @_;
      if (exists $special{ $node->{value} }) {
          $node->{style} = YAML_PLAIN_SCALAR_STYLE;
          $node->{data} = $special{ $node->{value} };
          return 1;
      }
      if (0.0 + $node->{value} ne $node->{value}) {
          return 0;
      }
      if (int($node->{value}) eq $node->{value} and not $node->{value} =~ m/\./) {
          $node->{value} .= '.0';
      }
      $node->{style} = YAML_PLAIN_SCALAR_STYLE;
      $node->{data} = "$node->{value}";
      return 1;
  }
  
  sub represent_bool {
      my ($rep, $node) = @_;
      my $string = $node->{value} ? 'true' : 'false';
      $node->{style} = YAML_PLAIN_SCALAR_STYLE;
      @{ $node->{items} } = $string;
      $node->{data} = $string;
      return 1;
  }
  
  1;
  
  __END__
  
  =pod
  
  =encoding utf-8
  
  =head1 NAME
  
  YAML::PP::Schema::JSON - YAML 1.2 JSON Schema
  
  =head1 SYNOPSIS
  
      my $yp = YAML::PP->new( schema => ['JSON'] );
      my $yp = YAML::PP->new( schema => [qw/ JSON empty=str /] );
      my $yp = YAML::PP->new( schema => [qw/ JSON empty=null /] );
  
  =head1 DESCRIPTION
  
  With this schema, the resolution of plain values will work like in JSON.
  Everything that matches a special value will be loaded as such, other plain
  scalars will be loaded as strings.
  
  Note that this is different from the official YAML 1.2 JSON Schema, where all
  strings have to be quoted.
  
  Here you can see all Schemas and examples implemented by YAML::PP:
  L<https://perlpunk.github.io/YAML-PP-p5/schemas.html>
  
  Official Schema: L<https://yaml.org/spec/1.2/spec.html#id2803231>
  
  =head1 CONFIGURATION
  
  The official YAML 1.2 JSON Schema wants all strings to be quoted.
  YAML::PP currently does not require that (it might do this optionally in
  the future).
  
  That means, there are no empty nodes allowed in the official schema. Example:
  
      ---
      key:
  
  The default behaviour of YAML::PP::Schema::JSON is to return an empty string,
  so it would be equivalent to:
  
      ---
      key: ''
  
  You can configure it to resolve this as C<undef>:
  
      my $yp = YAML::PP->new( schema => [qw/ JSON empty=null /] );
  
  This way it is equivalent to:
  
      ---
      key: null
  
  The default is:
  
      my $yp = YAML::PP->new( schema => [qw/ JSON empty=str /] );
  
  =head1 METHODS
  
  =over
  
  =item register
  
  Called by YAML::PP::Schema
  
  =item represent_bool, represent_float, represent_int, represent_literal, represent_undef
  
  Functions to represent the several node types.
  
      represent_bool($representer, $node);
  
  =back
  
  =cut
YAML_PP_SCHEMA_JSON

$fatpacked{"YAML/PP/Schema/Merge.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'YAML_PP_SCHEMA_MERGE';
  use strict;
  use warnings;
  package YAML::PP::Schema::Merge;
  
  our $VERSION = '0.027'; # VERSION
  
  use YAML::PP::Type::MergeKey;
  
  sub register {
      my ($self, %args) = @_;
      my $schema = $args{schema};
  
      $schema->add_resolver(
          tag => 'tag:yaml.org,2002:merge',
          match => [ equals => '<<' => YAML::PP::Type::MergeKey->new ],
      );
  }
  
  1;
  
  __END__
  
  =pod
  
  =encoding utf-8
  
  =head1 NAME
  
  YAML::PP::Schema::Merge - Enabling YAML merge keys for mappings
  
  =head1 SYNOPSIS
  
      use YAML::PP;
      my $yp = YAML::PP->new( schema => [qw/ + Merge /] );
  
      my $yaml = <<'EOM';
      ---
      - &CENTER { x: 1, y: 2 }
      - &LEFT { x: 0, y: 2 }
      - &BIG { r: 10 }
      - &SMALL { r: 1 }
  
      # All the following maps are equal:
  
      - # Explicit keys
        x: 1
        y: 2
        r: 10
        label: center/big
  
      - # Merge one map
        << : *CENTER
        r: 10
        label: center/big
  
      - # Merge multiple maps
        << : [ *CENTER, *BIG ]
        label: center/big
  
      - # Override
        << : [ *BIG, *LEFT, *SMALL ]
        x: 1
        label: center/big
      EOM
      my $data = $yp->load_string($yaml);
      # $data->[4] == $data->[5] == $data->[6] == $data->[7]
  
  =head1 DESCRIPTION
  
  See L<https://yaml.org/type/merge.html> for the specification.
  
  Quote:
  
  "Specify one or more mappings to be merged with the current one.
  
  The C<< << >> merge key is used to indicate that all the keys of one or more
  specified maps should be inserted into the current map. If the value associated
  with the key is a single mapping node, each of its key/value pairs is inserted
  into the current mapping, unless the key already exists in it. If the value
  associated with the merge key is a sequence, then this sequence is expected to
  contain mapping nodes and each of these nodes is merged in turn according to its
  order in the sequence. Keys in mapping nodes earlier in the sequence override
  keys specified in later mapping nodes."
  
  The implementation of this in a generic way is not trivial, because we also
  have to handle duplicate keys, and YAML::PP allows you to write your own
  handler for processing mappings.
  
  So the inner API of that is not stable at this point.
  
  Note that if you enable this schema, a plain scalar `<<` will be seen as
  special anywhere in your document, so if you want a literal `<<`, you have
  to put it in quotes.
  
  Note that the performed merge is not a "deep merge". Only top-level keys are
  merged.
  
  =head1 METHODS
  
  =over
  
  =item register
  
  Called by YAML::PP::Schema
  
  =back
  
  =cut
  
YAML_PP_SCHEMA_MERGE

$fatpacked{"YAML/PP/Schema/Perl.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'YAML_PP_SCHEMA_PERL';
  use strict;
  use warnings;
  package YAML::PP::Schema::Perl;
  
  our $VERSION = '0.027'; # VERSION
  
  use Scalar::Util qw/ blessed reftype /;
  
  my $qr_prefix;
  # workaround to avoid growing regexes when repeatedly loading and dumping
  # e.g. (?^:(?^:regex))
  {
      $qr_prefix = qr{\(\?-xism\:};
      if ($] >= 5.014) {
          $qr_prefix = qr{\(\?\^(?:[uadl])?\:};
      }
  }
  
  sub new {
      my ($class, %args) = @_;
      my $tags = $args{tags} || [];
      my $loadcode = $args{loadcode};
      $loadcode ||= 0;
      my $classes = $args{classes};
  
      my $self = bless {
          tags => $tags,
          loadcode => $loadcode,
          classes => $classes,
      }, $class;
  }
  
  sub register {
      my ($self, %args) = @_;
      my $schema = $args{schema};
  
      my $tags;
      my $loadcode = 0;
      my $classes;
      if (blessed($self)) {
          $tags = $self->{tags};
          @$tags = ('!perl') unless @$tags;
          $loadcode = $self->{loadcode};
          $classes = $self->{classes};
      }
      else {
          my $options = $args{options};
          my $tagtype = '!perl';
          for my $option (@$options) {
              if ($option =~ m/^tags?=(.+)$/) {
                  $tagtype = $1;
              }
              elsif ($option eq '+loadcode') {
                  $loadcode = 1;
              }
          }
          $tags = [split m/\+/, $tagtype];
      }
  
  
      my $perl_tag;
      my %tagtypes;
      my @perl_tags;
      for my $type (@$tags) {
          if ($type eq '!perl') {
              $perl_tag ||= $type;
              push @perl_tags, '!perl';
          }
          elsif ($type eq '!!perl') {
              $perl_tag ||= 'tag:yaml.org,2002:perl';
              push @perl_tags, 'tag:yaml.org,2002:perl';
          }
          else {
              die "Invalid tagtype '$type'";
          }
          $tagtypes{ $type } = 1;
      }
  
      my $perl_regex = '!perl';
      if ($tagtypes{'!perl'} and $tagtypes{'!!perl'}) {
          $perl_regex = '(?:tag:yaml\\.org,2002:|!)perl';
      }
      elsif ($tagtypes{'!perl'}) {
          $perl_regex = '!perl';
      }
      elsif ($tagtypes{'!!perl'}) {
          $perl_regex = 'tag:yaml\\.org,2002:perl';
      }
  
      my $class_regex = qr{.+};
      my $no_objects = 0;
      if ($classes) {
          if (@$classes) {
              $class_regex = '(' . join( '|', map "\Q$_\E", @$classes ) . ')';
          }
          else {
              $no_objects = 1;
              $class_regex = '';
          }
      }
  
      # Code
      if ($loadcode) {
          my $load_code = sub {
              my ($constructor, $event) = @_;
              return $self->evaluate_code($event->{value});
          };
          my $load_code_blessed = sub {
              my ($constructor, $event) = @_;
              my $class = $event->{tag};
              $class =~ s{^$perl_regex/code:}{};
              my $sub = $self->evaluate_code($event->{value});
              return $self->object($sub, $class);
          };
          $schema->add_resolver(
              tag => "$_/code",
              match => [ all => $load_code],
              implicit => 0,
          ) for @perl_tags;
          $schema->add_resolver(
              tag => qr{^$perl_regex/code:$class_regex$},
              match => [ all => $load_code_blessed ],
              implicit => 0,
          );
          $schema->add_resolver(
              tag => qr{^$perl_regex/code:.+},
              match => [ all => $load_code ],
              implicit => 0,
          ) if $no_objects;
      }
      else {
          my $loadcode_dummy = sub { return sub {} };
          my $loadcode_blessed_dummy = sub {
              my ($constructor, $event) = @_;
              my $class = $event->{tag};
              $class =~ s{^$perl_regex/code:}{};
              return $self->object(sub {}, $class);
          };
          $schema->add_resolver(
              tag => "$_/code",
              match => [ all => $loadcode_dummy ],
              implicit => 0,
          ) for @perl_tags;
          $schema->add_resolver(
              tag => qr{^$perl_regex/code:$class_regex$},
              match => [ all => $loadcode_blessed_dummy ],
              implicit => 0,
          );
          $schema->add_resolver(
              tag => qr{^$perl_regex/code:.+},
              match => [ all => $loadcode_dummy ],
              implicit => 0,
          ) if $no_objects;
      }
  
      # Glob
      my $load_glob = sub {
          my $value = undef;
          return \$value;
      };
      my $load_glob_blessed = sub {
          my ($constructor, $event) = @_;
          my $class = $event->{tag};
          $class =~ s{^$perl_regex/glob:}{};
          my $value = undef;
          return $self->object(\$value, $class);
      };
  
      $schema->add_mapping_resolver(
          tag => "$_/glob",
          on_create => $load_glob,
          on_data => sub {
              my ($constructor, $ref, $list) = @_;
              $$ref = $self->construct_glob($list);
          },
      ) for @perl_tags;
      if ($no_objects) {
          $schema->add_mapping_resolver(
              tag => qr{^$perl_regex/glob:.+$},
              on_create => $load_glob,
              on_data => sub {
                  my ($constructor, $ref, $list) = @_;
                  $$ref = $self->construct_glob($list);
              },
          );
      }
      else {
          $schema->add_mapping_resolver(
              tag => qr{^$perl_regex/glob:$class_regex$},
              on_create => $load_glob_blessed,
              on_data => sub {
                  my ($constructor, $ref, $list) = @_;
                  $$$ref = $self->construct_glob($list);
              },
          );
      }
  
      # Regex
      my $load_regex = sub {
          my ($constructor, $event) = @_;
          return $self->construct_regex($event->{value});
      };
      my $load_regex_blessed = sub {
          my ($constructor, $event) = @_;
          my $class = $event->{tag};
          $class =~ s{^$perl_regex/regexp:}{};
          my $qr = $self->construct_regex($event->{value});
          return $self->object($qr, $class);
      };
      $schema->add_resolver(
          tag => "$_/regexp",
          match => [ all => $load_regex ],
          implicit => 0,
      ) for @perl_tags;
      $schema->add_resolver(
          tag => qr{^$perl_regex/regexp:$class_regex$},
          match => [ all => $load_regex_blessed ],
          implicit => 0,
      );
      $schema->add_resolver(
          tag => qr{^$perl_regex/regexp:$class_regex$},
          match => [ all => $load_regex ],
          implicit => 0,
      ) if $no_objects;
  
      my $load_sequence = sub { return [] };
      my $load_sequence_blessed = sub {
          my ($constructor, $event) = @_;
          my $class = $event->{tag};
          $class =~ s{^$perl_regex/array:}{};
          return $self->object([], $class);
      };
      $schema->add_sequence_resolver(
          tag => "$_/array",
          on_create => $load_sequence,
      ) for @perl_tags;
      $schema->add_sequence_resolver(
          tag => qr{^$perl_regex/array:$class_regex$},
          on_create => $load_sequence_blessed,
      );
      $schema->add_sequence_resolver(
          tag => qr{^$perl_regex/array:.+$},
          on_create => $load_sequence,
      ) if $no_objects;
  
      my $load_mapping = sub { return {} };
      my $load_mapping_blessed = sub {
          my ($constructor, $event) = @_;
          my $class = $event->{tag};
          $class =~ s{^$perl_regex/hash:}{};
          return $self->object({}, $class);
      };
      $schema->add_mapping_resolver(
          tag => "$_/hash",
          on_create => $load_mapping,
      ) for @perl_tags;
      $schema->add_mapping_resolver(
          tag => qr{^$perl_regex/hash:$class_regex$},
          on_create => $load_mapping_blessed,
      );
      $schema->add_mapping_resolver(
          tag => qr{^$perl_regex/hash:.+$},
          on_create => $load_mapping,
      ) if $no_objects;
  
      # Ref
      my $load_ref = sub {
          my $value = undef;
          return \$value;
      };
      my $load_ref_blessed = sub {
          my ($constructor, $event) = @_;
          my $class = $event->{tag};
          $class =~ s{^$perl_regex/ref:}{};
          my $value = undef;
          return $self->object(\$value, $class);
      };
      $schema->add_mapping_resolver(
          tag => "$_/ref",
          on_create => $load_ref,
          on_data => sub {
              my ($constructor, $ref, $list) = @_;
              $$$ref = $self->construct_ref($list);
          },
      ) for @perl_tags;
      $schema->add_mapping_resolver(
          tag => qr{^$perl_regex/ref:$class_regex$},
          on_create => $load_ref_blessed,
          on_data => sub {
              my ($constructor, $ref, $list) = @_;
              $$$ref = $self->construct_ref($list);
          },
      );
      $schema->add_mapping_resolver(
          tag => qr{^$perl_regex/ref:.+$},
          on_create => $load_ref,
          on_data => sub {
              my ($constructor, $ref, $list) = @_;
              $$$ref = $self->construct_ref($list);
          },
      ) if $no_objects;
  
      # Scalar ref
      my $load_scalar_ref = sub {
          my $value = undef;
          return \$value;
      };
      my $load_scalar_ref_blessed = sub {
          my ($constructor, $event) = @_;
          my $class = $event->{tag};
          $class =~ s{^$perl_regex/scalar:}{};
          my $value = undef;
          return $self->object(\$value, $class);
      };
      $schema->add_mapping_resolver(
          tag => "$_/scalar",
          on_create => $load_scalar_ref,
          on_data => sub {
              my ($constructor, $ref, $list) = @_;
              $$$ref = $self->construct_scalar($list);
          },
      ) for @perl_tags;
      $schema->add_mapping_resolver(
          tag => qr{^$perl_regex/scalar:$class_regex$},
          on_create => $load_scalar_ref_blessed,
          on_data => sub {
              my ($constructor, $ref, $list) = @_;
              $$$ref = $self->construct_scalar($list);
          },
      );
      $schema->add_mapping_resolver(
          tag => qr{^$perl_regex/scalar:.+$},
          on_create => $load_scalar_ref,
          on_data => sub {
              my ($constructor, $ref, $list) = @_;
              $$$ref = $self->construct_scalar($list);
          },
      ) if $no_objects;
  
      $schema->add_representer(
          scalarref => 1,
          code => sub {
              my ($rep, $node) = @_;
              $node->{tag} = $perl_tag . "/scalar";
              $node->{data} = $self->represent_scalar($node->{value});
          },
      );
      $schema->add_representer(
          refref => 1,
          code => sub {
              my ($rep, $node) = @_;
              $node->{tag} = $perl_tag . "/ref";
              $node->{data} = $self->represent_ref($node->{value});
          },
      );
      $schema->add_representer(
          coderef => 1,
          code => sub {
              my ($rep, $node) = @_;
              $node->{tag} = $perl_tag . "/code";
              $node->{data} = $self->represent_code($node->{value});
          },
      );
      $schema->add_representer(
          glob => 1,
          code => sub {
              my ($rep, $node) = @_;
              $node->{tag} = $perl_tag . "/glob";
              $node->{data} = $self->represent_glob($node->{value});
          },
      );
  
      $schema->add_representer(
          class_matches => 1,
          code => sub {
              my ($rep, $node) = @_;
              my $blessed = blessed $node->{value};
              my $tag_blessed = ":$blessed";
              if ($blessed !~ m/^$class_regex$/) {
                  $tag_blessed = '';
              }
              $node->{tag} = sprintf "$perl_tag/%s%s",
                  lc($node->{reftype}), $tag_blessed;
              if ($node->{reftype} eq 'HASH') {
                  $node->{data} = $node->{value};
              }
              elsif ($node->{reftype} eq 'ARRAY') {
                  $node->{data} = $node->{value};
              }
  
              # Fun with regexes in perl versions!
              elsif ($node->{reftype} eq 'REGEXP') {
                  if ($blessed eq 'Regexp') {
                      $node->{tag} = $perl_tag . "/regexp";
                  }
                  $node->{data} = $self->represent_regex($node->{value});
              }
              elsif ($node->{reftype} eq 'SCALAR') {
  
                  # in perl <= 5.10 regex reftype(regex) was SCALAR
                  if ($blessed eq 'Regexp') {
                      $node->{tag} = $perl_tag . '/regexp';
                      $node->{data} = $self->represent_regex($node->{value});
                  }
  
                  # In perl <= 5.10 there seemed to be no better pure perl
                  # way to detect a blessed regex?
                  elsif (
                      $] <= 5.010001
                      and not defined ${ $node->{value} }
                      and $node->{value} =~ m/^\(\?/
                  ) {
                      $node->{tag} = $perl_tag . '/regexp' . $tag_blessed;
                      $node->{data} = $self->represent_regex($node->{value});
                  }
                  else {
                      # phew, just a simple scalarref
                      $node->{data} = $self->represent_scalar($node->{value});
                  }
              }
              elsif ($node->{reftype} eq 'REF') {
                  $node->{data} = $self->represent_ref($node->{value});
              }
  
              elsif ($node->{reftype} eq 'CODE') {
                  $node->{data} = $self->represent_code($node->{value});
              }
              elsif ($node->{reftype} eq 'GLOB') {
                  $node->{data} = $self->represent_glob($node->{value});
              }
              else {
                  die "Reftype '$node->{reftype}' not implemented";
              }
  
              return 1;
          },
      );
      return;
  }
  
  sub evaluate_code {
      my ($self, $code) = @_;
      unless ($code =~ m/^ \s* \{ .* \} \s* \z/xs) {
          die "Malformed code";
      }
      $code = "sub $code";
      my $sub = eval $code;
      if ($@) {
          die "Couldn't eval code: $@>>$code<<";
      }
      return $sub;
  }
  
  sub construct_regex {
      my ($self, $regex) = @_;
      if ($regex =~ m/^$qr_prefix(.*)\)\z/s) {
          $regex = $1;
      }
      my $qr = qr{$regex};
      return $qr;
  }
  
  sub construct_glob {
      my ($self, $list) = @_;
      if (@$list % 2) {
          die "Unexpected data in perl/glob construction";
      }
      my %globdata = @$list;
      my $name = delete $globdata{NAME} or die "Missing NAME in perl/glob";
      my $pkg = delete $globdata{PACKAGE};
      $pkg = 'main' unless defined $pkg;
      my @allowed = qw(SCALAR ARRAY HASH CODE IO);
      delete @globdata{ @allowed };
      if (my @keys = keys %globdata) {
          die "Unexpected keys in perl/glob: @keys";
      }
      no strict 'refs';
      return *{"${pkg}::$name"};
  }
  
  sub construct_scalar {
      my ($self, $list) = @_;
      if (@$list != 2) {
          die "Unexpected data in perl/scalar construction";
      }
      my ($key, $value) = @$list;
      unless ($key eq '=') {
          die "Unexpected data in perl/scalar construction";
      }
      return $value;
  }
  
  sub construct_ref {
      &construct_scalar;
  }
  
  sub represent_scalar {
      my ($self, $value) = @_;
      return { '=' => $$value };
  }
  
  sub represent_ref {
      &represent_scalar;
  }
  
  sub represent_code {
      my ($self, $code) = @_;
      require B::Deparse;
      my $deparse = B::Deparse->new("-p", "-sC");
      return $deparse->coderef2text($code);
  }
  
  
  my @stats = qw/ device inode mode links uid gid rdev size
      atime mtime ctime blksize blocks /;
  sub represent_glob {
      my ($self, $glob) = @_;
      my %glob;
      for my $type (qw/ PACKAGE NAME SCALAR ARRAY HASH CODE IO /) {
          my $value = *{ $glob }{ $type };
          if ($type eq 'SCALAR') {
              $value = $$value;
          }
          elsif ($type eq 'IO') {
              if (defined $value) {
                  undef $value;
                  $value->{stat} = {};
                  if ($value->{fileno} = fileno(*{ $glob })) {
                      @{ $value->{stat} }{ @stats } = stat(*{ $glob });
                      $value->{tell} = tell *{ $glob };
                  }
              }
          }
          $glob{ $type } = $value if defined $value;
      }
      return \%glob;
  }
  
  sub represent_regex {
      my ($self, $regex) = @_;
      $regex = "$regex";
      if ($regex =~ m/^$qr_prefix(.*)\)\z/s) {
          $regex = $1;
      }
      return $regex;
  }
  
  sub object {
      my ($self, $data, $class) = @_;
      return bless $data, $class;
  }
  
  1;
  
  __END__
  
  =pod
  
  =encoding utf-8
  
  =head1 NAME
  
  YAML::PP::Schema::Perl - Schema for serializing perl objects and special types
  
  =head1 SYNOPSIS
  
      use YAML::PP;
      # This can be dangerous when loading untrusted YAML!
      my $yp = YAML::PP->new( schema => [qw/ + Perl /] );
      # or
      my $yp = YAML::PP->new( schema => [qw/ Core Perl /] );
      my $yaml = $yp->dump_string(sub { return 23 });
  
      # loading code references
      # This is very dangerous when loading untrusted YAML!!
      my $yp = YAML::PP->new( schema => [qw/ + Perl +loadcode /] );
      my $code = $yp->load_string(<<'EOM');
      --- !perl/code |
          {
              use 5.010;
              my ($name) = @_;
              say "Hello $name!";
          }
      EOM
      $code->("Ingy");
  
  =head1 DESCRIPTION
  
  This schema allows you to load and dump perl objects and special types.
  
  Please note that loading objects of arbitrary classes can be dangerous
  in Perl. You have to load the modules yourself, but if an exploitable module
  is loaded and an object is created, its C<DESTROY> method will be called
  when the object falls out of scope. L<File::Temp> is an example that can
  be exploitable and might remove arbitrary files.
  
  Dumping code references is on by default, but not loading (because that is
  easily exploitable since it's using string C<eval>).
  
  =head2 Tag Styles
  
  You can define the style of tags you want to support:
  
      my $yp_perl_two_one = YAML::PP->new(
          schema => [qw/ + Perl tags=!!perl+!perl /],
      );
  
  =over
  
  =item C<!perl> (default)
  
  Only C<!perl/type> tags are supported.
  
  =item C<!!perl>
  
  Only C<!!perl/type> tags are supported.
  
  =item C<!perl+!!perl>
  
  Both C<!perl/type> and C<!!perl/tag> are supported when loading. When dumping,
  C<!perl/type> is used.
  
  =item C<!!perl+!perl>
  
  Both C<!perl/type> and C<!!perl/tag> are supported when loading. When dumping,
  C<!!perl/type> is used.
  
  =back
  
  L<YAML>.pm, L<YAML::Syck> and L<YAML::XS> are using C<!!perl/type> when dumping.
  
  L<YAML>.pm and L<YAML::Syck> are supporting both C<!perl/type> and
  C<!!perl/type> when loading. L<YAML::XS> currently only supports the latter.
  
  =head2 Allow only certain classes
  
  Since v0.017
  
  Blessing arbitrary objects can be dangerous.  Maybe you want to allow blessing
  only specific classes and ignore others.  For this you have to instantiate
  a Perl Schema object first and use the C<classes> option.
  
  Currently it only allows a list of strings:
  
      my $perl = YAML::PP::Schema::Perl->new(
          classes => ['Foo', 'Bar'],
      );
      my $yp = YAML::PP::Perl->new(
          schema => [qw/ + /, $perl],
      );
  
  Allowed classes will be loaded and dumped as usual. The others will be ignored.
  
  If you want to allow no objects at all, pass an empty array ref.
  
  
  =cut
  
  =head2 EXAMPLES
  
  This is a list of the currently supported types and how they are dumped into
  YAML:
  
  =cut
  
  ### BEGIN EXAMPLE
  
  =pod
  
  =over 4
  
  =item array
  
          # Code
          [
              qw/ one two three four /
          ]
  
  
          # YAML
          ---
          - one
          - two
          - three
          - four
  
  
  =item array_blessed
  
          # Code
          bless [
              qw/ one two three four /
          ], "Just::An::Arrayref"
  
  
          # YAML
          --- !perl/array:Just::An::Arrayref
          - one
          - two
          - three
          - four
  
  
  =item circular
  
          # Code
          my $circle = bless [ 1, 2 ], 'Circle';
          push @$circle, $circle;
          $circle;
  
  
          # YAML
          --- &1 !perl/array:Circle
          - 1
          - 2
          - *1
  
  
  =item coderef
  
          # Code
          sub {
              my (%args) = @_;
              return $args{x} + $args{y};
          }
  
  
          # YAML
          --- !perl/code |-
            {
                use warnings;
                use strict;
                (my(%args) = @_);
                (return ($args{'x'} + $args{'y'}));
            }
  
  
  =item coderef_blessed
  
          # Code
          bless sub {
              my (%args) = @_;
              return $args{x} - $args{y};
          }, "I::Am::Code"
  
  
          # YAML
          --- !perl/code:I::Am::Code |-
            {
                use warnings;
                use strict;
                (my(%args) = @_);
                (return ($args{'x'} - $args{'y'}));
            }
  
  
  =item hash
  
          # Code
          {
              U => 2,
              B => 52,
          }
  
  
          # YAML
          ---
          B: 52
          U: 2
  
  
  =item hash_blessed
  
          # Code
          bless {
              U => 2,
              B => 52,
          }, 'A::Very::Exclusive::Class'
  
  
          # YAML
          --- !perl/hash:A::Very::Exclusive::Class
          B: 52
          U: 2
  
  
  =item refref
  
          # Code
          my $ref = { a => 'hash' };
          my $refref = \$ref;
          $refref;
  
  
          # YAML
          --- !perl/ref
          =:
            a: hash
  
  
  =item refref_blessed
  
          # Code
          my $ref = { a => 'hash' };
          my $refref = bless \$ref, 'Foo';
          $refref;
  
  
          # YAML
          --- !perl/ref:Foo
          =:
            a: hash
  
  
  =item regexp
  
          # Code
          my $string = 'unblessed';
          qr{$string}
  
  
          # YAML
          --- !perl/regexp unblessed
  
  
  =item regexp_blessed
  
          # Code
          my $string = 'blessed';
          bless qr{$string}, "Foo"
  
  
          # YAML
          --- !perl/regexp:Foo blessed
  
  
  =item scalarref
  
          # Code
          my $scalar = "some string";
          my $scalarref = \$scalar;
          $scalarref;
  
  
          # YAML
          --- !perl/scalar
          =: some string
  
  
  =item scalarref_blessed
  
          # Code
          my $scalar = "some other string";
          my $scalarref = bless \$scalar, 'Foo';
          $scalarref;
  
  
          # YAML
          --- !perl/scalar:Foo
          =: some other string
  
  
  
  
  =back
  
  =cut
  
  ### END EXAMPLE
  
  =head2 METHODS
  
  =over
  
  =item new
  
      my $perl = YAML::PP::Schema::Perl->new(
          tags => "!perl",
          classes => ['MyClass'],
          loadcode => 1,
      );
  
  The constructor recognizes the following options:
  
  =over
  
  =item tags
  
  Default: 'C<!perl>'
  
  See L<"Tag Styles">
  
  =item classes
  
  Default: C<undef>
  
  Since: v0.017
  
  Accepts an array ref of class names
  
  =item loadcode
  
  Default: 0
  
  =back
  
  =item register
  
  A class method called by L<YAML::PP::Schema>
  
  =item construct_ref, represent_ref
  
  Perl variables of the type C<REF> are represented in yaml like this:
  
      --- !perl/ref
      =:
        a: 1
  
  C<construct_ref> returns the perl data:
  
      my $data = YAML::PP::Schema::Perl->construct_ref([ '=', { some => 'data' } );
      my $data = \{ a => 1 };
  
  C<represent_ref> turns a C<REF> variable into a YAML mapping:
  
      my $data = YAML::PP::Schema::Perl->represent_ref(\{ a => 1 });
      my $data = { '=' => { a => 1 } };
  
  =item construct_scalar, represent_scalar
  
  Perl variables of the type C<SCALAR> are represented in yaml like this:
  
      --- !perl/scalar
      =: string
  
  C<construct_scalar> returns the perl data:
  
      my $data = YAML::PP::Schema::Perl->construct_ref([ '=', 'string' );
      my $data = \'string';
  
  C<represent_scalar> turns a C<SCALAR> variable into a YAML mapping:
  
      my $data = YAML::PP::Schema::Perl->represent_scalar(\'string');
      my $data = { '=' => 'string' };
  
  =item construct_regex, represent_regex
  
  C<construct_regex> returns a C<qr{}> object from the YAML string:
  
      my $qr = YAML::PP::Schema::Perl->construct_regex('foo.*');
  
  C<represent_regex> returns a string representing the regex object:
  
      my $string = YAML::PP::Schema::Perl->represent_regex(qr{...});
  
  =item evaluate_code, represent_code
  
  C<evaluate_code> returns a code reference from a string. The string must
  start with a C<{> and end with a C<}>.
  
      my $code = YAML::PP::Schema::Perl->evaluate_code('{ return 23 }');
  
  C<represent_code> returns a string representation of the code reference
  with the help of B::Deparse:
  
      my $string = YAML::PP::Schema::Perl->represent_code(sub { return 23 });
  
  =item construct_glob, represent_glob
  
  C<construct_glob> returns a glob from a hash.
  
      my $glob = YAML::PP::Schema::Perl->construct_glob($hash);
  
  C<represent_glob> returns a hash representation of the glob.
  
      my $hash = YAML::PP::Schema::Perl->represent_glob($glob);
  
  =item object
  
  Does the same as C<bless>:
  
      my $object = YAML::PP::Schema::Perl->object($data, $class);
  
  =back
  
  =cut
YAML_PP_SCHEMA_PERL

$fatpacked{"YAML/PP/Schema/Tie/IxHash.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'YAML_PP_SCHEMA_TIE_IXHASH';
  use strict;
  use warnings;
  package YAML::PP::Schema::Tie::IxHash;
  
  our $VERSION = '0.027'; # VERSION
  
  use base 'YAML::PP::Schema';
  
  use Scalar::Util qw/ blessed reftype /;
  my $ixhash = eval { require Tie::IxHash };
  
  sub register {
      my ($self, %args) = @_;
      my $schema = $args{schema};
      unless ($ixhash) {
          die "You need to install Tie::IxHash in order to use this module";
      }
  
      $schema->add_representer(
          tied_equals => 'Tie::IxHash',
          code => sub {
              my ($rep, $node) = @_;
              $node->{items} = [ %{ $node->{data} } ];
              return 1;
          },
      );
      return;
  }
  
  1;
  
  __END__
  
  =pod
  
  =encoding utf-8
  
  =head1 NAME
  
  YAML::PP::Schema::Tie::IxHash - (Deprecated) Schema for serializing ordered hashes
  
  =head1 SYNOPSIS
  
      use YAML::PP;
      use Tie::IxHash;
      my $yp = YAML::PP->new( schema => [qw/ + Tie::IxHash /] );
  
      tie(my %ordered, 'Tie::IxHash');
      %ordered = (
          U => 2,
          B => 52,
      );
  
      my $yaml = $yp->dump_string(\%ordered);
  
  
      # Output:
      ---
      U: 2
      B: 52
  
  =head1 DESCRIPTION
  
  This is deprecated. See the new option C<preserve> in L<YAML::PP>.
  
  This schema allows you to dump ordered hashes which are tied to
  L<Tie::IxHash>.
  
  This code is pretty new and experimental.
  
  It is not yet implemented for loading yet, so for now you have to tie
  the hashes yourself.
  
  Examples:
  
  =cut
  
  ### BEGIN EXAMPLE
  
  =pod
  
  =over 4
  
  =item order
  
          # Code
          tie(my %order, 'Tie::IxHash');
          %order = (
              U => 2,
              B => 52,
              c => 64,
              19 => 84,
              Disco => 2000,
              Year => 2525,
              days_on_earth => 20_000,
          );
          \%order;
  
  
          # YAML
          ---
          U: 2
          B: 52
          c: 64
          19: 84
          Disco: 2000
          Year: 2525
          days_on_earth: 20000
  
  
  =item order_blessed
  
          # Code
          tie(my %order, 'Tie::IxHash');
          %order = (
              U => 2,
              B => 52,
              c => 64,
              19 => 84,
              Disco => 2000,
              Year => 2525,
              days_on_earth => 20_000,
          );
          bless \%order, 'Order';
  
  
          # YAML
          --- !perl/hash:Order
          U: 2
          B: 52
          c: 64
          19: 84
          Disco: 2000
          Year: 2525
          days_on_earth: 20000
  
  
  
  
  =back
  
  =cut
  
  ### END EXAMPLE
  
  =head1 METHODS
  
  =over
  
  =item register
  
  Called by YAML::PP::Schema
  
  =back
  
  =cut
YAML_PP_SCHEMA_TIE_IXHASH

$fatpacked{"YAML/PP/Schema/YAML1_1.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'YAML_PP_SCHEMA_YAML1_1';
  use strict;
  use warnings;
  package YAML::PP::Schema::YAML1_1;
  
  our $VERSION = '0.027'; # VERSION
  
  use YAML::PP::Schema::JSON qw/
      represent_int represent_float represent_literal represent_bool
      represent_undef
  /;
  
  use YAML::PP::Common qw/ YAML_PLAIN_SCALAR_STYLE /;
  
  #https://yaml.org/type/bool.html
  # y|Y|yes|Yes|YES|n|N|no|No|NO
  # |true|True|TRUE|false|False|FALSE
  # |on|On|ON|off|Off|OFF
  
  # https://yaml.org/type/float.html
  #  [-+]?([0-9][0-9_]*)?\.[0-9.]*([eE][-+][0-9]+)? (base 10)
  # |[-+]?[0-9][0-9_]*(:[0-5]?[0-9])+\.[0-9_]* (base 60)
  # |[-+]?\.(inf|Inf|INF) # (infinity)
  # |\.(nan|NaN|NAN) # (not a number)
  
  # https://yaml.org/type/int.html
  #  [-+]?0b[0-1_]+ # (base 2)
  # |[-+]?0[0-7_]+ # (base 8)
  # |[-+]?(0|[1-9][0-9_]*) # (base 10)
  # |[-+]?0x[0-9a-fA-F_]+ # (base 16)
  # |[-+]?[1-9][0-9_]*(:[0-5]?[0-9])+ # (base 60)
  
  # https://yaml.org/type/null.html
  #  ~ # (canonical)
  # |null|Null|NULL # (English)
  # | # (Empty)
  
  my $RE_INT_1_1 = qr{^([+-]?(?:0|[1-9][0-9_]*))$};
  #my $RE_FLOAT_1_1 = qr{^([+-]?([0-9][0-9_]*)?\.[0-9.]*([eE][+-][0-9]+)?)$};
  # https://yaml.org/type/float.html has a bug. The regex says \.[0-9.], but
  # probably means \.[0-9_]
  my $RE_FLOAT_1_1 = qr{^([+-]?(?:[0-9][0-9_]*)?\.[0-9_]*(?:[eE][+-][0-9]+)?)$};
  my $RE_SEXAGESIMAL = qr{^([+-]?[0-9][0-9_]*(:[0-5]?[0-9])+\.[0-9_]*)$};
  my $RE_SEXAGESIMAL_INT = qr{^([-+]?[1-9][0-9_]*(:[0-5]?[0-9])+)$};
  my $RE_INT_OCTAL_1_1 = qr{^([+-]?)0([0-7_]+)$};
  my $RE_INT_HEX_1_1 = qr{^([+-]?)(0x[0-9a-fA-F_]+)$};
  my $RE_INT_BIN_1_1 = qr{^([-+]?)(0b[0-1_]+)$};
  
  sub _from_oct {
      my ($constructor, $event, $matches) = @_;
      my ($sign, $oct) = @$matches;
      $oct =~ tr/_//d;
      my $result = oct $oct;
      $result = -$result if $sign eq '-';
      return $result;
  }
  sub _from_hex {
      my ($constructor, $event, $matches) = @_;
      my ($sign, $hex) = @$matches;
      my $result = hex $hex;
      $result = -$result if $sign eq '-';
      return $result;
  }
  sub _sexa_to_float {
      my ($constructor, $event, $matches) = @_;
      my ($float) = @$matches;
      my $result = 0;
      my $i = 0;
      my $sign = 1;
      $float =~ s/^-// and $sign = -1;
      for my $part (reverse split m/:/, $float) {
          $result += $part * ( 60 ** $i );
          $i++;
      }
      $result = unpack F => pack F => $result;
      return $result * $sign;
  }
  sub _to_float {
      my ($constructor, $event, $matches) = @_;
      my ($float) = @$matches;
      $float =~ tr/_//d;
      $float = unpack F => pack F => $float;
      return $float;
  }
  sub _to_int {
      my ($constructor, $event, $matches) = @_;
      my ($int) = @$matches;
      $int =~ tr/_//d;
      0 + $int;
  }
  
  sub register {
      my ($self, %args) = @_;
      my $schema = $args{schema};
  
      $schema->add_resolver(
          tag => 'tag:yaml.org,2002:null',
          match => [ equals => $_ => undef ],
      ) for (qw/ null NULL Null ~ /, '');
      $schema->add_resolver(
          tag => 'tag:yaml.org,2002:bool',
          match => [ equals => $_ => $schema->true ],
      ) for (qw/ true TRUE True y Y yes Yes YES on On ON /);
      $schema->add_resolver(
          tag => 'tag:yaml.org,2002:bool',
          match => [ equals => $_ => $schema->false ],
      ) for (qw/ false FALSE False n N no No NO off Off OFF /);
      $schema->add_resolver(
          tag => 'tag:yaml.org,2002:int',
          match => [ regex => $RE_INT_OCTAL_1_1 => \&_from_oct ],
      );
      $schema->add_resolver(
          tag => 'tag:yaml.org,2002:int',
          match => [ regex => $RE_INT_1_1 => \&_to_int ],
      );
      $schema->add_resolver(
          tag => 'tag:yaml.org,2002:int',
          match => [ regex => $RE_INT_HEX_1_1 => \&_from_hex ],
      );
      $schema->add_resolver(
          tag => 'tag:yaml.org,2002:float',
          match => [ regex => $RE_FLOAT_1_1 => \&_to_float ],
      );
      $schema->add_resolver(
          tag => 'tag:yaml.org,2002:int',
          match => [ regex => $RE_INT_BIN_1_1 => \&_from_oct ],
      );
      $schema->add_resolver(
          tag => 'tag:yaml.org,2002:int',
          match => [ regex => $RE_SEXAGESIMAL_INT => \&_sexa_to_float ],
      );
      $schema->add_resolver(
          tag => 'tag:yaml.org,2002:float',
          match => [ regex => $RE_SEXAGESIMAL => \&_sexa_to_float ],
      );
      $schema->add_resolver(
          tag => 'tag:yaml.org,2002:float',
          match => [ equals => $_ => 0 + "inf" ],
      ) for (qw/ .inf .Inf .INF +.inf +.Inf +.INF /);
      $schema->add_resolver(
          tag => 'tag:yaml.org,2002:float',
          match => [ equals => $_ => 0 - "inf" ],
      ) for (qw/ -.inf -.Inf -.INF /);
      $schema->add_resolver(
          tag => 'tag:yaml.org,2002:float',
          match => [ equals => $_ => 0 + "nan" ],
      ) for (qw/ .nan .NaN .NAN /);
      $schema->add_resolver(
          tag => 'tag:yaml.org,2002:str',
          match => [ all => sub { $_[1]->{value} } ],
          implicit => 0,
      );
  
      my $int_flags = B::SVp_IOK;
      my $float_flags = B::SVp_NOK;
      $schema->add_representer(
          flags => $int_flags,
          code => \&represent_int,
      );
      $schema->add_representer(
          flags => $float_flags,
          code => \&represent_float,
      );
      $schema->add_representer(
          undefined => \&represent_undef,
      );
      $schema->add_representer(
          equals => $_,
          code => \&represent_literal,
      ) for ("", qw/
          true TRUE True y Y yes Yes YES on On ON
          false FALSE False n N n no No NO off Off OFF
          null NULL Null ~
          .inf .Inf .INF -.inf -.Inf -.INF +.inf +.Inf +.INF .nan .NaN .NAN
      /);
      $schema->add_representer(
          regex => qr{$RE_INT_1_1|$RE_FLOAT_1_1|$RE_INT_OCTAL_1_1|$RE_INT_HEX_1_1|$RE_INT_BIN_1_1|$RE_SEXAGESIMAL_INT|$RE_SEXAGESIMAL},
          code => \&represent_literal,
      );
  
      if ($schema->bool_class) {
          $schema->add_representer(
              class_equals => $schema->bool_class,
              code => \&represent_bool,
          );
      }
  
      return;
  }
  
  
  1;
  
  __END__
  
  =pod
  
  =encoding utf-8
  
  =head1 NAME
  
  YAML::PP::Schema::YAML1_1 - YAML 1.1 Schema for YAML::PP
  
  =head1 SYNOPSIS
  
      use YAML::PP;
  
      my $yp = YAML::PP->new( schema => ['YAML1_1'] );
      my $yaml = <<'EOM';
      ---
      booltrue: [ true, True, TRUE, y, Y, yes, Yes, YES, on, On, ON ]
      EOM
      my $data = $yp->load_string($yaml);
  
  =head1 DESCRIPTION
  
  This schema allows you to load the common YAML Types from YAML 1.1.
  
  =head1 METHODS
  
  =over
  
  =item register
  
  Called by YAML::PP::Schema
  
  =back
  
  =head1 SEE ALSO
  
  =over
  
  =item L<https://yaml.org/type/null.html>
  
  =item L<https://yaml.org/type/float.html>
  
  =item L<https://yaml.org/type/int.html>
  
  =item L<https://yaml.org/type/bool.html>
  
  =back
YAML_PP_SCHEMA_YAML1_1

$fatpacked{"YAML/PP/Type/MergeKey.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'YAML_PP_TYPE_MERGEKEY';
  use strict;
  use warnings;
  package YAML::PP::Type::MergeKey;
  
  our $VERSION = '0.027'; # VERSION
  
  sub new {
      my ($class) = @_;
      return bless {}, $class;
  }
  
  1;
  
  
  __END__
  
  =pod
  
  =encoding utf-8
  
  =head1 NAME
  
  YAML::PP::Type::MergeKey - A special node type for merge keys
  
  =head1 DESCRIPTION
  
  See L<YAML::PP::Schema::Merge>
  
  =head1 METHODS
  
  =over
  
  =item new
  
  Constructor
  
  =back
  
  =cut
  
YAML_PP_TYPE_MERGEKEY

$fatpacked{"YAML/PP/Writer.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'YAML_PP_WRITER';
  # ABSTRACT: Writer class for YAML::PP representing output data
  use strict;
  use warnings;
  package YAML::PP::Writer;
  
  our $VERSION = '0.027'; # VERSION
  
  sub output { return $_[0]->{output} }
  sub set_output { $_[0]->{output} = $_[1] }
  
  sub new {
      my ($class, %args) = @_;
      my $output = delete $args{output};
      $output = '' unless defined $output;
      return bless {
          output => $output,
      }, $class;
  }
  
  sub write {
      my ($self, $line) = @_;
      $self->{output} .= $line;
  }
  
  sub init {
      $_[0]->set_output('');
  }
  
  sub finish {
      my ($self) = @_;
      $_[0]->set_output(undef);
  }
  
  1;
  
  __END__
  
  =pod
  
  =encoding utf-8
  
  =head1 NAME
  
  YAML::PP::Writer - Write YAML output
  
  =head1 SYNOPSIS
  
      my $writer = YAML::PP::Writer->new;
  
  =head1 DESCRIPTION
  
  The L<YAML::PP::Emitter> sends its output to the writer.
  
  You can use your own writer. if you want to send the YAML output to
  somewhere else. See t/44.writer.t for an example.
  
  =head1 METHODS
  
  =over
  
  =item new
  
      my $writer = YAML::PP::Writer->new;
  
  Constructor.
  
  =item write
  
      $writer->write('- ');
  
  =item init
  
      $writer->init;
  
  Initialize
  
  =item finish
  
      $writer->finish;
  
  Gets called when the output ends.
  
  =item output, set_output
  
  Getter/setter for the YAML output
  
  =back
  
  =cut
YAML_PP_WRITER

$fatpacked{"YAML/PP/Writer/File.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'YAML_PP_WRITER_FILE';
  use strict;
  use warnings;
  package YAML::PP::Writer::File;
  
  our $VERSION = '0.027'; # VERSION
  
  use Scalar::Util qw/ openhandle /;
  
  use base qw/ YAML::PP::Writer /;
  
  use Carp qw/ croak /;
  
  sub _open_handle {
      my ($self) = @_;
      if (openhandle($self->{output})) {
          $self->{filehandle} = $self->{output};
          return $self->{output};
      }
      open my $fh, '>:encoding(UTF-8)', $self->{output}
          or croak "Could not open '$self->{output}' for writing: $!";
      $self->{filehandle} = $fh;
      return $fh;
  }
  
  sub write {
      my ($self, $line) = @_;
      my $fh = $self->{filehandle};
      print $fh $line;
  }
  
  sub init {
      my ($self) = @_;
      my $fh = $self->_open_handle;
  }
  
  sub finish {
      my ($self) = @_;
      if (openhandle($self->{output})) {
          # Original argument was a file handle, so the caller needs
          # to close it
          return;
      }
      close $self->{filehandle};
  }
  
  1;
  
  __END__
  
  =pod
  
  =encoding utf-8
  
  =head1 NAME
  
  YAML::PP::Writer::File - Write YAML output to file or file handle
  
  =head1 SYNOPSIS
  
      my $writer = YAML::PP::Writer::File->new(output => $file);
  
  =head1 DESCRIPTION
  
  The L<YAML::PP::Emitter> sends its output to the writer.
  
  You can use your own writer. if you want to send the YAML output to
  somewhere else. See t/44.writer.t for an example.
  
  =head1 METHODS
  
  =over
  
  =item new
  
      my $writer = YAML::PP::Writer::File->new(output => $file);
      my $writer = YAML::PP::Writer::File->new(output => $filehandle);
  
  Constructor.
  
  =item write
  
      $writer->write('- ');
  
  =item init
  
      $writer->init;
  
  Initialize
  
  =item finish
  
      $writer->finish;
  
  Gets called when the output ends. If The argument was a filename, the
  filehandle will be closed. If the argument was a filehandle, the caller needs to
  close it.
  
  =item output, set_output
  
  Getter/setter for the YAML output
  
  =back
  
  =cut
YAML_PP_WRITER_FILE

$fatpacked{"x86_64-linux-gnu-thread-multi/List/Util.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'X86_64-LINUX-GNU-THREAD-MULTI_LIST_UTIL';
  # Copyright (c) 1997-2009 Graham Barr <gbarr@pobox.com>. All rights reserved.
  # This program is free software; you can redistribute it and/or
  # modify it under the same terms as Perl itself.
  #
  # Maintained since 2013 by Paul Evans <leonerd@leonerd.org.uk>
  
  package List::Util;
  
  use strict;
  use warnings;
  require Exporter;
  
  our @ISA        = qw(Exporter);
  our @EXPORT_OK  = qw(
    all any first min max minstr maxstr none notall product reduce reductions sum sum0
    sample shuffle uniq uniqint uniqnum uniqstr zip zip_longest zip_shortest mesh mesh_longest mesh_shortest
    head tail pairs unpairs pairkeys pairvalues pairmap pairgrep pairfirst
  );
  our $VERSION    = "1.59";
  our $XS_VERSION = $VERSION;
  $VERSION =~ tr/_//d;
  
  require XSLoader;
  XSLoader::load('List::Util', $XS_VERSION);
  
  # Used by shuffle()
  our $RAND;
  
  sub import
  {
    my $pkg = caller;
  
    # (RT88848) Touch the caller's $a and $b, to avoid the warning of
    #   Name "main::a" used only once: possible typo" warning
    no strict 'refs';
    ${"${pkg}::a"} = ${"${pkg}::a"};
    ${"${pkg}::b"} = ${"${pkg}::b"};
  
    goto &Exporter::import;
  }
  
  # For objects returned by pairs()
  sub List::Util::_Pair::key   { shift->[0] }
  sub List::Util::_Pair::value { shift->[1] }
  sub List::Util::_Pair::TO_JSON { [ @{+shift} ] }
  
  =head1 NAME
  
  List::Util - A selection of general-utility list subroutines
  
  =head1 SYNOPSIS
  
      use List::Util qw(
        reduce any all none notall first reductions
  
        max maxstr min minstr product sum sum0
  
        pairs unpairs pairkeys pairvalues pairfirst pairgrep pairmap
  
        shuffle uniq uniqint uniqnum uniqstr zip mesh
      );
  
  =head1 DESCRIPTION
  
  C<List::Util> contains a selection of subroutines that people have expressed
  would be nice to have in the perl core, but the usage would not really be high
  enough to warrant the use of a keyword, and the size so small such that being
  individual extensions would be wasteful.
  
  By default C<List::Util> does not export any subroutines.
  
  =cut
  
  =head1 LIST-REDUCTION FUNCTIONS
  
  The following set of functions all apply a given block of code to a list of
  values.
  
  =cut
  
  =head2 reduce
  
      $result = reduce { BLOCK } @list
  
  Reduces C<@list> by calling C<BLOCK> in a scalar context multiple times,
  setting C<$a> and C<$b> each time. The first call will be with C<$a> and C<$b>
  set to the first two elements of the list, subsequent calls will be done by
  setting C<$a> to the result of the previous call and C<$b> to the next element
  in the list.
  
  Returns the result of the last call to the C<BLOCK>. If C<@list> is empty then
  C<undef> is returned. If C<@list> only contains one element then that element
  is returned and C<BLOCK> is not executed.
  
  The following examples all demonstrate how C<reduce> could be used to implement
  the other list-reduction functions in this module. (They are not in fact
  implemented like this, but instead in a more efficient manner in individual C
  functions).
  
      $foo = reduce { defined($a)            ? $a :
                      $code->(local $_ = $b) ? $b :
                                               undef } undef, @list # first
  
      $foo = reduce { $a > $b ? $a : $b } 1..10       # max
      $foo = reduce { $a gt $b ? $a : $b } 'A'..'Z'   # maxstr
      $foo = reduce { $a < $b ? $a : $b } 1..10       # min
      $foo = reduce { $a lt $b ? $a : $b } 'aa'..'zz' # minstr
      $foo = reduce { $a + $b } 1 .. 10               # sum
      $foo = reduce { $a . $b } @bar                  # concat
  
      $foo = reduce { $a || $code->(local $_ = $b) } 0, @bar   # any
      $foo = reduce { $a && $code->(local $_ = $b) } 1, @bar   # all
      $foo = reduce { $a && !$code->(local $_ = $b) } 1, @bar  # none
      $foo = reduce { $a || !$code->(local $_ = $b) } 0, @bar  # notall
         # Note that these implementations do not fully short-circuit
  
  If your algorithm requires that C<reduce> produce an identity value, then make
  sure that you always pass that identity value as the first argument to prevent
  C<undef> being returned
  
    $foo = reduce { $a + $b } 0, @values;             # sum with 0 identity value
  
  The above example code blocks also suggest how to use C<reduce> to build a
  more efficient combined version of one of these basic functions and a C<map>
  block. For example, to find the total length of all the strings in a list,
  we could use
  
      $total = sum map { length } @strings;
  
  However, this produces a list of temporary integer values as long as the
  original list of strings, only to reduce it down to a single value again. We
  can compute the same result more efficiently by using C<reduce> with a code
  block that accumulates lengths by writing this instead as:
  
      $total = reduce { $a + length $b } 0, @strings
  
  The other scalar-returning list reduction functions are all specialisations of
  this generic idea.
  
  =head2 reductions
  
      @results = reductions { BLOCK } @list
  
  I<Since version 1.54.>
  
  Similar to C<reduce> except that it also returns the intermediate values along
  with the final result. As before, C<$a> is set to the first element of the
  given list, and the C<BLOCK> is then called once for remaining item in the
  list set into C<$b>, with the result being captured for return as well as
  becoming the new value for C<$a>.
  
  The returned list will begin with the initial value for C<$a>, followed by
  each return value from the block in order. The final value of the result will
  be identical to what the C<reduce> function would have returned given the same
  block and list.
  
      reduce     { "$a-$b" }  "a".."d"    # "a-b-c-d"
      reductions { "$a-$b" }  "a".."d"    # "a", "a-b", "a-b-c", "a-b-c-d"
  
  =head2 any
  
      my $bool = any { BLOCK } @list;
  
  I<Since version 1.33.>
  
  Similar to C<grep> in that it evaluates C<BLOCK> setting C<$_> to each element
  of C<@list> in turn. C<any> returns true if any element makes the C<BLOCK>
  return a true value. If C<BLOCK> never returns true or C<@list> was empty then
  it returns false.
  
  Many cases of using C<grep> in a conditional can be written using C<any>
  instead, as it can short-circuit after the first true result.
  
      if( any { length > 10 } @strings ) {
          # at least one string has more than 10 characters
      }
  
  Note: Due to XS issues the block passed may be able to access the outer @_
  directly. This is not intentional and will break under debugger.
  
  =head2 all
  
      my $bool = all { BLOCK } @list;
  
  I<Since version 1.33.>
  
  Similar to L</any>, except that it requires all elements of the C<@list> to
  make the C<BLOCK> return true. If any element returns false, then it returns
  false. If the C<BLOCK> never returns false or the C<@list> was empty then it
  returns true.
  
  Note: Due to XS issues the block passed may be able to access the outer @_
  directly. This is not intentional and will break under debugger.
  
  =head2 none
  
  =head2 notall
  
      my $bool = none { BLOCK } @list;
  
      my $bool = notall { BLOCK } @list;
  
  I<Since version 1.33.>
  
  Similar to L</any> and L</all>, but with the return sense inverted. C<none>
  returns true only if no value in the C<@list> causes the C<BLOCK> to return
  true, and C<notall> returns true only if not all of the values do.
  
  Note: Due to XS issues the block passed may be able to access the outer @_
  directly. This is not intentional and will break under debugger.
  
  =head2 first
  
      my $val = first { BLOCK } @list;
  
  Similar to C<grep> in that it evaluates C<BLOCK> setting C<$_> to each element
  of C<@list> in turn. C<first> returns the first element where the result from
  C<BLOCK> is a true value. If C<BLOCK> never returns true or C<@list> was empty
  then C<undef> is returned.
  
      $foo = first { defined($_) } @list    # first defined value in @list
      $foo = first { $_ > $value } @list    # first value in @list which
                                            # is greater than $value
  
  =head2 max
  
      my $num = max @list;
  
  Returns the entry in the list with the highest numerical value. If the list is
  empty then C<undef> is returned.
  
      $foo = max 1..10                # 10
      $foo = max 3,9,12               # 12
      $foo = max @bar, @baz           # whatever
  
  =head2 maxstr
  
      my $str = maxstr @list;
  
  Similar to L</max>, but treats all the entries in the list as strings and
  returns the highest string as defined by the C<gt> operator. If the list is
  empty then C<undef> is returned.
  
      $foo = maxstr 'A'..'Z'          # 'Z'
      $foo = maxstr "hello","world"   # "world"
      $foo = maxstr @bar, @baz        # whatever
  
  =head2 min
  
      my $num = min @list;
  
  Similar to L</max> but returns the entry in the list with the lowest numerical
  value. If the list is empty then C<undef> is returned.
  
      $foo = min 1..10                # 1
      $foo = min 3,9,12               # 3
      $foo = min @bar, @baz           # whatever
  
  =head2 minstr
  
      my $str = minstr @list;
  
  Similar to L</min>, but treats all the entries in the list as strings and
  returns the lowest string as defined by the C<lt> operator. If the list is
  empty then C<undef> is returned.
  
      $foo = minstr 'A'..'Z'          # 'A'
      $foo = minstr "hello","world"   # "hello"
      $foo = minstr @bar, @baz        # whatever
  
  =head2 product
  
      my $num = product @list;
  
  I<Since version 1.35.>
  
  Returns the numerical product of all the elements in C<@list>. If C<@list> is
  empty then C<1> is returned.
  
      $foo = product 1..10            # 3628800
      $foo = product 3,9,12           # 324
  
  =head2 sum
  
      my $num_or_undef = sum @list;
  
  Returns the numerical sum of all the elements in C<@list>. For backwards
  compatibility, if C<@list> is empty then C<undef> is returned.
  
      $foo = sum 1..10                # 55
      $foo = sum 3,9,12               # 24
      $foo = sum @bar, @baz           # whatever
  
  =head2 sum0
  
      my $num = sum0 @list;
  
  I<Since version 1.26.>
  
  Similar to L</sum>, except this returns 0 when given an empty list, rather
  than C<undef>.
  
  =cut
  
  =head1 KEY/VALUE PAIR LIST FUNCTIONS
  
  The following set of functions, all inspired by L<List::Pairwise>, consume an
  even-sized list of pairs. The pairs may be key/value associations from a hash,
  or just a list of values. The functions will all preserve the original ordering
  of the pairs, and will not be confused by multiple pairs having the same "key"
  value - nor even do they require that the first of each pair be a plain string.
  
  B<NOTE>: At the time of writing, the following C<pair*> functions that take a
  block do not modify the value of C<$_> within the block, and instead operate
  using the C<$a> and C<$b> globals instead. This has turned out to be a poor
  design, as it precludes the ability to provide a C<pairsort> function. Better
  would be to pass pair-like objects as 2-element array references in C<$_>, in
  a style similar to the return value of the C<pairs> function. At some future
  version this behaviour may be added.
  
  Until then, users are alerted B<NOT> to rely on the value of C<$_> remaining
  unmodified between the outside and the inside of the control block. In
  particular, the following example is B<UNSAFE>:
  
   my @kvlist = ...
  
   foreach (qw( some keys here )) {
      my @items = pairgrep { $a eq $_ } @kvlist;
      ...
   }
  
  Instead, write this using a lexical variable:
  
   foreach my $key (qw( some keys here )) {
      my @items = pairgrep { $a eq $key } @kvlist;
      ...
   }
  
  =cut
  
  =head2 pairs
  
      my @pairs = pairs @kvlist;
  
  I<Since version 1.29.>
  
  A convenient shortcut to operating on even-sized lists of pairs, this function
  returns a list of C<ARRAY> references, each containing two items from the
  given list. It is a more efficient version of
  
      @pairs = pairmap { [ $a, $b ] } @kvlist
  
  It is most convenient to use in a C<foreach> loop, for example:
  
      foreach my $pair ( pairs @kvlist ) {
         my ( $key, $value ) = @$pair;
         ...
      }
  
  Since version C<1.39> these C<ARRAY> references are blessed objects,
  recognising the two methods C<key> and C<value>. The following code is
  equivalent:
  
      foreach my $pair ( pairs @kvlist ) {
         my $key   = $pair->key;
         my $value = $pair->value;
         ...
      }
  
  Since version C<1.51> they also have a C<TO_JSON> method to ease
  serialisation.
  
  =head2 unpairs
  
      my @kvlist = unpairs @pairs
  
  I<Since version 1.42.>
  
  The inverse function to C<pairs>; this function takes a list of C<ARRAY>
  references containing two elements each, and returns a flattened list of the
  two values from each of the pairs, in order. This is notionally equivalent to
  
      my @kvlist = map { @{$_}[0,1] } @pairs
  
  except that it is implemented more efficiently internally. Specifically, for
  any input item it will extract exactly two values for the output list; using
  C<undef> if the input array references are short.
  
  Between C<pairs> and C<unpairs>, a higher-order list function can be used to
  operate on the pairs as single scalars; such as the following near-equivalents
  of the other C<pair*> higher-order functions:
  
      @kvlist = unpairs grep { FUNC } pairs @kvlist
      # Like pairgrep, but takes $_ instead of $a and $b
  
      @kvlist = unpairs map { FUNC } pairs @kvlist
      # Like pairmap, but takes $_ instead of $a and $b
  
  Note however that these versions will not behave as nicely in scalar context.
  
  Finally, this technique can be used to implement a sort on a keyvalue pair
  list; e.g.:
  
      @kvlist = unpairs sort { $a->key cmp $b->key } pairs @kvlist
  
  =head2 pairkeys
  
      my @keys = pairkeys @kvlist;
  
  I<Since version 1.29.>
  
  A convenient shortcut to operating on even-sized lists of pairs, this function
  returns a list of the the first values of each of the pairs in the given list.
  It is a more efficient version of
  
      @keys = pairmap { $a } @kvlist
  
  =head2 pairvalues
  
      my @values = pairvalues @kvlist;
  
  I<Since version 1.29.>
  
  A convenient shortcut to operating on even-sized lists of pairs, this function
  returns a list of the the second values of each of the pairs in the given list.
  It is a more efficient version of
  
      @values = pairmap { $b } @kvlist
  
  =head2 pairgrep
  
      my @kvlist = pairgrep { BLOCK } @kvlist;
  
      my $count = pairgrep { BLOCK } @kvlist;
  
  I<Since version 1.29.>
  
  Similar to perl's C<grep> keyword, but interprets the given list as an
  even-sized list of pairs. It invokes the C<BLOCK> multiple times, in scalar
  context, with C<$a> and C<$b> set to successive pairs of values from the
  C<@kvlist>.
  
  Returns an even-sized list of those pairs for which the C<BLOCK> returned true
  in list context, or the count of the B<number of pairs> in scalar context.
  (Note, therefore, in scalar context that it returns a number half the size of
  the count of items it would have returned in list context).
  
      @subset = pairgrep { $a =~ m/^[[:upper:]]+$/ } @kvlist
  
  As with C<grep> aliasing C<$_> to list elements, C<pairgrep> aliases C<$a> and
  C<$b> to elements of the given list. Any modifications of it by the code block
  will be visible to the caller.
  
  =head2 pairfirst
  
      my ( $key, $val ) = pairfirst { BLOCK } @kvlist;
  
      my $found = pairfirst { BLOCK } @kvlist;
  
  I<Since version 1.30.>
  
  Similar to the L</first> function, but interprets the given list as an
  even-sized list of pairs. It invokes the C<BLOCK> multiple times, in scalar
  context, with C<$a> and C<$b> set to successive pairs of values from the
  C<@kvlist>.
  
  Returns the first pair of values from the list for which the C<BLOCK> returned
  true in list context, or an empty list of no such pair was found. In scalar
  context it returns a simple boolean value, rather than either the key or the
  value found.
  
      ( $key, $value ) = pairfirst { $a =~ m/^[[:upper:]]+$/ } @kvlist
  
  As with C<grep> aliasing C<$_> to list elements, C<pairfirst> aliases C<$a> and
  C<$b> to elements of the given list. Any modifications of it by the code block
  will be visible to the caller.
  
  =head2 pairmap
  
      my @list = pairmap { BLOCK } @kvlist;
  
      my $count = pairmap { BLOCK } @kvlist;
  
  I<Since version 1.29.>
  
  Similar to perl's C<map> keyword, but interprets the given list as an
  even-sized list of pairs. It invokes the C<BLOCK> multiple times, in list
  context, with C<$a> and C<$b> set to successive pairs of values from the
  C<@kvlist>.
  
  Returns the concatenation of all the values returned by the C<BLOCK> in list
  context, or the count of the number of items that would have been returned in
  scalar context.
  
      @result = pairmap { "The key $a has value $b" } @kvlist
  
  As with C<map> aliasing C<$_> to list elements, C<pairmap> aliases C<$a> and
  C<$b> to elements of the given list. Any modifications of it by the code block
  will be visible to the caller.
  
  See L</KNOWN BUGS> for a known-bug with C<pairmap>, and a workaround.
  
  =cut
  
  =head1 OTHER FUNCTIONS
  
  =cut
  
  =head2 shuffle
  
      my @values = shuffle @values;
  
  Returns the values of the input in a random order
  
      @cards = shuffle 0..51      # 0..51 in a random order
  
  This function is affected by the C<$RAND> variable.
  
  =cut
  
  =head2 sample
  
      my @items = sample $count, @values
  
  I<Since version 1.54.>
  
  Randomly select the given number of elements from the input list. Any given
  position in the input list will be selected at most once.
  
  If there are fewer than C<$count> items in the list then the function will
  return once all of them have been randomly selected; effectively the function
  behaves similarly to L</shuffle>.
  
  This function is affected by the C<$RAND> variable.
  
  =head2 uniq
  
      my @subset = uniq @values
  
  I<Since version 1.45.>
  
  Filters a list of values to remove subsequent duplicates, as judged by a
  DWIM-ish string equality or C<undef> test. Preserves the order of unique
  elements, and retains the first value of any duplicate set.
  
      my $count = uniq @values
  
  In scalar context, returns the number of elements that would have been
  returned as a list.
  
  The C<undef> value is treated by this function as distinct from the empty
  string, and no warning will be produced. It is left as-is in the returned
  list. Subsequent C<undef> values are still considered identical to the first,
  and will be removed.
  
  =head2 uniqint
  
      my @subset = uniqint @values
  
  I<Since version 1.55.>
  
  Filters a list of values to remove subsequent duplicates, as judged by an
  integer numerical equality test. Preserves the order of unique elements, and
  retains the first value of any duplicate set. Values in the returned list will
  be coerced into integers.
  
      my $count = uniqint @values
  
  In scalar context, returns the number of elements that would have been
  returned as a list.
  
  Note that C<undef> is treated much as other numerical operations treat it; it
  compares equal to zero but additionally produces a warning if such warnings
  are enabled (C<use warnings 'uninitialized';>). In addition, an C<undef> in
  the returned list is coerced into a numerical zero, so that the entire list of
  values returned by C<uniqint> are well-behaved as integers.
  
  =head2 uniqnum
  
      my @subset = uniqnum @values
  
  I<Since version 1.44.>
  
  Filters a list of values to remove subsequent duplicates, as judged by a
  numerical equality test. Preserves the order of unique elements, and retains
  the first value of any duplicate set.
  
      my $count = uniqnum @values
  
  In scalar context, returns the number of elements that would have been
  returned as a list.
  
  Note that C<undef> is treated much as other numerical operations treat it; it
  compares equal to zero but additionally produces a warning if such warnings
  are enabled (C<use warnings 'uninitialized';>). In addition, an C<undef> in
  the returned list is coerced into a numerical zero, so that the entire list of
  values returned by C<uniqnum> are well-behaved as numbers.
  
  Note also that multiple IEEE C<NaN> values are treated as duplicates of
  each other, regardless of any differences in their payloads, and despite
  the fact that C<< 0+'NaN' == 0+'NaN' >> yields false.
  
  =head2 uniqstr
  
      my @subset = uniqstr @values
  
  I<Since version 1.45.>
  
  Filters a list of values to remove subsequent duplicates, as judged by a
  string equality test. Preserves the order of unique elements, and retains the
  first value of any duplicate set.
  
      my $count = uniqstr @values
  
  In scalar context, returns the number of elements that would have been
  returned as a list.
  
  Note that C<undef> is treated much as other string operations treat it; it
  compares equal to the empty string but additionally produces a warning if such
  warnings are enabled (C<use warnings 'uninitialized';>). In addition, an
  C<undef> in the returned list is coerced into an empty string, so that the
  entire list of values returned by C<uniqstr> are well-behaved as strings.
  
  =cut
  
  =head2 head
  
      my @values = head $size, @list;
  
  I<Since version 1.50.>
  
  Returns the first C<$size> elements from C<@list>. If C<$size> is negative, returns
  all but the last C<$size> elements from C<@list>.
  
      @result = head 2, qw( foo bar baz );
      # foo, bar
  
      @result = head -2, qw( foo bar baz );
      # foo
  
  =head2 tail
  
      my @values = tail $size, @list;
  
  I<Since version 1.50.>
  
  Returns the last C<$size> elements from C<@list>. If C<$size> is negative, returns
  all but the first C<$size> elements from C<@list>.
  
      @result = tail 2, qw( foo bar baz );
      # bar, baz
  
      @result = tail -2, qw( foo bar baz );
      # baz
  
  =head2 zip
  
      my @result = zip [1..3], ['a'..'c'];
      # [1, 'a'], [2, 'b'], [3, 'c']
  
  I<Since version 1.56.>
  
  Returns a list of array references, composed of elements from the given list
  of array references. Each array in the returned list is composed of elements
  at that corresponding position from each of the given input arrays. If any
  input arrays run out of elements before others, then C<undef> will be inserted
  into the result to fill in the gaps.
  
  The C<zip> function is particularly handy for iterating over multiple arrays
  at the same time with a C<foreach> loop, taking one element from each:
  
      foreach ( zip \@xs, \@ys, \@zs ) {
          my ($x, $y, $z) = @$_;
          ...
      }
  
  B<NOTE> to users of L<List::MoreUtils>: This function does not behave the same
  as C<List::MoreUtils::zip>, but is actually a non-prototyped equivalent to
  C<List::MoreUtils::zip_unflatten>. This function does not apply a prototype,
  so make sure to invoke it with references to arrays.
  
  For a function similar to the C<zip> function from C<List::MoreUtils>, see
  L<mesh>.
  
      my @result = zip_shortest ...
  
  A variation of the function that differs in how it behaves when given input
  arrays of differing lengths. C<zip_shortest> will stop as soon as any one of
  the input arrays run out of elements, discarding any remaining unused values
  from the others.
  
      my @result = zip_longest ...
  
  C<zip_longest> is an alias to the C<zip> function, provided simply to be
  explicit about that behaviour as compared to C<zip_shortest>.
  
  =head2 mesh
  
      my @result = mesh [1..3], ['a'..'c'];
      # (1, 'a', 2, 'b', 3, 'c')
  
  I<Since version 1.56.>
  
  Returns a list of items collected from elements of the given list of array
  references. Each section of items in the returned list is composed of elements
  at the corresponding position from each of the given input arrays. If any
  input arrays run out of elements before others, then C<undef> will be inserted
  into the result to fill in the gaps.
  
  This is similar to L<zip>, except that all of the ranges in the result are
  returned in one long flattened list, instead of being bundled into separate
  arrays.
  
  Because it returns a flat list of items, the C<mesh> function is particularly
  useful for building a hash out of two separate arrays of keys and values:
  
      my %hash = mesh \@keys, \@values;
  
      my $href = { mesh \@keys, \@values };
  
  B<NOTE> to users of L<List::MoreUtils>: This function is a non-prototyped
  equivalent to C<List::MoreUtils::mesh> or C<List::MoreUtils::zip> (themselves
  aliases of each other). This function does not apply a prototype, so make sure
  to invoke it with references to arrays.
  
      my @result = mesh_shortest ...
  
      my @result = mesh_longest ...
  
  These variations are similar to those of L<zip>, in that they differ in
  behaviour when one of the input lists runs out of elements before the others.
  
  =head1 CONFIGURATION VARIABLES
  
  =head2 $RAND
  
      local $List::Util::RAND = sub { ... };
  
  I<Since version 1.54.>
  
  This package variable is used by code which needs to generate random numbers
  (such as the L</shuffle> and L</sample> functions). If set to a CODE reference
  it provides an alternative to perl's builtin C<rand()> function. When a new
  random number is needed this function will be invoked with no arguments and is
  expected to return a floating-point value, of which only the fractional part
  will be used.
  
  =head1 KNOWN BUGS
  
  =head2 RT #95409
  
  L<https://rt.cpan.org/Ticket/Display.html?id=95409>
  
  If the block of code given to L</pairmap> contains lexical variables that are
  captured by a returned closure, and the closure is executed after the block
  has been re-used for the next iteration, these lexicals will not see the
  correct values. For example:
  
   my @subs = pairmap {
      my $var = "$a is $b";
      sub { print "$var\n" };
   } one => 1, two => 2, three => 3;
  
   $_->() for @subs;
  
  Will incorrectly print
  
   three is 3
   three is 3
   three is 3
  
  This is due to the performance optimisation of using C<MULTICALL> for the code
  block, which means that fresh SVs do not get allocated for each call to the
  block. Instead, the same SV is re-assigned for each iteration, and all the
  closures will share the value seen on the final iteration.
  
  To work around this bug, surround the code with a second set of braces. This
  creates an inner block that defeats the C<MULTICALL> logic, and does get fresh
  SVs allocated each time:
  
   my @subs = pairmap {
      {
         my $var = "$a is $b";
         sub { print "$var\n"; }
      }
   } one => 1, two => 2, three => 3;
  
  This bug only affects closures that are generated by the block but used
  afterwards. Lexical variables that are only used during the lifetime of the
  block's execution will take their individual values for each invocation, as
  normal.
  
  =head2 uniqnum() on oversized bignums
  
  Due to the way that C<uniqnum()> compares numbers, it cannot distinguish
  differences between bignums (especially bigints) that are too large to fit in
  the native platform types. For example,
  
   my $x = Math::BigInt->new( "1" x 100 );
   my $y = $x + 1;
  
   say for uniqnum( $x, $y );
  
  Will print just the value of C<$x>, believing that C<$y> is a numerically-
  equivalent value. This bug does not affect C<uniqstr()>, which will correctly
  observe that the two values stringify to different strings.
  
  =head1 SUGGESTED ADDITIONS
  
  The following are additions that have been requested, but I have been reluctant
  to add due to them being very simple to implement in perl
  
    # How many elements are true
  
    sub true { scalar grep { $_ } @_ }
  
    # How many elements are false
  
    sub false { scalar grep { !$_ } @_ }
  
  =head1 SEE ALSO
  
  L<Scalar::Util>, L<List::MoreUtils>
  
  =head1 COPYRIGHT
  
  Copyright (c) 1997-2007 Graham Barr <gbarr@pobox.com>. All rights reserved.
  This program is free software; you can redistribute it and/or
  modify it under the same terms as Perl itself.
  
  Recent additions and current maintenance by
  Paul Evans, <leonerd@leonerd.org.uk>.
  
  =cut
  
  1;
X86_64-LINUX-GNU-THREAD-MULTI_LIST_UTIL

$fatpacked{"x86_64-linux-gnu-thread-multi/List/Util/XS.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'X86_64-LINUX-GNU-THREAD-MULTI_LIST_UTIL_XS';
  package List::Util::XS;
  use strict;
  use warnings;
  use List::Util;
  
  our $VERSION = "1.59";       # FIXUP
  $VERSION =~ tr/_//d;         # FIXUP
  
  1;
  __END__
  
  =head1 NAME
  
  List::Util::XS - Indicate if List::Util was compiled with a C compiler
  
  =head1 SYNOPSIS
  
      use List::Util::XS 1.20;
  
  =head1 DESCRIPTION
  
  C<List::Util::XS> can be used as a dependency to ensure List::Util was
  installed using a C compiler and that the XS version is installed.
  
  During installation C<$List::Util::XS::VERSION> will be set to
  C<undef> if the XS was not compiled.
  
  Starting with release 1.23_03, Scalar-List-Util is B<always> using
  the XS implementation, but for backwards compatibility, we still
  ship the C<List::Util::XS> module which just loads C<List::Util>.
  
  =head1 SEE ALSO
  
  L<Scalar::Util>, L<List::Util>, L<List::MoreUtils>
  
  =head1 COPYRIGHT
  
  Copyright (c) 2008 Graham Barr <gbarr@pobox.com>. All rights reserved.
  This program is free software; you can redistribute it and/or
  modify it under the same terms as Perl itself.
  
  =cut
X86_64-LINUX-GNU-THREAD-MULTI_LIST_UTIL_XS

$fatpacked{"x86_64-linux-gnu-thread-multi/Scalar/Util.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'X86_64-LINUX-GNU-THREAD-MULTI_SCALAR_UTIL';
  # Copyright (c) 1997-2007 Graham Barr <gbarr@pobox.com>. All rights reserved.
  # This program is free software; you can redistribute it and/or
  # modify it under the same terms as Perl itself.
  #
  # Maintained since 2013 by Paul Evans <leonerd@leonerd.org.uk>
  
  package Scalar::Util;
  
  use strict;
  use warnings;
  require Exporter;
  
  our @ISA       = qw(Exporter);
  our @EXPORT_OK = qw(
    blessed refaddr reftype weaken unweaken isweak
  
    dualvar isdual isvstring looks_like_number openhandle readonly set_prototype
    tainted
  );
  our $VERSION    = "1.59";
  $VERSION =~ tr/_//d;
  
  require List::Util; # List::Util loads the XS
  List::Util->VERSION( $VERSION ); # Ensure we got the right XS version (RT#100863)
  
  # populating @EXPORT_FAIL is done in the XS code
  sub export_fail {
    if (grep { /^isvstring$/ } @_ ) {
      require Carp;
      Carp::croak("Vstrings are not implemented in this version of perl");
    }
  
    @_;
  }
  
  # set_prototype has been moved to Sub::Util with a different interface
  sub set_prototype(&$)
  {
    my ( $code, $proto ) = @_;
    return Sub::Util::set_prototype( $proto, $code );
  }
  
  1;
  
  __END__
  
  =head1 NAME
  
  Scalar::Util - A selection of general-utility scalar subroutines
  
  =head1 SYNOPSIS
  
      use Scalar::Util qw(blessed dualvar isdual readonly refaddr reftype
                          tainted weaken isweak isvstring looks_like_number
                          set_prototype);
                          # and other useful utils appearing below
  
  =head1 DESCRIPTION
  
  C<Scalar::Util> contains a selection of subroutines that people have expressed
  would be nice to have in the perl core, but the usage would not really be high
  enough to warrant the use of a keyword, and the size would be so small that 
  being individual extensions would be wasteful.
  
  By default C<Scalar::Util> does not export any subroutines.
  
  =cut
  
  =head1 FUNCTIONS FOR REFERENCES
  
  The following functions all perform some useful activity on reference values.
  
  =head2 blessed
  
      my $pkg = blessed( $ref );
  
  If C<$ref> is a blessed reference, the name of the package that it is blessed
  into is returned. Otherwise C<undef> is returned.
  
      $scalar = "foo";
      $class  = blessed $scalar;           # undef
  
      $ref    = [];
      $class  = blessed $ref;              # undef
  
      $obj    = bless [], "Foo";
      $class  = blessed $obj;              # "Foo"
  
  Take care when using this function simply as a truth test (such as in
  C<if(blessed $ref)...>) because the package name C<"0"> is defined yet false.
  
  =head2 refaddr
  
      my $addr = refaddr( $ref );
  
  If C<$ref> is reference, the internal memory address of the referenced value is
  returned as a plain integer. Otherwise C<undef> is returned.
  
      $addr = refaddr "string";           # undef
      $addr = refaddr \$var;              # eg 12345678
      $addr = refaddr [];                 # eg 23456784
  
      $obj  = bless {}, "Foo";
      $addr = refaddr $obj;               # eg 88123488
  
  =head2 reftype
  
      my $type = reftype( $ref );
  
  If C<$ref> is a reference, the basic Perl type of the variable referenced is
  returned as a plain string (such as C<ARRAY> or C<HASH>). Otherwise C<undef>
  is returned.
  
      $type = reftype "string";           # undef
      $type = reftype \$var;              # SCALAR
      $type = reftype [];                 # ARRAY
  
      $obj  = bless {}, "Foo";
      $type = reftype $obj;               # HASH
  
  Note that for internal reasons, all precompiled regexps (C<qr/.../>) are
  blessed references; thus C<ref()> returns the package name string C<"Regexp">
  on these but C<reftype()> will return the underlying C structure type of
  C<"REGEXP"> in all capitals.
  
  =head2 weaken
  
      weaken( $ref );
  
  The lvalue C<$ref> will be turned into a weak reference. This means that it
  will not hold a reference count on the object it references. Also, when the
  reference count on that object reaches zero, the reference will be set to
  undef. This function mutates the lvalue passed as its argument and returns no
  value.
  
  This is useful for keeping copies of references, but you don't want to prevent
  the object being DESTROY-ed at its usual time.
  
      {
        my $var;
        $ref = \$var;
        weaken($ref);                     # Make $ref a weak reference
      }
      # $ref is now undef
  
  Note that if you take a copy of a scalar with a weakened reference, the copy
  will be a strong reference.
  
      my $var;
      my $foo = \$var;
      weaken($foo);                       # Make $foo a weak reference
      my $bar = $foo;                     # $bar is now a strong reference
  
  This may be less obvious in other situations, such as C<grep()>, for instance
  when grepping through a list of weakened references to objects that may have
  been destroyed already:
  
      @object = grep { defined } @object;
  
  This will indeed remove all references to destroyed objects, but the remaining
  references to objects will be strong, causing the remaining objects to never be
  destroyed because there is now always a strong reference to them in the @object
  array.
  
  =head2 unweaken
  
      unweaken( $ref );
  
  I<Since version 1.36.>
  
  The lvalue C<REF> will be turned from a weak reference back into a normal
  (strong) reference again. This function mutates the lvalue passed as its
  argument and returns no value. This undoes the action performed by
  L</weaken>.
  
  This function is slightly neater and more convenient than the
  otherwise-equivalent code
  
      my $tmp = $REF;
      undef $REF;
      $REF = $tmp;
  
  (because in particular, simply assigning a weak reference back to itself does
  not work to unweaken it; C<$REF = $REF> does not work).
  
  =head2 isweak
  
      my $weak = isweak( $ref );
  
  Returns true if C<$ref> is a weak reference.
  
      $ref  = \$foo;
      $weak = isweak($ref);               # false
      weaken($ref);
      $weak = isweak($ref);               # true
  
  B<NOTE>: Copying a weak reference creates a normal, strong, reference.
  
      $copy = $ref;
      $weak = isweak($copy);              # false
  
  =head1 OTHER FUNCTIONS
  
  =head2 dualvar
  
      my $var = dualvar( $num, $string );
  
  Returns a scalar that has the value C<$num> in a numeric context and the value
  C<$string> in a string context.
  
      $foo = dualvar 10, "Hello";
      $num = $foo + 2;                    # 12
      $str = $foo . " world";             # Hello world
  
  =head2 isdual
  
      my $dual = isdual( $var );
  
  I<Since version 1.26.>
  
  If C<$var> is a scalar that has both numeric and string values, the result is
  true.
  
      $foo = dualvar 86, "Nix";
      $dual = isdual($foo);               # true
  
  Note that a scalar can be made to have both string and numeric content through
  standard operations:
  
      $foo = "10";
      $dual = isdual($foo);               # false
      $bar = $foo + 0;
      $dual = isdual($foo);               # true
  
  The C<$!> variable is commonly dual-valued, though it is also magical in other
  ways:
  
      $! = 1;
      $dual = isdual($!);                 # true
      print("$!\n");                      # "Operation not permitted"
  
  B<CAUTION>: This function is not as useful as it may seem. Dualvars are not a
  distinct concept in Perl, but a standard internal construct of all scalar
  values. Almost any value could be considered as a dualvar by this function
  through the course of normal operations.
  
  =head2 isvstring
  
      my $vstring = isvstring( $var );
  
  If C<$var> is a scalar which was coded as a vstring, the result is true.
  
      $vs   = v49.46.48;
      $fmt  = isvstring($vs) ? "%vd" : "%s"; #true
      printf($fmt,$vs);
  
  =head2 looks_like_number
  
      my $isnum = looks_like_number( $var );
  
  Returns true if perl thinks C<$var> is a number. See
  L<perlapi/looks_like_number>.
  
  =head2 openhandle
  
      my $fh = openhandle( $fh );
  
  Returns C<$fh> itself, if C<$fh> may be used as a filehandle and is open, or if
  it is a tied handle. Otherwise C<undef> is returned.
  
      $fh = openhandle(*STDIN);           # \*STDIN
      $fh = openhandle(\*STDIN);          # \*STDIN
      $fh = openhandle(*NOTOPEN);         # undef
      $fh = openhandle("scalar");         # undef
  
  =head2 readonly
  
      my $ro = readonly( $var );
  
  Returns true if C<$var> is readonly.
  
      sub foo { readonly($_[0]) }
  
      $readonly = foo($bar);              # false
      $readonly = foo(0);                 # true
  
  =head2 set_prototype
  
      my $code = set_prototype( $code, $prototype );
  
  Sets the prototype of the function given by the C<$code> reference, or deletes
  it if C<$prototype> is C<undef>. Returns the C<$code> reference itself.
  
      set_prototype \&foo, '$$';
  
  =head2 tainted
  
      my $t = tainted( $var );
  
  Return true if C<$var> is tainted.
  
      $taint = tainted("constant");       # false
      $taint = tainted($ENV{PWD});        # true if running under -T
  
  =head1 DIAGNOSTICS
  
  Module use may give one of the following errors during import.
  
  =over
  
  =item Vstrings are not implemented in this version of perl
  
  The version of perl that you are using does not implement Vstrings, to use
  L</isvstring> you will need to use a newer release of perl.
  
  =back
  
  =head1 KNOWN BUGS
  
  There is a bug in perl5.6.0 with UV's that are >= 1<<31. This will
  show up as tests 8 and 9 of dualvar.t failing
  
  =head1 SEE ALSO
  
  L<List::Util>
  
  =head1 COPYRIGHT
  
  Copyright (c) 1997-2007 Graham Barr <gbarr@pobox.com>. All rights reserved.
  This program is free software; you can redistribute it and/or modify it
  under the same terms as Perl itself.
  
  Additionally L</weaken> and L</isweak> which are
  
  Copyright (c) 1999 Tuomas J. Lukka <lukka@iki.fi>. All rights reserved.
  This program is free software; you can redistribute it and/or modify it
  under the same terms as perl itself.
  
  Copyright (C) 2004, 2008  Matthijs van Duin.  All rights reserved.
  Copyright (C) 2014 cPanel Inc.  All rights reserved.
  This program is free software; you can redistribute it and/or modify
  it under the same terms as Perl itself.
  
  =cut
X86_64-LINUX-GNU-THREAD-MULTI_SCALAR_UTIL

$fatpacked{"x86_64-linux-gnu-thread-multi/Sub/Util.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'X86_64-LINUX-GNU-THREAD-MULTI_SUB_UTIL';
  # Copyright (c) 2014 Paul Evans <leonerd@leonerd.org.uk>. All rights reserved.
  # This program is free software; you can redistribute it and/or
  # modify it under the same terms as Perl itself.
  
  package Sub::Util;
  
  use strict;
  use warnings;
  
  require Exporter;
  
  our @ISA = qw( Exporter );
  our @EXPORT_OK = qw(
    prototype set_prototype
    subname set_subname
  );
  
  our $VERSION    = "1.59";
  $VERSION =~ tr/_//d;
  
  require List::Util; # as it has the XS
  List::Util->VERSION( $VERSION ); # Ensure we got the right XS version (RT#100863)
  
  =head1 NAME
  
  Sub::Util - A selection of utility subroutines for subs and CODE references
  
  =head1 SYNOPSIS
  
      use Sub::Util qw( prototype set_prototype subname set_subname );
  
  =head1 DESCRIPTION
  
  C<Sub::Util> contains a selection of utility subroutines that are useful for
  operating on subs and CODE references.
  
  The rationale for inclusion in this module is that the function performs some
  work for which an XS implementation is essential because it cannot be
  implemented in Pure Perl, and which is sufficiently-widely used across CPAN
  that its popularity warrants inclusion in a core module, which this is.
  
  =cut
  
  =head1 FUNCTIONS
  
  =cut
  
  =head2 prototype
  
      my $proto = prototype( $code )
  
  I<Since version 1.40.>
  
  Returns the prototype of the given C<$code> reference, if it has one, as a
  string. This is the same as the C<CORE::prototype> operator; it is included
  here simply for symmetry and completeness with the other functions.
  
  =cut
  
  sub prototype
  {
    my ( $code ) = @_;
    return CORE::prototype( $code );
  }
  
  =head2 set_prototype
  
      my $code = set_prototype $prototype, $code;
  
  I<Since version 1.40.>
  
  Sets the prototype of the function given by the C<$code> reference, or deletes
  it if C<$prototype> is C<undef>. Returns the C<$code> reference itself.
  
  I<Caution>: This function takes arguments in a different order to the previous
  copy of the code from C<Scalar::Util>. This is to match the order of
  C<set_subname>, and other potential additions in this file. This order has
  been chosen as it allows a neat and simple chaining of other
  C<Sub::Util::set_*> functions as might become available, such as:
  
   my $code =
      set_subname   name_here =>
      set_prototype '&@'      =>
      set_attribute ':lvalue' =>
         sub { ...... };
  
  =cut
  
  =head2 subname
  
      my $name = subname( $code )
  
  I<Since version 1.40.>
  
  Returns the name of the given C<$code> reference, if it has one. Normal named
  subs will give a fully-qualified name consisting of the package and the
  localname separated by C<::>. Anonymous code references will give C<__ANON__>
  as the localname. If the package the code was compiled in has been deleted
  (e.g. using C<delete_package> from L<Symbol>), C<__ANON__> will be returned as
  the package name. If a name has been set using L</set_subname>, this name will be
  returned instead.
  
  This function was inspired by C<sub_fullname> from L<Sub::Identify>. The
  remaining functions that C<Sub::Identify> implements can easily be emulated
  using regexp operations, such as
  
   sub get_code_info { return (subname $_[0]) =~ m/^(.+)::(.*?)$/ }
   sub sub_name      { return (get_code_info $_[0])[0] }
   sub stash_name    { return (get_code_info $_[0])[1] }
  
  I<Users of Sub::Name beware>: This function is B<not> the same as
  C<Sub::Name::subname>; it returns the existing name of the sub rather than
  changing it. To set or change a name, see instead L</set_subname>.
  
  =cut
  
  =head2 set_subname
  
      my $code = set_subname $name, $code;
  
  I<Since version 1.40.>
  
  Sets the name of the function given by the C<$code> reference. Returns the
  C<$code> reference itself. If the C<$name> is unqualified, the package of the
  caller is used to qualify it.
  
  This is useful for applying names to anonymous CODE references so that stack
  traces and similar situations, to give a useful name rather than having the
  default of C<__ANON__>. Note that this name is only used for this situation;
  the C<set_subname> will not install it into the symbol table; you will have to
  do that yourself if required.
  
  However, since the name is not used by perl except as the return value of
  C<caller>, for stack traces or similar, there is no actual requirement that
  the name be syntactically valid as a perl function name. This could be used to
  attach extra information that could be useful in debugging stack traces.
  
  This function was copied from C<Sub::Name::subname> and renamed to the naming
  convention of this module.
  
  =cut
  
  =head1 AUTHOR
  
  The general structure of this module was written by Paul Evans
  <leonerd@leonerd.org.uk>.
  
  The XS implementation of L</set_subname> was copied from L<Sub::Name> by
  Matthijs van Duin <xmath@cpan.org>
  
  =cut
  
  1;
X86_64-LINUX-GNU-THREAD-MULTI_SUB_UTIL

s/^  //mg for values %fatpacked;

my $class = 'FatPacked::'.(0+\%fatpacked);
no strict 'refs';
*{"${class}::files"} = sub { keys %{$_[0]} };

if ($] < 5.008) {
  *{"${class}::INC"} = sub {
    if (my $fat = $_[0]{$_[1]}) {
      my $pos = 0;
      my $last = length $fat;
      return (sub {
        return 0 if $pos == $last;
        my $next = (1 + index $fat, "\n", $pos) || $last;
        $_ .= substr $fat, $pos, $next - $pos;
        $pos = $next;
        return 1;
      });
    }
  };
}

else {
  *{"${class}::INC"} = sub {
    if (my $fat = $_[0]{$_[1]}) {
      open my $fh, '<', \$fat
        or die "FatPacker error loading $_[1] (could be a perl installation issue?)";
      return $fh;
    }
    return;
  };
}

unshift @INC, bless \%fatpacked, $class;
  } # END OF FATPACK CODE

use warnings;
use strict;
use App::Dex;
use Pod::Usage qw(pod2usage);
use Try::Tiny;

if ( @ARGV && ( $ARGV[0] eq '--help' || $ARGV[0] eq '-h' ) ) {
    pod2usage( -verbose => 2 );
}

my $app = App::Dex->new;

# Throw an error if we couldn't find a config file.
try { $app->config_file } catch { die "Error: No config file found.\n" };

if ( @ARGV ) {
    my $block = $app->resolve_block( [ @ARGV ] );

    if ( ! $block ) {
        if ( $ENV{DEX_FALLBACK_CMD} ) {
            exec $ENV{DEX_FALLBACK_CMD}, @ARGV;
        } else {
            print STDERR "Error: No such command.\n\n";
            $app->display_menu;
            exit -1;
        }
    }

    $app->process_block( $block );
} else {
    $app->display_menu;
}

=pod

=encoding utf8

=head1 NAME

dex - Directory Exec

=head1 DESCRIPTION

B<dex> is a command line utility to simply repeative tasks by defining them in
the specific directory you should be in when running them.

Running dex from a directory with a F<.dex.yaml> or F<dex.yaml> file will
present you with the list of named commands.


 dev                     : Control a local development server.
     start                   : Start a local development server on docker.
     stop                    : Stop a local development server on docker.
     status                  : Show the status of the local development server.
     reset                   : Delete the database volume.
 test                    : Run the tests.


Top level commands have no indentation. Each level of indentation is a child 
command.  For instance you would run C<dex dev start> to trigger 
I<Start a local development server on docker>, but only C<dex test> to trigger 
I<Run the tests>.

=head1 DEX FILE SPEC

Dex uses YAML and expects the following format:

 ---
 - name: CommandName
   desc: CommandDescription
   shell:
     - Shell String    
     - Shell String  
   children:  
     - name: SubCommandName
       desc: SubCommandDescription
       shell:
         - Shell String

The structure is infinitely nestable by adding a C<children> attribute, the
following are supported attributes:

=over 4

=item * name: The name that can be used on the command line to invoke the block

=item * desc: The description given in the menu

=item * shell: An array of shell commands to run

=item * children: An array that takes all of the same arguments, use for subcommands

=back

