#!/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.002000"; # 0.2.0
  $VERSION = eval $VERSION;
  
  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};
  
          die "There is no such command.\n"
              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
  
  =head1 DEX FILE SPECIFICATION
  
  =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{"Devel/GlobalDestruction.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'DEVEL_GLOBALDESTRUCTION';
  package Devel::GlobalDestruction;
  
  use strict;
  use warnings;
  
  our $VERSION = '0.14';
  
  use Sub::Exporter::Progressive -setup => {
    exports => [ qw(in_global_destruction) ],
    groups  => { default => [ -all ] },
  };
  
  # we run 5.14+ - everything is in core
  #
  if (defined ${^GLOBAL_PHASE}) {
    eval 'sub in_global_destruction () { ${^GLOBAL_PHASE} eq q[DESTRUCT] }; 1'
      or die $@;
  }
  # try to load the xs version if it was compiled
  #
  elsif (eval {
    require Devel::GlobalDestruction::XS;
    no warnings 'once';
    *in_global_destruction = \&Devel::GlobalDestruction::XS::in_global_destruction;
    1;
  }) {
    # the eval already installed everything, nothing to do
  }
  else {
    # internally, PL_main_cv is set to Nullcv immediately before entering
    # global destruction and we can use B to detect that.  B::main_cv will
    # only ever be a B::CV or a B::SPECIAL that is a reference to 0
    require B;
    eval 'sub in_global_destruction () { ${B::main_cv()} == 0 }; 1'
      or die $@;
  }
  
  1;  # keep require happy
  
  
  __END__
  
  =head1 NAME
  
  Devel::GlobalDestruction - Provides function returning the equivalent of
  C<${^GLOBAL_PHASE} eq 'DESTRUCT'> for older perls.
  
  =head1 SYNOPSIS
  
      package Foo;
      use Devel::GlobalDestruction;
  
      use namespace::clean; # to avoid having an "in_global_destruction" method
  
      sub DESTROY {
          return if in_global_destruction;
  
          do_something_a_little_tricky();
      }
  
  =head1 DESCRIPTION
  
  Perl's global destruction is a little tricky to deal with WRT finalizers
  because it's not ordered and objects can sometimes disappear.
  
  Writing defensive destructors is hard and annoying, and usually if global
  destruction is happening you only need the destructors that free up non
  process local resources to actually execute.
  
  For these constructors you can avoid the mess by simply bailing out if global
  destruction is in effect.
  
  =head1 EXPORTS
  
  This module uses L<Sub::Exporter::Progressive> so the exports may be renamed,
  aliased, etc. if L<Sub::Exporter> is present.
  
  =over 4
  
  =item in_global_destruction
  
  Returns true if the interpreter is in global destruction. In perl 5.14+, this
  returns C<${^GLOBAL_PHASE} eq 'DESTRUCT'>, and on earlier perls, detects it using
  the value of C<PL_main_cv> or C<PL_dirty>.
  
  =back
  
  =head1 AUTHORS
  
  Yuval Kogman E<lt>nothingmuch@woobling.orgE<gt>
  
  Florian Ragwitz E<lt>rafl@debian.orgE<gt>
  
  Jesse Luehrs E<lt>doy@tozt.netE<gt>
  
  Peter Rabbitson E<lt>ribasushi@cpan.orgE<gt>
  
  Arthur Axel 'fREW' Schmidt E<lt>frioux@gmail.comE<gt>
  
  Elizabeth Mattijsen E<lt>liz@dijkmat.nlE<gt>
  
  Greham Knop E<lt>haarg@haarg.orgE<gt>
  
  =head1 COPYRIGHT
  
      Copyright (c) 2008 Yuval Kogman. All rights reserved
      This program is free software; you can redistribute
      it and/or modify it under the same terms as Perl itself.
  
  =cut
DEVEL_GLOBALDESTRUCTION

$fatpacked{"File/Temp.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'FILE_TEMP';
  package File::Temp; # git description: v0.2308-7-g3bb4d88
  # ABSTRACT: return name and handle of a temporary file safely
  
  our $VERSION = '0.2309';
  
  #pod =begin :__INTERNALS
  #pod
  #pod =head1 PORTABILITY
  #pod
  #pod This section is at the top in order to provide easier access to
  #pod porters.  It is not expected to be rendered by a standard pod
  #pod formatting tool. Please skip straight to the SYNOPSIS section if you
  #pod are not trying to port this module to a new platform.
  #pod
  #pod This module is designed to be portable across operating systems and it
  #pod currently supports Unix, VMS, DOS, OS/2, Windows and Mac OS
  #pod (Classic). When porting to a new OS there are generally three main
  #pod issues that have to be solved:
  #pod
  #pod =over 4
  #pod
  #pod =item *
  #pod
  #pod Can the OS unlink an open file? If it can not then the
  #pod C<_can_unlink_opened_file> method should be modified.
  #pod
  #pod =item *
  #pod
  #pod Are the return values from C<stat> reliable? By default all the
  #pod return values from C<stat> are compared when unlinking a temporary
  #pod file using the filename and the handle. Operating systems other than
  #pod unix do not always have valid entries in all fields. If utility function
  #pod C<File::Temp::unlink0> fails then the C<stat> comparison should be
  #pod modified accordingly.
  #pod
  #pod =item *
  #pod
  #pod Security. Systems that can not support a test for the sticky bit
  #pod on a directory can not use the MEDIUM and HIGH security tests.
  #pod The C<_can_do_level> method should be modified accordingly.
  #pod
  #pod =back
  #pod
  #pod =end :__INTERNALS
  #pod
  #pod =head1 SYNOPSIS
  #pod
  #pod   use File::Temp qw/ tempfile tempdir /;
  #pod
  #pod   $fh = tempfile();
  #pod   ($fh, $filename) = tempfile();
  #pod
  #pod   ($fh, $filename) = tempfile( $template, DIR => $dir);
  #pod   ($fh, $filename) = tempfile( $template, SUFFIX => '.dat');
  #pod   ($fh, $filename) = tempfile( $template, TMPDIR => 1 );
  #pod
  #pod   binmode( $fh, ":utf8" );
  #pod
  #pod   $dir = tempdir( CLEANUP => 1 );
  #pod   ($fh, $filename) = tempfile( DIR => $dir );
  #pod
  #pod Object interface:
  #pod
  #pod   require File::Temp;
  #pod   use File::Temp ();
  #pod   use File::Temp qw/ :seekable /;
  #pod
  #pod   $fh = File::Temp->new();
  #pod   $fname = $fh->filename;
  #pod
  #pod   $fh = File::Temp->new(TEMPLATE => $template);
  #pod   $fname = $fh->filename;
  #pod
  #pod   $tmp = File::Temp->new( UNLINK => 0, SUFFIX => '.dat' );
  #pod   print $tmp "Some data\n";
  #pod   print "Filename is $tmp\n";
  #pod   $tmp->seek( 0, SEEK_END );
  #pod
  #pod   $dir = File::Temp->newdir(); # CLEANUP => 1 by default
  #pod
  #pod The following interfaces are provided for compatibility with
  #pod existing APIs. They should not be used in new code.
  #pod
  #pod MkTemp family:
  #pod
  #pod   use File::Temp qw/ :mktemp  /;
  #pod
  #pod   ($fh, $file) = mkstemp( "tmpfileXXXXX" );
  #pod   ($fh, $file) = mkstemps( "tmpfileXXXXXX", $suffix);
  #pod
  #pod   $tmpdir = mkdtemp( $template );
  #pod
  #pod   $unopened_file = mktemp( $template );
  #pod
  #pod POSIX functions:
  #pod
  #pod   use File::Temp qw/ :POSIX /;
  #pod
  #pod   $file = tmpnam();
  #pod   $fh = tmpfile();
  #pod
  #pod   ($fh, $file) = tmpnam();
  #pod
  #pod Compatibility functions:
  #pod
  #pod   $unopened_file = File::Temp::tempnam( $dir, $pfx );
  #pod
  #pod =head1 DESCRIPTION
  #pod
  #pod C<File::Temp> can be used to create and open temporary files in a safe
  #pod way.  There is both a function interface and an object-oriented
  #pod interface.  The File::Temp constructor or the tempfile() function can
  #pod be used to return the name and the open filehandle of a temporary
  #pod file.  The tempdir() function can be used to create a temporary
  #pod directory.
  #pod
  #pod The security aspect of temporary file creation is emphasized such that
  #pod a filehandle and filename are returned together.  This helps guarantee
  #pod that a race condition can not occur where the temporary file is
  #pod created by another process between checking for the existence of the
  #pod file and its opening.  Additional security levels are provided to
  #pod check, for example, that the sticky bit is set on world writable
  #pod directories.  See L<"safe_level"> for more information.
  #pod
  #pod For compatibility with popular C library functions, Perl implementations of
  #pod the mkstemp() family of functions are provided. These are, mkstemp(),
  #pod mkstemps(), mkdtemp() and mktemp().
  #pod
  #pod Additionally, implementations of the standard L<POSIX|POSIX>
  #pod tmpnam() and tmpfile() functions are provided if required.
  #pod
  #pod Implementations of mktemp(), tmpnam(), and tempnam() are provided,
  #pod but should be used with caution since they return only a filename
  #pod that was valid when function was called, so cannot guarantee
  #pod that the file will not exist by the time the caller opens the filename.
  #pod
  #pod Filehandles returned by these functions support the seekable methods.
  #pod
  #pod =cut
  
  # Toolchain targets v5.8.1, but we'll try to support back to v5.6 anyway.
  # It might be possible to make this v5.5, but many v5.6isms are creeping
  # into the code and tests.
  use 5.006;
  use strict;
  use Carp;
  use File::Spec 0.8;
  use Cwd ();
  use File::Path 2.06 qw/ rmtree /;
  use Fcntl 1.03;
  use IO::Seekable;               # For SEEK_*
  use Errno;
  use Scalar::Util 'refaddr';
  require VMS::Stdio if $^O eq 'VMS';
  
  # pre-emptively load Carp::Heavy. If we don't when we run out of file
  # handles and attempt to call croak() we get an error message telling
  # us that Carp::Heavy won't load rather than an error telling us we
  # have run out of file handles. We either preload croak() or we
  # switch the calls to croak from _gettemp() to use die.
  eval { require Carp::Heavy; };
  
  # Need the Symbol package if we are running older perl
  require Symbol if $] < 5.006;
  
  ### For the OO interface
  use parent 0.221 qw/ IO::Handle IO::Seekable /;
  use overload '""' => "STRINGIFY", '0+' => "NUMIFY",
    fallback => 1;
  
  our $DEBUG = 0;
  our $KEEP_ALL = 0;
  
  # We are exporting functions
  
  use Exporter 5.57 'import';   # 5.57 lets us import 'import'
  
  # Export list - to allow fine tuning of export table
  
  our @EXPORT_OK = qw{
                   tempfile
                   tempdir
                   tmpnam
                   tmpfile
                   mktemp
                   mkstemp
                   mkstemps
                   mkdtemp
                   unlink0
                   cleanup
                   SEEK_SET
                   SEEK_CUR
                   SEEK_END
               };
  
  # Groups of functions for export
  
  our %EXPORT_TAGS = (
                  'POSIX' => [qw/ tmpnam tmpfile /],
                  'mktemp' => [qw/ mktemp mkstemp mkstemps mkdtemp/],
                  'seekable' => [qw/ SEEK_SET SEEK_CUR SEEK_END /],
                 );
  
  # add contents of these tags to @EXPORT
  Exporter::export_tags('POSIX','mktemp','seekable');
  
  # This is a list of characters that can be used in random filenames
  
  my @CHARS = (qw/ A B C D E F G H I J K L M N O P Q R S T U V W X Y Z
                   a b c d e f g h i j k l m n o p q r s t u v w x y z
                   0 1 2 3 4 5 6 7 8 9 _
                 /);
  
  # Maximum number of tries to make a temp file before failing
  
  use constant MAX_TRIES => 1000;
  
  # Minimum number of X characters that should be in a template
  use constant MINX => 4;
  
  # Default template when no template supplied
  
  use constant TEMPXXX => 'X' x 10;
  
  # Constants for the security level
  
  use constant STANDARD => 0;
  use constant MEDIUM   => 1;
  use constant HIGH     => 2;
  
  # OPENFLAGS. If we defined the flag to use with Sysopen here this gives
  # us an optimisation when many temporary files are requested
  
  my $OPENFLAGS = O_CREAT | O_EXCL | O_RDWR;
  my $LOCKFLAG;
  
  unless ($^O eq 'MacOS') {
    for my $oflag (qw/ NOFOLLOW BINARY LARGEFILE NOINHERIT /) {
      my ($bit, $func) = (0, "Fcntl::O_" . $oflag);
      no strict 'refs';
      $OPENFLAGS |= $bit if eval {
        # Make sure that redefined die handlers do not cause problems
        # e.g. CGI::Carp
        local $SIG{__DIE__} = sub {};
        local $SIG{__WARN__} = sub {};
        $bit = &$func();
        1;
      };
    }
    # Special case O_EXLOCK
    $LOCKFLAG = eval {
      local $SIG{__DIE__} = sub {};
      local $SIG{__WARN__} = sub {};
      &Fcntl::O_EXLOCK();
    };
  }
  
  # On some systems the O_TEMPORARY flag can be used to tell the OS
  # to automatically remove the file when it is closed. This is fine
  # in most cases but not if tempfile is called with UNLINK=>0 and
  # the filename is requested -- in the case where the filename is to
  # be passed to another routine. This happens on windows. We overcome
  # this by using a second open flags variable
  
  my $OPENTEMPFLAGS = $OPENFLAGS;
  unless ($^O eq 'MacOS') {
    for my $oflag (qw/ TEMPORARY /) {
      my ($bit, $func) = (0, "Fcntl::O_" . $oflag);
      local($@);
      no strict 'refs';
      $OPENTEMPFLAGS |= $bit if eval {
        # Make sure that redefined die handlers do not cause problems
        # e.g. CGI::Carp
        local $SIG{__DIE__} = sub {};
        local $SIG{__WARN__} = sub {};
        $bit = &$func();
        1;
      };
    }
  }
  
  # Private hash tracking which files have been created by each process id via the OO interface
  my %FILES_CREATED_BY_OBJECT;
  
  # INTERNAL ROUTINES - not to be used outside of package
  
  # Generic routine for getting a temporary filename
  # modelled on OpenBSD _gettemp() in mktemp.c
  
  # The template must contain X's that are to be replaced
  # with the random values
  
  #  Arguments:
  
  #  TEMPLATE   - string containing the XXXXX's that is converted
  #           to a random filename and opened if required
  
  # Optionally, a hash can also be supplied containing specific options
  #   "open" => if true open the temp file, else just return the name
  #             default is 0
  #   "mkdir"=> if true, we are creating a temp directory rather than tempfile
  #             default is 0
  #   "suffixlen" => number of characters at end of PATH to be ignored.
  #                  default is 0.
  #   "unlink_on_close" => indicates that, if possible,  the OS should remove
  #                        the file as soon as it is closed. Usually indicates
  #                        use of the O_TEMPORARY flag to sysopen.
  #                        Usually irrelevant on unix
  #   "use_exlock" => Indicates that O_EXLOCK should be used. Default is false.
  
  # Optionally a reference to a scalar can be passed into the function
  # On error this will be used to store the reason for the error
  #   "ErrStr"  => \$errstr
  
  # "open" and "mkdir" can not both be true
  # "unlink_on_close" is not used when "mkdir" is true.
  
  # The default options are equivalent to mktemp().
  
  # Returns:
  #   filehandle - open file handle (if called with doopen=1, else undef)
  #   temp name  - name of the temp file or directory
  
  # For example:
  #   ($fh, $name) = _gettemp($template, "open" => 1);
  
  # for the current version, failures are associated with
  # stored in an error string and returned to give the reason whilst debugging
  # This routine is not called by any external function
  sub _gettemp {
  
    croak 'Usage: ($fh, $name) = _gettemp($template, OPTIONS);'
      unless scalar(@_) >= 1;
  
    # the internal error string - expect it to be overridden
    # Need this in case the caller decides not to supply us a value
    # need an anonymous scalar
    my $tempErrStr;
  
    # Default options
    my %options = (
                   "open" => 0,
                   "mkdir" => 0,
                   "suffixlen" => 0,
                   "unlink_on_close" => 0,
                   "use_exlock" => 0,
                   "ErrStr" => \$tempErrStr,
                  );
  
    # Read the template
    my $template = shift;
    if (ref($template)) {
      # Use a warning here since we have not yet merged ErrStr
      carp "File::Temp::_gettemp: template must not be a reference";
      return ();
    }
  
    # Check that the number of entries on stack are even
    if (scalar(@_) % 2 != 0) {
      # Use a warning here since we have not yet merged ErrStr
      carp "File::Temp::_gettemp: Must have even number of options";
      return ();
    }
  
    # Read the options and merge with defaults
    %options = (%options, @_)  if @_;
  
    # Make sure the error string is set to undef
    ${$options{ErrStr}} = undef;
  
    # Can not open the file and make a directory in a single call
    if ($options{"open"} && $options{"mkdir"}) {
      ${$options{ErrStr}} = "doopen and domkdir can not both be true\n";
      return ();
    }
  
    # Find the start of the end of the  Xs (position of last X)
    # Substr starts from 0
    my $start = length($template) - 1 - $options{"suffixlen"};
  
    # Check that we have at least MINX x X (e.g. 'XXXX") at the end of the string
    # (taking suffixlen into account). Any fewer is insecure.
  
    # Do it using substr - no reason to use a pattern match since
    # we know where we are looking and what we are looking for
  
    if (substr($template, $start - MINX + 1, MINX) ne 'X' x MINX) {
      ${$options{ErrStr}} = "The template must end with at least ".
        MINX . " 'X' characters\n";
      return ();
    }
  
    # Replace all the X at the end of the substring with a
    # random character or just all the XX at the end of a full string.
    # Do it as an if, since the suffix adjusts which section to replace
    # and suffixlen=0 returns nothing if used in the substr directly
    # and generate a full path from the template
  
    my $path = _replace_XX($template, $options{"suffixlen"});
  
  
    # Split the path into constituent parts - eventually we need to check
    # whether the directory exists
    # We need to know whether we are making a temp directory
    # or a tempfile
  
    my ($volume, $directories, $file);
    my $parent;                   # parent directory
    if ($options{"mkdir"}) {
      # There is no filename at the end
      ($volume, $directories, $file) = File::Spec->splitpath( $path, 1);
  
      # The parent is then $directories without the last directory
      # Split the directory and put it back together again
      my @dirs = File::Spec->splitdir($directories);
  
      # If @dirs only has one entry (i.e. the directory template) that means
      # we are in the current directory
      if ($#dirs == 0) {
        $parent = File::Spec->curdir;
      } else {
  
        if ($^O eq 'VMS') {     # need volume to avoid relative dir spec
          $parent = File::Spec->catdir($volume, @dirs[0..$#dirs-1]);
          $parent = 'sys$disk:[]' if $parent eq '';
        } else {
  
          # Put it back together without the last one
          $parent = File::Spec->catdir(@dirs[0..$#dirs-1]);
  
          # ...and attach the volume (no filename)
          $parent = File::Spec->catpath($volume, $parent, '');
        }
  
      }
  
    } else {
  
      # Get rid of the last filename (use File::Basename for this?)
      ($volume, $directories, $file) = File::Spec->splitpath( $path );
  
      # Join up without the file part
      $parent = File::Spec->catpath($volume,$directories,'');
  
      # If $parent is empty replace with curdir
      $parent = File::Spec->curdir
        unless $directories ne '';
  
    }
  
    # Check that the parent directories exist
    # Do this even for the case where we are simply returning a name
    # not a file -- no point returning a name that includes a directory
    # that does not exist or is not writable
  
    unless (-e $parent) {
      ${$options{ErrStr}} = "Parent directory ($parent) does not exist";
      return ();
    }
    unless (-d $parent) {
      ${$options{ErrStr}} = "Parent directory ($parent) is not a directory";
      return ();
    }
  
    # Check the stickiness of the directory and chown giveaway if required
    # If the directory is world writable the sticky bit
    # must be set
  
    if (File::Temp->safe_level == MEDIUM) {
      my $safeerr;
      unless (_is_safe($parent,\$safeerr)) {
        ${$options{ErrStr}} = "Parent directory ($parent) is not safe ($safeerr)";
        return ();
      }
    } elsif (File::Temp->safe_level == HIGH) {
      my $safeerr;
      unless (_is_verysafe($parent, \$safeerr)) {
        ${$options{ErrStr}} = "Parent directory ($parent) is not safe ($safeerr)";
        return ();
      }
    }
  
  
    # Now try MAX_TRIES time to open the file
    for (my $i = 0; $i < MAX_TRIES; $i++) {
  
      # Try to open the file if requested
      if ($options{"open"}) {
        my $fh;
  
        # If we are running before perl5.6.0 we can not auto-vivify
        if ($] < 5.006) {
          $fh = &Symbol::gensym;
        }
  
        # Try to make sure this will be marked close-on-exec
        # XXX: Win32 doesn't respect this, nor the proper fcntl,
        #      but may have O_NOINHERIT. This may or may not be in Fcntl.
        local $^F = 2;
  
        # Attempt to open the file
        my $open_success = undef;
        if ( $^O eq 'VMS' and $options{"unlink_on_close"} && !$KEEP_ALL) {
          # make it auto delete on close by setting FAB$V_DLT bit
          $fh = VMS::Stdio::vmssysopen($path, $OPENFLAGS, 0600, 'fop=dlt');
          $open_success = $fh;
        } else {
          my $flags = ( ($options{"unlink_on_close"} && !$KEEP_ALL) ?
                        $OPENTEMPFLAGS :
                        $OPENFLAGS );
          $flags |= $LOCKFLAG if (defined $LOCKFLAG && $options{use_exlock});
          $open_success = sysopen($fh, $path, $flags, 0600);
        }
        if ( $open_success ) {
  
          # in case of odd umask force rw
          chmod(0600, $path);
  
          # Opened successfully - return file handle and name
          return ($fh, $path);
  
        } else {
  
          # Error opening file - abort with error
          # if the reason was anything but EEXIST
          unless ($!{EEXIST}) {
            ${$options{ErrStr}} = "Could not create temp file $path: $!";
            return ();
          }
  
          # Loop round for another try
  
        }
      } elsif ($options{"mkdir"}) {
  
        # Open the temp directory
        if (mkdir( $path, 0700)) {
          # in case of odd umask
          chmod(0700, $path);
  
          return undef, $path;
        } else {
  
          # Abort with error if the reason for failure was anything
          # except EEXIST
          unless ($!{EEXIST}) {
            ${$options{ErrStr}} = "Could not create directory $path: $!";
            return ();
          }
  
          # Loop round for another try
  
        }
  
      } else {
  
        # Return true if the file can not be found
        # Directory has been checked previously
  
        return (undef, $path) unless -e $path;
  
        # Try again until MAX_TRIES
  
      }
  
      # Did not successfully open the tempfile/dir
      # so try again with a different set of random letters
      # No point in trying to increment unless we have only
      # 1 X say and the randomness could come up with the same
      # file MAX_TRIES in a row.
  
      # Store current attempt - in principle this implies that the
      # 3rd time around the open attempt that the first temp file
      # name could be generated again. Probably should store each
      # attempt and make sure that none are repeated
  
      my $original = $path;
      my $counter = 0;            # Stop infinite loop
      my $MAX_GUESS = 50;
  
      do {
  
        # Generate new name from original template
        $path = _replace_XX($template, $options{"suffixlen"});
  
        $counter++;
  
      } until ($path ne $original || $counter > $MAX_GUESS);
  
      # Check for out of control looping
      if ($counter > $MAX_GUESS) {
        ${$options{ErrStr}} = "Tried to get a new temp name different to the previous value $MAX_GUESS times.\nSomething wrong with template?? ($template)";
        return ();
      }
  
    }
  
    # If we get here, we have run out of tries
    ${ $options{ErrStr} } = "Have exceeded the maximum number of attempts ("
      . MAX_TRIES . ") to open temp file/dir";
  
    return ();
  
  }
  
  # Internal routine to replace the XXXX... with random characters
  # This has to be done by _gettemp() every time it fails to
  # open a temp file/dir
  
  # Arguments:  $template (the template with XXX),
  #             $ignore   (number of characters at end to ignore)
  
  # Returns:    modified template
  
  sub _replace_XX {
  
    croak 'Usage: _replace_XX($template, $ignore)'
      unless scalar(@_) == 2;
  
    my ($path, $ignore) = @_;
  
    # Do it as an if, since the suffix adjusts which section to replace
    # and suffixlen=0 returns nothing if used in the substr directly
    # Alternatively, could simply set $ignore to length($path)-1
    # Don't want to always use substr when not required though.
    my $end = ( $] >= 5.006 ? "\\z" : "\\Z" );
  
    if ($ignore) {
      substr($path, 0, - $ignore) =~ s/X(?=X*$end)/$CHARS[ int( rand( @CHARS ) ) ]/ge;
    } else {
      $path =~ s/X(?=X*$end)/$CHARS[ int( rand( @CHARS ) ) ]/ge;
    }
    return $path;
  }
  
  # Internal routine to force a temp file to be writable after
  # it is created so that we can unlink it. Windows seems to occasionally
  # force a file to be readonly when written to certain temp locations
  sub _force_writable {
    my $file = shift;
    chmod 0600, $file;
  }
  
  
  # internal routine to check to see if the directory is safe
  # First checks to see if the directory is not owned by the
  # current user or root. Then checks to see if anyone else
  # can write to the directory and if so, checks to see if
  # it has the sticky bit set
  
  # Will not work on systems that do not support sticky bit
  
  #Args:  directory path to check
  #       Optionally: reference to scalar to contain error message
  # Returns true if the path is safe and false otherwise.
  # Returns undef if can not even run stat() on the path
  
  # This routine based on version written by Tom Christiansen
  
  # Presumably, by the time we actually attempt to create the
  # file or directory in this directory, it may not be safe
  # anymore... Have to run _is_safe directly after the open.
  
  sub _is_safe {
  
    my $path = shift;
    my $err_ref = shift;
  
    # Stat path
    my @info = stat($path);
    unless (scalar(@info)) {
      $$err_ref = "stat(path) returned no values";
      return 0;
    }
    ;
    return 1 if $^O eq 'VMS';     # owner delete control at file level
  
    # Check to see whether owner is neither superuser (or a system uid) nor me
    # Use the effective uid from the $> variable
    # UID is in [4]
    if ($info[4] > File::Temp->top_system_uid() && $info[4] != $>) {
  
      Carp::cluck(sprintf "uid=$info[4] topuid=%s euid=$> path='$path'",
                  File::Temp->top_system_uid());
  
      $$err_ref = "Directory owned neither by root nor the current user"
        if ref($err_ref);
      return 0;
    }
  
    # check whether group or other can write file
    # use 066 to detect either reading or writing
    # use 022 to check writability
    # Do it with S_IWOTH and S_IWGRP for portability (maybe)
    # mode is in info[2]
    if (($info[2] & &Fcntl::S_IWGRP) ||  # Is group writable?
        ($info[2] & &Fcntl::S_IWOTH) ) { # Is world writable?
      # Must be a directory
      unless (-d $path) {
        $$err_ref = "Path ($path) is not a directory"
          if ref($err_ref);
        return 0;
      }
      # Must have sticky bit set
      unless (-k $path) {
        $$err_ref = "Sticky bit not set on $path when dir is group|world writable"
          if ref($err_ref);
        return 0;
      }
    }
  
    return 1;
  }
  
  # Internal routine to check whether a directory is safe
  # for temp files. Safer than _is_safe since it checks for
  # the possibility of chown giveaway and if that is a possibility
  # checks each directory in the path to see if it is safe (with _is_safe)
  
  # If _PC_CHOWN_RESTRICTED is not set, does the full test of each
  # directory anyway.
  
  # Takes optional second arg as scalar ref to error reason
  
  sub _is_verysafe {
  
    # Need POSIX - but only want to bother if really necessary due to overhead
    require POSIX;
  
    my $path = shift;
    print "_is_verysafe testing $path\n" if $DEBUG;
    return 1 if $^O eq 'VMS';     # owner delete control at file level
  
    my $err_ref = shift;
  
    # Should Get the value of _PC_CHOWN_RESTRICTED if it is defined
    # and If it is not there do the extensive test
    local($@);
    my $chown_restricted;
    $chown_restricted = &POSIX::_PC_CHOWN_RESTRICTED()
      if eval { &POSIX::_PC_CHOWN_RESTRICTED(); 1};
  
    # If chown_resticted is set to some value we should test it
    if (defined $chown_restricted) {
  
      # Return if the current directory is safe
      return _is_safe($path,$err_ref) if POSIX::sysconf( $chown_restricted );
  
    }
  
    # To reach this point either, the _PC_CHOWN_RESTRICTED symbol
    # was not available or the symbol was there but chown giveaway
    # is allowed. Either way, we now have to test the entire tree for
    # safety.
  
    # Convert path to an absolute directory if required
    unless (File::Spec->file_name_is_absolute($path)) {
      $path = File::Spec->rel2abs($path);
    }
  
    # Split directory into components - assume no file
    my ($volume, $directories, undef) = File::Spec->splitpath( $path, 1);
  
    # Slightly less efficient than having a function in File::Spec
    # to chop off the end of a directory or even a function that
    # can handle ../ in a directory tree
    # Sometimes splitdir() returns a blank at the end
    # so we will probably check the bottom directory twice in some cases
    my @dirs = File::Spec->splitdir($directories);
  
    # Concatenate one less directory each time around
    foreach my $pos (0.. $#dirs) {
      # Get a directory name
      my $dir = File::Spec->catpath($volume,
                                    File::Spec->catdir(@dirs[0.. $#dirs - $pos]),
                                    ''
                                   );
  
      print "TESTING DIR $dir\n" if $DEBUG;
  
      # Check the directory
      return 0 unless _is_safe($dir,$err_ref);
  
    }
  
    return 1;
  }
  
  
  
  # internal routine to determine whether unlink works on this
  # platform for files that are currently open.
  # Returns true if we can, false otherwise.
  
  # Currently WinNT, OS/2 and VMS can not unlink an opened file
  # On VMS this is because the O_EXCL flag is used to open the
  # temporary file. Currently I do not know enough about the issues
  # on VMS to decide whether O_EXCL is a requirement.
  
  sub _can_unlink_opened_file {
  
    if (grep { $^O eq $_ } qw/MSWin32 os2 VMS dos MacOS haiku/) {
      return 0;
    } else {
      return 1;
    }
  
  }
  
  # internal routine to decide which security levels are allowed
  # see safe_level() for more information on this
  
  # Controls whether the supplied security level is allowed
  
  #   $cando = _can_do_level( $level )
  
  sub _can_do_level {
  
    # Get security level
    my $level = shift;
  
    # Always have to be able to do STANDARD
    return 1 if $level == STANDARD;
  
    # Currently, the systems that can do HIGH or MEDIUM are identical
    if ( $^O eq 'MSWin32' || $^O eq 'os2' || $^O eq 'cygwin' || $^O eq 'dos' || $^O eq 'MacOS' || $^O eq 'mpeix') {
      return 0;
    } else {
      return 1;
    }
  
  }
  
  # This routine sets up a deferred unlinking of a specified
  # filename and filehandle. It is used in the following cases:
  #  - Called by unlink0 if an opened file can not be unlinked
  #  - Called by tempfile() if files are to be removed on shutdown
  #  - Called by tempdir() if directories are to be removed on shutdown
  
  # Arguments:
  #   _deferred_unlink( $fh, $fname, $isdir );
  #
  #   - filehandle (so that it can be explicitly closed if open
  #   - filename   (the thing we want to remove)
  #   - isdir      (flag to indicate that we are being given a directory)
  #                 [and hence no filehandle]
  
  # Status is not referred to since all the magic is done with an END block
  
  {
    # Will set up two lexical variables to contain all the files to be
    # removed. One array for files, another for directories They will
    # only exist in this block.
  
    #  This means we only have to set up a single END block to remove
    #  all files. 
  
    # in order to prevent child processes inadvertently deleting the parent
    # temp files we use a hash to store the temp files and directories
    # created by a particular process id.
  
    # %files_to_unlink contains values that are references to an array of
    # array references containing the filehandle and filename associated with
    # the temp file.
    my (%files_to_unlink, %dirs_to_unlink);
  
    # Set up an end block to use these arrays
    END {
      local($., $@, $!, $^E, $?);
      cleanup(at_exit => 1);
    }
  
    # Cleanup function. Always triggered on END (with at_exit => 1) but
    # can be invoked manually.
    sub cleanup {
      my %h = @_;
      my $at_exit = delete $h{at_exit};
      $at_exit = 0 if not defined $at_exit;
      { my @k = sort keys %h; die "unrecognized parameters: @k" if @k }
  
      if (!$KEEP_ALL) {
        # Files
        my @files = (exists $files_to_unlink{$$} ?
                     @{ $files_to_unlink{$$} } : () );
        foreach my $file (@files) {
          # close the filehandle without checking its state
          # in order to make real sure that this is closed
          # if its already closed then I don't care about the answer
          # probably a better way to do this
          close($file->[0]);      # file handle is [0]
  
          if (-f $file->[1]) {       # file name is [1]
            _force_writable( $file->[1] ); # for windows
            unlink $file->[1] or warn "Error removing ".$file->[1];
          }
        }
        # Dirs
        my @dirs = (exists $dirs_to_unlink{$$} ?
                    @{ $dirs_to_unlink{$$} } : () );
        my ($cwd, $cwd_to_remove);
        foreach my $dir (@dirs) {
          if (-d $dir) {
            # Some versions of rmtree will abort if you attempt to remove
            # the directory you are sitting in. For automatic cleanup
            # at program exit, we avoid this by chdir()ing out of the way
            # first. If not at program exit, it's best not to mess with the
            # current directory, so just let it fail with a warning.
            if ($at_exit) {
              $cwd = Cwd::abs_path(File::Spec->curdir) if not defined $cwd;
              my $abs = Cwd::abs_path($dir);
              if ($abs eq $cwd) {
                $cwd_to_remove = $dir;
                next;
              }
            }
            eval { rmtree($dir, $DEBUG, 0); };
            warn $@ if ($@ && $^W);
          }
        }
  
        if (defined $cwd_to_remove) {
          # We do need to clean up the current directory, and everything
          # else is done, so get out of there and remove it.
          chdir $cwd_to_remove or die "cannot chdir to $cwd_to_remove: $!";
          my $updir = File::Spec->updir;
          chdir $updir or die "cannot chdir to $updir: $!";
          eval { rmtree($cwd_to_remove, $DEBUG, 0); };
          warn $@ if ($@ && $^W);
        }
  
        # clear the arrays
        @{ $files_to_unlink{$$} } = ()
          if exists $files_to_unlink{$$};
        @{ $dirs_to_unlink{$$} } = ()
          if exists $dirs_to_unlink{$$};
      }
    }
  
  
    # This is the sub called to register a file for deferred unlinking
    # This could simply store the input parameters and defer everything
    # until the END block. For now we do a bit of checking at this
    # point in order to make sure that (1) we have a file/dir to delete
    # and (2) we have been called with the correct arguments.
    sub _deferred_unlink {
  
      croak 'Usage:  _deferred_unlink($fh, $fname, $isdir)'
        unless scalar(@_) == 3;
  
      my ($fh, $fname, $isdir) = @_;
  
      warn "Setting up deferred removal of $fname\n"
        if $DEBUG;
  
      # make sure we save the absolute path for later cleanup
      # OK to untaint because we only ever use this internally
      # as a file path, never interpolating into the shell
      $fname = Cwd::abs_path($fname);
      ($fname) = $fname =~ /^(.*)$/;
  
      # If we have a directory, check that it is a directory
      if ($isdir) {
  
        if (-d $fname) {
  
          # Directory exists so store it
          # first on VMS turn []foo into [.foo] for rmtree
          $fname = VMS::Filespec::vmspath($fname) if $^O eq 'VMS';
          $dirs_to_unlink{$$} = [] 
            unless exists $dirs_to_unlink{$$};
          push (@{ $dirs_to_unlink{$$} }, $fname);
  
        } else {
          carp "Request to remove directory $fname could not be completed since it does not exist!\n" if $^W;
        }
  
      } else {
  
        if (-f $fname) {
  
          # file exists so store handle and name for later removal
          $files_to_unlink{$$} = []
            unless exists $files_to_unlink{$$};
          push(@{ $files_to_unlink{$$} }, [$fh, $fname]);
  
        } else {
          carp "Request to remove file $fname could not be completed since it is not there!\n" if $^W;
        }
  
      }
  
    }
  
  
  }
  
  # normalize argument keys to upper case and do consistent handling
  # of leading template vs TEMPLATE
  sub _parse_args {
    my $leading_template = (scalar(@_) % 2 == 1 ? shift(@_) : '' );
    my %args = @_;
    %args = map { uc($_), $args{$_} } keys %args;
  
    # template (store it in an array so that it will
    # disappear from the arg list of tempfile)
    my @template = (
      exists $args{TEMPLATE}  ? $args{TEMPLATE} :
      $leading_template       ? $leading_template : ()
    );
    delete $args{TEMPLATE};
  
    return( \@template, \%args );
  }
  
  #pod =head1 OBJECT-ORIENTED INTERFACE
  #pod
  #pod This is the primary interface for interacting with
  #pod C<File::Temp>. Using the OO interface a temporary file can be created
  #pod when the object is constructed and the file can be removed when the
  #pod object is no longer required.
  #pod
  #pod Note that there is no method to obtain the filehandle from the
  #pod C<File::Temp> object. The object itself acts as a filehandle.  The object
  #pod isa C<IO::Handle> and isa C<IO::Seekable> so all those methods are
  #pod available.
  #pod
  #pod Also, the object is configured such that it stringifies to the name of the
  #pod temporary file and so can be compared to a filename directly.  It numifies
  #pod to the C<refaddr> the same as other handles and so can be compared to other
  #pod handles with C<==>.
  #pod
  #pod     $fh eq $filename       # as a string
  #pod     $fh != \*STDOUT        # as a number
  #pod
  #pod Available since 0.14.
  #pod
  #pod =over 4
  #pod
  #pod =item B<new>
  #pod
  #pod Create a temporary file object.
  #pod
  #pod   my $tmp = File::Temp->new();
  #pod
  #pod by default the object is constructed as if C<tempfile>
  #pod was called without options, but with the additional behaviour
  #pod that the temporary file is removed by the object destructor
  #pod if UNLINK is set to true (the default).
  #pod
  #pod Supported arguments are the same as for C<tempfile>: UNLINK
  #pod (defaulting to true), DIR, EXLOCK and SUFFIX. Additionally, the filename
  #pod template is specified using the TEMPLATE option. The OPEN option
  #pod is not supported (the file is always opened).
  #pod
  #pod  $tmp = File::Temp->new( TEMPLATE => 'tempXXXXX',
  #pod                         DIR => 'mydir',
  #pod                         SUFFIX => '.dat');
  #pod
  #pod Arguments are case insensitive.
  #pod
  #pod Can call croak() if an error occurs.
  #pod
  #pod Available since 0.14.
  #pod
  #pod TEMPLATE available since 0.23
  #pod
  #pod =cut
  
  sub new {
    my $proto = shift;
    my $class = ref($proto) || $proto;
  
    my ($maybe_template, $args) = _parse_args(@_);
  
    # see if they are unlinking (defaulting to yes)
    my $unlink = (exists $args->{UNLINK} ? $args->{UNLINK} : 1 );
    delete $args->{UNLINK};
  
    # Protect OPEN
    delete $args->{OPEN};
  
    # Open the file and retain file handle and file name
    my ($fh, $path) = tempfile( @$maybe_template, %$args );
  
    print "Tmp: $fh - $path\n" if $DEBUG;
  
    # Store the filename in the scalar slot
    ${*$fh} = $path;
  
    # Cache the filename by pid so that the destructor can decide whether to remove it
    $FILES_CREATED_BY_OBJECT{$$}{$path} = 1;
  
    # Store unlink information in hash slot (plus other constructor info)
    %{*$fh} = %$args;
  
    # create the object
    bless $fh, $class;
  
    # final method-based configuration
    $fh->unlink_on_destroy( $unlink );
  
    return $fh;
  }
  
  #pod =item B<newdir>
  #pod
  #pod Create a temporary directory using an object oriented interface.
  #pod
  #pod   $dir = File::Temp->newdir();
  #pod
  #pod By default the directory is deleted when the object goes out of scope.
  #pod
  #pod Supports the same options as the C<tempdir> function. Note that directories
  #pod created with this method default to CLEANUP => 1.
  #pod
  #pod   $dir = File::Temp->newdir( $template, %options );
  #pod
  #pod A template may be specified either with a leading template or
  #pod with a TEMPLATE argument.
  #pod
  #pod Available since 0.19.
  #pod
  #pod TEMPLATE available since 0.23.
  #pod
  #pod =cut
  
  sub newdir {
    my $self = shift;
  
    my ($maybe_template, $args) = _parse_args(@_);
  
    # handle CLEANUP without passing CLEANUP to tempdir
    my $cleanup = (exists $args->{CLEANUP} ? $args->{CLEANUP} : 1 );
    delete $args->{CLEANUP};
  
    my $tempdir = tempdir( @$maybe_template, %$args);
  
    # get a safe absolute path for cleanup, just like
    # happens in _deferred_unlink
    my $real_dir = Cwd::abs_path( $tempdir );
    ($real_dir) = $real_dir =~ /^(.*)$/;
  
    return bless { DIRNAME => $tempdir,
                   REALNAME => $real_dir,
                   CLEANUP => $cleanup,
                   LAUNCHPID => $$,
                 }, "File::Temp::Dir";
  }
  
  #pod =item B<filename>
  #pod
  #pod Return the name of the temporary file associated with this object
  #pod (if the object was created using the "new" constructor).
  #pod
  #pod   $filename = $tmp->filename;
  #pod
  #pod This method is called automatically when the object is used as
  #pod a string.
  #pod
  #pod Current API available since 0.14
  #pod
  #pod =cut
  
  sub filename {
    my $self = shift;
    return ${*$self};
  }
  
  sub STRINGIFY {
    my $self = shift;
    return $self->filename;
  }
  
  # For reference, can't use '0+'=>\&Scalar::Util::refaddr directly because
  # refaddr() demands one parameter only, whereas overload.pm calls with three
  # even for unary operations like '0+'.
  sub NUMIFY {
    return refaddr($_[0]);
  }
  
  #pod =item B<dirname>
  #pod
  #pod Return the name of the temporary directory associated with this
  #pod object (if the object was created using the "newdir" constructor).
  #pod
  #pod   $dirname = $tmpdir->dirname;
  #pod
  #pod This method is called automatically when the object is used in string context.
  #pod
  #pod =item B<unlink_on_destroy>
  #pod
  #pod Control whether the file is unlinked when the object goes out of scope.
  #pod The file is removed if this value is true and $KEEP_ALL is not.
  #pod
  #pod  $fh->unlink_on_destroy( 1 );
  #pod
  #pod Default is for the file to be removed.
  #pod
  #pod Current API available since 0.15
  #pod
  #pod =cut
  
  sub unlink_on_destroy {
    my $self = shift;
    if (@_) {
      ${*$self}{UNLINK} = shift;
    }
    return ${*$self}{UNLINK};
  }
  
  #pod =item B<DESTROY>
  #pod
  #pod When the object goes out of scope, the destructor is called. This
  #pod destructor will attempt to unlink the file (using L<unlink1|"unlink1">)
  #pod if the constructor was called with UNLINK set to 1 (the default state
  #pod if UNLINK is not specified).
  #pod
  #pod No error is given if the unlink fails.
  #pod
  #pod If the object has been passed to a child process during a fork, the
  #pod file will be deleted when the object goes out of scope in the parent.
  #pod
  #pod For a temporary directory object the directory will be removed unless
  #pod the CLEANUP argument was used in the constructor (and set to false) or
  #pod C<unlink_on_destroy> was modified after creation.  Note that if a temp
  #pod directory is your current directory, it cannot be removed - a warning
  #pod will be given in this case.  C<chdir()> out of the directory before
  #pod letting the object go out of scope.
  #pod
  #pod If the global variable $KEEP_ALL is true, the file or directory
  #pod will not be removed.
  #pod
  #pod =cut
  
  sub DESTROY {
    local($., $@, $!, $^E, $?);
    my $self = shift;
  
    # Make sure we always remove the file from the global hash
    # on destruction. This prevents the hash from growing uncontrollably
    # and post-destruction there is no reason to know about the file.
    my $file = $self->filename;
    my $was_created_by_proc;
    if (exists $FILES_CREATED_BY_OBJECT{$$}{$file}) {
      $was_created_by_proc = 1;
      delete $FILES_CREATED_BY_OBJECT{$$}{$file};
    }
  
    if (${*$self}{UNLINK} && !$KEEP_ALL) {
      print "# --------->   Unlinking $self\n" if $DEBUG;
  
      # only delete if this process created it
      return unless $was_created_by_proc;
  
      # The unlink1 may fail if the file has been closed
      # by the caller. This leaves us with the decision
      # of whether to refuse to remove the file or simply
      # do an unlink without test. Seems to be silly
      # to do this when we are trying to be careful
      # about security
      _force_writable( $file ); # for windows
      unlink1( $self, $file )
        or unlink($file);
    }
  }
  
  #pod =back
  #pod
  #pod =head1 FUNCTIONS
  #pod
  #pod This section describes the recommended interface for generating
  #pod temporary files and directories.
  #pod
  #pod =over 4
  #pod
  #pod =item B<tempfile>
  #pod
  #pod This is the basic function to generate temporary files.
  #pod The behaviour of the file can be changed using various options:
  #pod
  #pod   $fh = tempfile();
  #pod   ($fh, $filename) = tempfile();
  #pod
  #pod Create a temporary file in  the directory specified for temporary
  #pod files, as specified by the tmpdir() function in L<File::Spec>.
  #pod
  #pod   ($fh, $filename) = tempfile($template);
  #pod
  #pod Create a temporary file in the current directory using the supplied
  #pod template.  Trailing `X' characters are replaced with random letters to
  #pod generate the filename.  At least four `X' characters must be present
  #pod at the end of the template.
  #pod
  #pod   ($fh, $filename) = tempfile($template, SUFFIX => $suffix)
  #pod
  #pod Same as previously, except that a suffix is added to the template
  #pod after the `X' translation.  Useful for ensuring that a temporary
  #pod filename has a particular extension when needed by other applications.
  #pod But see the WARNING at the end.
  #pod
  #pod   ($fh, $filename) = tempfile($template, DIR => $dir);
  #pod
  #pod Translates the template as before except that a directory name
  #pod is specified.
  #pod
  #pod   ($fh, $filename) = tempfile($template, TMPDIR => 1);
  #pod
  #pod Equivalent to specifying a DIR of "File::Spec->tmpdir", writing the file
  #pod into the same temporary directory as would be used if no template was
  #pod specified at all.
  #pod
  #pod   ($fh, $filename) = tempfile($template, UNLINK => 1);
  #pod
  #pod Return the filename and filehandle as before except that the file is
  #pod automatically removed when the program exits (dependent on
  #pod $KEEP_ALL). Default is for the file to be removed if a file handle is
  #pod requested and to be kept if the filename is requested. In a scalar
  #pod context (where no filename is returned) the file is always deleted
  #pod either (depending on the operating system) on exit or when it is
  #pod closed (unless $KEEP_ALL is true when the temp file is created).
  #pod
  #pod Use the object-oriented interface if fine-grained control of when
  #pod a file is removed is required.
  #pod
  #pod If the template is not specified, a template is always
  #pod automatically generated. This temporary file is placed in tmpdir()
  #pod (L<File::Spec>) unless a directory is specified explicitly with the
  #pod DIR option.
  #pod
  #pod   $fh = tempfile( DIR => $dir );
  #pod
  #pod If called in scalar context, only the filehandle is returned and the
  #pod file will automatically be deleted when closed on operating systems
  #pod that support this (see the description of tmpfile() elsewhere in this
  #pod document).  This is the preferred mode of operation, as if you only
  #pod have a filehandle, you can never create a race condition by fumbling
  #pod with the filename. On systems that can not unlink an open file or can
  #pod not mark a file as temporary when it is opened (for example, Windows
  #pod NT uses the C<O_TEMPORARY> flag) the file is marked for deletion when
  #pod the program ends (equivalent to setting UNLINK to 1). The C<UNLINK>
  #pod flag is ignored if present.
  #pod
  #pod   (undef, $filename) = tempfile($template, OPEN => 0);
  #pod
  #pod This will return the filename based on the template but
  #pod will not open this file.  Cannot be used in conjunction with
  #pod UNLINK set to true. Default is to always open the file
  #pod to protect from possible race conditions. A warning is issued
  #pod if warnings are turned on. Consider using the tmpnam()
  #pod and mktemp() functions described elsewhere in this document
  #pod if opening the file is not required.
  #pod
  #pod To open the temporary filehandle with O_EXLOCK (open with exclusive
  #pod file lock) use C<< EXLOCK=>1 >>. This is supported only by some
  #pod operating systems (most notably BSD derived systems). By default
  #pod EXLOCK will be false. Former C<File::Temp> versions set EXLOCK to
  #pod true, so to be sure to get an unlocked filehandle also with older
  #pod versions, explicitly set C<< EXLOCK=>0 >>.
  #pod
  #pod   ($fh, $filename) = tempfile($template, EXLOCK => 1);
  #pod
  #pod Options can be combined as required.
  #pod
  #pod Will croak() if there is an error.
  #pod
  #pod Available since 0.05.
  #pod
  #pod UNLINK flag available since 0.10.
  #pod
  #pod TMPDIR flag available since 0.19.
  #pod
  #pod EXLOCK flag available since 0.19.
  #pod
  #pod =cut
  
  sub tempfile {
    if ( @_ && $_[0] eq 'File::Temp' ) {
        croak "'tempfile' can't be called as a method";
    }
    # Can not check for argument count since we can have any
    # number of args
  
    # Default options
    my %options = (
                   "DIR"    => undef, # Directory prefix
                   "SUFFIX" => '',    # Template suffix
                   "UNLINK" => 0,     # Do not unlink file on exit
                   "OPEN"   => 1,     # Open file
                   "TMPDIR" => 0, # Place tempfile in tempdir if template specified
                   "EXLOCK" => 0, # Open file with O_EXLOCK
                  );
  
    # Check to see whether we have an odd or even number of arguments
    my ($maybe_template, $args) = _parse_args(@_);
    my $template = @$maybe_template ? $maybe_template->[0] : undef;
  
    # Read the options and merge with defaults
    %options = (%options, %$args);
  
    # First decision is whether or not to open the file
    if (! $options{"OPEN"}) {
  
      warn "tempfile(): temporary filename requested but not opened.\nPossibly unsafe, consider using tempfile() with OPEN set to true\n"
        if $^W;
  
    }
  
    if ($options{"DIR"} and $^O eq 'VMS') {
  
      # on VMS turn []foo into [.foo] for concatenation
      $options{"DIR"} = VMS::Filespec::vmspath($options{"DIR"});
    }
  
    # Construct the template
  
    # Have a choice of trying to work around the mkstemp/mktemp/tmpnam etc
    # functions or simply constructing a template and using _gettemp()
    # explicitly. Go for the latter
  
    # First generate a template if not defined and prefix the directory
    # If no template must prefix the temp directory
    if (defined $template) {
      # End up with current directory if neither DIR not TMPDIR are set
      if ($options{"DIR"}) {
  
        $template = File::Spec->catfile($options{"DIR"}, $template);
  
      } elsif ($options{TMPDIR}) {
  
        $template = File::Spec->catfile(_wrap_file_spec_tmpdir(), $template );
  
      }
  
    } else {
  
      if ($options{"DIR"}) {
  
        $template = File::Spec->catfile($options{"DIR"}, TEMPXXX);
  
      } else {
  
        $template = File::Spec->catfile(_wrap_file_spec_tmpdir(), TEMPXXX);
  
      }
  
    }
  
    # Now add a suffix
    $template .= $options{"SUFFIX"};
  
    # Determine whether we should tell _gettemp to unlink the file
    # On unix this is irrelevant and can be worked out after the file is
    # opened (simply by unlinking the open filehandle). On Windows or VMS
    # we have to indicate temporary-ness when we open the file. In general
    # we only want a true temporary file if we are returning just the
    # filehandle - if the user wants the filename they probably do not
    # want the file to disappear as soon as they close it (which may be
    # important if they want a child process to use the file)
    # For this reason, tie unlink_on_close to the return context regardless
    # of OS.
    my $unlink_on_close = ( wantarray ? 0 : 1);
  
    # Create the file
    my ($fh, $path, $errstr);
    croak "Error in tempfile() using template $template: $errstr"
      unless (($fh, $path) = _gettemp($template,
                                      "open" => $options{'OPEN'},
                                      "mkdir"=> 0 ,
                                      "unlink_on_close" => $unlink_on_close,
                                      "suffixlen" => length($options{'SUFFIX'}),
                                      "ErrStr" => \$errstr,
                                      "use_exlock" => $options{EXLOCK},
                                     ) );
  
    # Set up an exit handler that can do whatever is right for the
    # system. This removes files at exit when requested explicitly or when
    # system is asked to unlink_on_close but is unable to do so because
    # of OS limitations.
    # The latter should be achieved by using a tied filehandle.
    # Do not check return status since this is all done with END blocks.
    _deferred_unlink($fh, $path, 0) if $options{"UNLINK"};
  
    # Return
    if (wantarray()) {
  
      if ($options{'OPEN'}) {
        return ($fh, $path);
      } else {
        return (undef, $path);
      }
  
    } else {
  
      # Unlink the file. It is up to unlink0 to decide what to do with
      # this (whether to unlink now or to defer until later)
      unlink0($fh, $path) or croak "Error unlinking file $path using unlink0";
  
      # Return just the filehandle.
      return $fh;
    }
  
  
  }
  
  # On Windows under taint mode, File::Spec could suggest "C:\" as a tempdir
  # which might not be writable.  If that is the case, we fallback to a
  # user directory.  See https://rt.cpan.org/Ticket/Display.html?id=60340
  
  {
    my ($alt_tmpdir, $checked);
  
    sub _wrap_file_spec_tmpdir {
      return File::Spec->tmpdir unless $^O eq "MSWin32" && ${^TAINT};
  
      if ( $checked ) {
        return $alt_tmpdir ? $alt_tmpdir : File::Spec->tmpdir;
      }
  
      # probe what File::Spec gives and find a fallback
      my $xxpath = _replace_XX( "X" x 10, 0 );
  
      # First, see if File::Spec->tmpdir is writable
      my $tmpdir = File::Spec->tmpdir;
      my $testpath = File::Spec->catdir( $tmpdir, $xxpath );
      if (mkdir( $testpath, 0700) ) {
        $checked = 1;
        rmdir $testpath;
        return $tmpdir;
      }
  
      # Next, see if CSIDL_LOCAL_APPDATA is writable
      require Win32;
      my $local_app = File::Spec->catdir(
        Win32::GetFolderPath( Win32::CSIDL_LOCAL_APPDATA() ), 'Temp'
      );
      $testpath = File::Spec->catdir( $local_app, $xxpath );
      if ( -e $local_app or mkdir( $local_app, 0700 ) ) {
        if (mkdir( $testpath, 0700) ) {
          $checked = 1;
          rmdir $testpath;
          return $alt_tmpdir = $local_app;
        }
      }
  
      # Can't find something writable
      croak << "HERE";
  Couldn't find a writable temp directory in taint mode. Tried:
    $tmpdir
    $local_app
  
  Try setting and untainting the TMPDIR environment variable.
  HERE
  
    }
  }
  
  #pod =item B<tempdir>
  #pod
  #pod This is the recommended interface for creation of temporary
  #pod directories.  By default the directory will not be removed on exit
  #pod (that is, it won't be temporary; this behaviour can not be changed
  #pod because of issues with backwards compatibility). To enable removal
  #pod either use the CLEANUP option which will trigger removal on program
  #pod exit, or consider using the "newdir" method in the object interface which
  #pod will allow the directory to be cleaned up when the object goes out of
  #pod scope.
  #pod
  #pod The behaviour of the function depends on the arguments:
  #pod
  #pod   $tempdir = tempdir();
  #pod
  #pod Create a directory in tmpdir() (see L<File::Spec|File::Spec>).
  #pod
  #pod   $tempdir = tempdir( $template );
  #pod
  #pod Create a directory from the supplied template. This template is
  #pod similar to that described for tempfile(). `X' characters at the end
  #pod of the template are replaced with random letters to construct the
  #pod directory name. At least four `X' characters must be in the template.
  #pod
  #pod   $tempdir = tempdir ( DIR => $dir );
  #pod
  #pod Specifies the directory to use for the temporary directory.
  #pod The temporary directory name is derived from an internal template.
  #pod
  #pod   $tempdir = tempdir ( $template, DIR => $dir );
  #pod
  #pod Prepend the supplied directory name to the template. The template
  #pod should not include parent directory specifications itself. Any parent
  #pod directory specifications are removed from the template before
  #pod prepending the supplied directory.
  #pod
  #pod   $tempdir = tempdir ( $template, TMPDIR => 1 );
  #pod
  #pod Using the supplied template, create the temporary directory in
  #pod a standard location for temporary files. Equivalent to doing
  #pod
  #pod   $tempdir = tempdir ( $template, DIR => File::Spec->tmpdir);
  #pod
  #pod but shorter. Parent directory specifications are stripped from the
  #pod template itself. The C<TMPDIR> option is ignored if C<DIR> is set
  #pod explicitly.  Additionally, C<TMPDIR> is implied if neither a template
  #pod nor a directory are supplied.
  #pod
  #pod   $tempdir = tempdir( $template, CLEANUP => 1);
  #pod
  #pod Create a temporary directory using the supplied template, but
  #pod attempt to remove it (and all files inside it) when the program
  #pod exits. Note that an attempt will be made to remove all files from
  #pod the directory even if they were not created by this module (otherwise
  #pod why ask to clean it up?). The directory removal is made with
  #pod the rmtree() function from the L<File::Path|File::Path> module.
  #pod Of course, if the template is not specified, the temporary directory
  #pod will be created in tmpdir() and will also be removed at program exit.
  #pod
  #pod Will croak() if there is an error.
  #pod
  #pod Current API available since 0.05.
  #pod
  #pod =cut
  
  # '
  
  sub tempdir  {
    if ( @_ && $_[0] eq 'File::Temp' ) {
        croak "'tempdir' can't be called as a method";
    }
  
    # Can not check for argument count since we can have any
    # number of args
  
    # Default options
    my %options = (
                   "CLEANUP"    => 0, # Remove directory on exit
                   "DIR"        => '', # Root directory
                   "TMPDIR"     => 0,  # Use tempdir with template
                  );
  
    # Check to see whether we have an odd or even number of arguments
    my ($maybe_template, $args) = _parse_args(@_);
    my $template = @$maybe_template ? $maybe_template->[0] : undef;
  
    # Read the options and merge with defaults
    %options = (%options, %$args);
  
    # Modify or generate the template
  
    # Deal with the DIR and TMPDIR options
    if (defined $template) {
  
      # Need to strip directory path if using DIR or TMPDIR
      if ($options{'TMPDIR'} || $options{'DIR'}) {
  
        # Strip parent directory from the filename
        #
        # There is no filename at the end
        $template = VMS::Filespec::vmspath($template) if $^O eq 'VMS';
        my ($volume, $directories, undef) = File::Spec->splitpath( $template, 1);
  
        # Last directory is then our template
        $template = (File::Spec->splitdir($directories))[-1];
  
        # Prepend the supplied directory or temp dir
        if ($options{"DIR"}) {
  
          $template = File::Spec->catdir($options{"DIR"}, $template);
  
        } elsif ($options{TMPDIR}) {
  
          # Prepend tmpdir
          $template = File::Spec->catdir(_wrap_file_spec_tmpdir(), $template);
  
        }
  
      }
  
    } else {
  
      if ($options{"DIR"}) {
  
        $template = File::Spec->catdir($options{"DIR"}, TEMPXXX);
  
      } else {
  
        $template = File::Spec->catdir(_wrap_file_spec_tmpdir(), TEMPXXX);
  
      }
  
    }
  
    # Create the directory
    my $tempdir;
    my $suffixlen = 0;
    if ($^O eq 'VMS') {           # dir names can end in delimiters
      $template =~ m/([\.\]:>]+)$/;
      $suffixlen = length($1);
    }
    if ( ($^O eq 'MacOS') && (substr($template, -1) eq ':') ) {
      # dir name has a trailing ':'
      ++$suffixlen;
    }
  
    my $errstr;
    croak "Error in tempdir() using $template: $errstr"
      unless ((undef, $tempdir) = _gettemp($template,
                                           "open" => 0,
                                           "mkdir"=> 1 ,
                                           "suffixlen" => $suffixlen,
                                           "ErrStr" => \$errstr,
                                          ) );
  
    # Install exit handler; must be dynamic to get lexical
    if ( $options{'CLEANUP'} && -d $tempdir) {
      _deferred_unlink(undef, $tempdir, 1);
    }
  
    # Return the dir name
    return $tempdir;
  
  }
  
  #pod =back
  #pod
  #pod =head1 MKTEMP FUNCTIONS
  #pod
  #pod The following functions are Perl implementations of the
  #pod mktemp() family of temp file generation system calls.
  #pod
  #pod =over 4
  #pod
  #pod =item B<mkstemp>
  #pod
  #pod Given a template, returns a filehandle to the temporary file and the name
  #pod of the file.
  #pod
  #pod   ($fh, $name) = mkstemp( $template );
  #pod
  #pod In scalar context, just the filehandle is returned.
  #pod
  #pod The template may be any filename with some number of X's appended
  #pod to it, for example F</tmp/temp.XXXX>. The trailing X's are replaced
  #pod with unique alphanumeric combinations.
  #pod
  #pod Will croak() if there is an error.
  #pod
  #pod Current API available since 0.05.
  #pod
  #pod =cut
  
  
  
  sub mkstemp {
  
    croak "Usage: mkstemp(template)"
      if scalar(@_) != 1;
  
    my $template = shift;
  
    my ($fh, $path, $errstr);
    croak "Error in mkstemp using $template: $errstr"
      unless (($fh, $path) = _gettemp($template,
                                      "open" => 1,
                                      "mkdir"=> 0 ,
                                      "suffixlen" => 0,
                                      "ErrStr" => \$errstr,
                                     ) );
  
    if (wantarray()) {
      return ($fh, $path);
    } else {
      return $fh;
    }
  
  }
  
  
  #pod =item B<mkstemps>
  #pod
  #pod Similar to mkstemp(), except that an extra argument can be supplied
  #pod with a suffix to be appended to the template.
  #pod
  #pod   ($fh, $name) = mkstemps( $template, $suffix );
  #pod
  #pod For example a template of C<testXXXXXX> and suffix of C<.dat>
  #pod would generate a file similar to F<testhGji_w.dat>.
  #pod
  #pod Returns just the filehandle alone when called in scalar context.
  #pod
  #pod Will croak() if there is an error.
  #pod
  #pod Current API available since 0.05.
  #pod
  #pod =cut
  
  sub mkstemps {
  
    croak "Usage: mkstemps(template, suffix)"
      if scalar(@_) != 2;
  
  
    my $template = shift;
    my $suffix   = shift;
  
    $template .= $suffix;
  
    my ($fh, $path, $errstr);
    croak "Error in mkstemps using $template: $errstr"
      unless (($fh, $path) = _gettemp($template,
                                      "open" => 1,
                                      "mkdir"=> 0 ,
                                      "suffixlen" => length($suffix),
                                      "ErrStr" => \$errstr,
                                     ) );
  
    if (wantarray()) {
      return ($fh, $path);
    } else {
      return $fh;
    }
  
  }
  
  #pod =item B<mkdtemp>
  #pod
  #pod Create a directory from a template. The template must end in
  #pod X's that are replaced by the routine.
  #pod
  #pod   $tmpdir_name = mkdtemp($template);
  #pod
  #pod Returns the name of the temporary directory created.
  #pod
  #pod Directory must be removed by the caller.
  #pod
  #pod Will croak() if there is an error.
  #pod
  #pod Current API available since 0.05.
  #pod
  #pod =cut
  
  #' # for emacs
  
  sub mkdtemp {
  
    croak "Usage: mkdtemp(template)"
      if scalar(@_) != 1;
  
    my $template = shift;
    my $suffixlen = 0;
    if ($^O eq 'VMS') {           # dir names can end in delimiters
      $template =~ m/([\.\]:>]+)$/;
      $suffixlen = length($1);
    }
    if ( ($^O eq 'MacOS') && (substr($template, -1) eq ':') ) {
      # dir name has a trailing ':'
      ++$suffixlen;
    }
    my ($junk, $tmpdir, $errstr);
    croak "Error creating temp directory from template $template\: $errstr"
      unless (($junk, $tmpdir) = _gettemp($template,
                                          "open" => 0,
                                          "mkdir"=> 1 ,
                                          "suffixlen" => $suffixlen,
                                          "ErrStr" => \$errstr,
                                         ) );
  
    return $tmpdir;
  
  }
  
  #pod =item B<mktemp>
  #pod
  #pod Returns a valid temporary filename but does not guarantee
  #pod that the file will not be opened by someone else.
  #pod
  #pod   $unopened_file = mktemp($template);
  #pod
  #pod Template is the same as that required by mkstemp().
  #pod
  #pod Will croak() if there is an error.
  #pod
  #pod Current API available since 0.05.
  #pod
  #pod =cut
  
  sub mktemp {
  
    croak "Usage: mktemp(template)"
      if scalar(@_) != 1;
  
    my $template = shift;
  
    my ($tmpname, $junk, $errstr);
    croak "Error getting name to temp file from template $template: $errstr"
      unless (($junk, $tmpname) = _gettemp($template,
                                           "open" => 0,
                                           "mkdir"=> 0 ,
                                           "suffixlen" => 0,
                                           "ErrStr" => \$errstr,
                                          ) );
  
    return $tmpname;
  }
  
  #pod =back
  #pod
  #pod =head1 POSIX FUNCTIONS
  #pod
  #pod This section describes the re-implementation of the tmpnam()
  #pod and tmpfile() functions described in L<POSIX>
  #pod using the mkstemp() from this module.
  #pod
  #pod Unlike the L<POSIX|POSIX> implementations, the directory used
  #pod for the temporary file is not specified in a system include
  #pod file (C<P_tmpdir>) but simply depends on the choice of tmpdir()
  #pod returned by L<File::Spec|File::Spec>. On some implementations this
  #pod location can be set using the C<TMPDIR> environment variable, which
  #pod may not be secure.
  #pod If this is a problem, simply use mkstemp() and specify a template.
  #pod
  #pod =over 4
  #pod
  #pod =item B<tmpnam>
  #pod
  #pod When called in scalar context, returns the full name (including path)
  #pod of a temporary file (uses mktemp()). The only check is that the file does
  #pod not already exist, but there is no guarantee that that condition will
  #pod continue to apply.
  #pod
  #pod   $file = tmpnam();
  #pod
  #pod When called in list context, a filehandle to the open file and
  #pod a filename are returned. This is achieved by calling mkstemp()
  #pod after constructing a suitable template.
  #pod
  #pod   ($fh, $file) = tmpnam();
  #pod
  #pod If possible, this form should be used to prevent possible
  #pod race conditions.
  #pod
  #pod See L<File::Spec/tmpdir> for information on the choice of temporary
  #pod directory for a particular operating system.
  #pod
  #pod Will croak() if there is an error.
  #pod
  #pod Current API available since 0.05.
  #pod
  #pod =cut
  
  sub tmpnam {
  
    # Retrieve the temporary directory name
    my $tmpdir = _wrap_file_spec_tmpdir();
  
    # XXX I don't know under what circumstances this occurs, -- xdg 2016-04-02
    croak "Error temporary directory is not writable"
      if $tmpdir eq '';
  
    # Use a ten character template and append to tmpdir
    my $template = File::Spec->catfile($tmpdir, TEMPXXX);
  
    if (wantarray() ) {
      return mkstemp($template);
    } else {
      return mktemp($template);
    }
  
  }
  
  #pod =item B<tmpfile>
  #pod
  #pod Returns the filehandle of a temporary file.
  #pod
  #pod   $fh = tmpfile();
  #pod
  #pod The file is removed when the filehandle is closed or when the program
  #pod exits. No access to the filename is provided.
  #pod
  #pod If the temporary file can not be created undef is returned.
  #pod Currently this command will probably not work when the temporary
  #pod directory is on an NFS file system.
  #pod
  #pod Will croak() if there is an error.
  #pod
  #pod Available since 0.05.
  #pod
  #pod Returning undef if unable to create file added in 0.12.
  #pod
  #pod =cut
  
  sub tmpfile {
  
    # Simply call tmpnam() in a list context
    my ($fh, $file) = tmpnam();
  
    # Make sure file is removed when filehandle is closed
    # This will fail on NFS
    unlink0($fh, $file)
      or return undef;
  
    return $fh;
  
  }
  
  #pod =back
  #pod
  #pod =head1 ADDITIONAL FUNCTIONS
  #pod
  #pod These functions are provided for backwards compatibility
  #pod with common tempfile generation C library functions.
  #pod
  #pod They are not exported and must be addressed using the full package
  #pod name.
  #pod
  #pod =over 4
  #pod
  #pod =item B<tempnam>
  #pod
  #pod Return the name of a temporary file in the specified directory
  #pod using a prefix. The file is guaranteed not to exist at the time
  #pod the function was called, but such guarantees are good for one
  #pod clock tick only.  Always use the proper form of C<sysopen>
  #pod with C<O_CREAT | O_EXCL> if you must open such a filename.
  #pod
  #pod   $filename = File::Temp::tempnam( $dir, $prefix );
  #pod
  #pod Equivalent to running mktemp() with $dir/$prefixXXXXXXXX
  #pod (using unix file convention as an example)
  #pod
  #pod Because this function uses mktemp(), it can suffer from race conditions.
  #pod
  #pod Will croak() if there is an error.
  #pod
  #pod Current API available since 0.05.
  #pod
  #pod =cut
  
  sub tempnam {
  
    croak 'Usage tempnam($dir, $prefix)' unless scalar(@_) == 2;
  
    my ($dir, $prefix) = @_;
  
    # Add a string to the prefix
    $prefix .= 'XXXXXXXX';
  
    # Concatenate the directory to the file
    my $template = File::Spec->catfile($dir, $prefix);
  
    return mktemp($template);
  
  }
  
  #pod =back
  #pod
  #pod =head1 UTILITY FUNCTIONS
  #pod
  #pod Useful functions for dealing with the filehandle and filename.
  #pod
  #pod =over 4
  #pod
  #pod =item B<unlink0>
  #pod
  #pod Given an open filehandle and the associated filename, make a safe
  #pod unlink. This is achieved by first checking that the filename and
  #pod filehandle initially point to the same file and that the number of
  #pod links to the file is 1 (all fields returned by stat() are compared).
  #pod Then the filename is unlinked and the filehandle checked once again to
  #pod verify that the number of links on that file is now 0.  This is the
  #pod closest you can come to making sure that the filename unlinked was the
  #pod same as the file whose descriptor you hold.
  #pod
  #pod   unlink0($fh, $path)
  #pod      or die "Error unlinking file $path safely";
  #pod
  #pod Returns false on error but croaks() if there is a security
  #pod anomaly. The filehandle is not closed since on some occasions this is
  #pod not required.
  #pod
  #pod On some platforms, for example Windows NT, it is not possible to
  #pod unlink an open file (the file must be closed first). On those
  #pod platforms, the actual unlinking is deferred until the program ends and
  #pod good status is returned. A check is still performed to make sure that
  #pod the filehandle and filename are pointing to the same thing (but not at
  #pod the time the end block is executed since the deferred removal may not
  #pod have access to the filehandle).
  #pod
  #pod Additionally, on Windows NT not all the fields returned by stat() can
  #pod be compared. For example, the C<dev> and C<rdev> fields seem to be
  #pod different.  Also, it seems that the size of the file returned by stat()
  #pod does not always agree, with C<stat(FH)> being more accurate than
  #pod C<stat(filename)>, presumably because of caching issues even when
  #pod using autoflush (this is usually overcome by waiting a while after
  #pod writing to the tempfile before attempting to C<unlink0> it).
  #pod
  #pod Finally, on NFS file systems the link count of the file handle does
  #pod not always go to zero immediately after unlinking. Currently, this
  #pod command is expected to fail on NFS disks.
  #pod
  #pod This function is disabled if the global variable $KEEP_ALL is true
  #pod and an unlink on open file is supported. If the unlink is to be deferred
  #pod to the END block, the file is still registered for removal.
  #pod
  #pod This function should not be called if you are using the object oriented
  #pod interface since the it will interfere with the object destructor deleting
  #pod the file.
  #pod
  #pod Available Since 0.05.
  #pod
  #pod If can not unlink open file, defer removal until later available since 0.06.
  #pod
  #pod =cut
  
  sub unlink0 {
  
    croak 'Usage: unlink0(filehandle, filename)'
      unless scalar(@_) == 2;
  
    # Read args
    my ($fh, $path) = @_;
  
    cmpstat($fh, $path) or return 0;
  
    # attempt remove the file (does not work on some platforms)
    if (_can_unlink_opened_file()) {
  
      # return early (Without unlink) if we have been instructed to retain files.
      return 1 if $KEEP_ALL;
  
      # XXX: do *not* call this on a directory; possible race
      #      resulting in recursive removal
      croak "unlink0: $path has become a directory!" if -d $path;
      unlink($path) or return 0;
  
      # Stat the filehandle
      my @fh = stat $fh;
  
      print "Link count = $fh[3] \n" if $DEBUG;
  
      # Make sure that the link count is zero
      # - Cygwin provides deferred unlinking, however,
      #   on Win9x the link count remains 1
      # On NFS the link count may still be 1 but we can't know that
      # we are on NFS.  Since we can't be sure, we'll defer it
  
      return 1 if $fh[3] == 0 || $^O eq 'cygwin';
    }
    # fall-through if we can't unlink now
    _deferred_unlink($fh, $path, 0);
    return 1;
  }
  
  #pod =item B<cmpstat>
  #pod
  #pod Compare C<stat> of filehandle with C<stat> of provided filename.  This
  #pod can be used to check that the filename and filehandle initially point
  #pod to the same file and that the number of links to the file is 1 (all
  #pod fields returned by stat() are compared).
  #pod
  #pod   cmpstat($fh, $path)
  #pod      or die "Error comparing handle with file";
  #pod
  #pod Returns false if the stat information differs or if the link count is
  #pod greater than 1. Calls croak if there is a security anomaly.
  #pod
  #pod On certain platforms, for example Windows, not all the fields returned by stat()
  #pod can be compared. For example, the C<dev> and C<rdev> fields seem to be
  #pod different in Windows.  Also, it seems that the size of the file
  #pod returned by stat() does not always agree, with C<stat(FH)> being more
  #pod accurate than C<stat(filename)>, presumably because of caching issues
  #pod even when using autoflush (this is usually overcome by waiting a while
  #pod after writing to the tempfile before attempting to C<unlink0> it).
  #pod
  #pod Not exported by default.
  #pod
  #pod Current API available since 0.14.
  #pod
  #pod =cut
  
  sub cmpstat {
  
    croak 'Usage: cmpstat(filehandle, filename)'
      unless scalar(@_) == 2;
  
    # Read args
    my ($fh, $path) = @_;
  
    warn "Comparing stat\n"
      if $DEBUG;
  
    # Stat the filehandle - which may be closed if someone has manually
    # closed the file. Can not turn off warnings without using $^W
    # unless we upgrade to 5.006 minimum requirement
    my @fh;
    {
      local ($^W) = 0;
      @fh = stat $fh;
    }
    return unless @fh;
  
    if ($fh[3] > 1 && $^W) {
      carp "unlink0: fstat found too many links; SB=@fh" if $^W;
    }
  
    # Stat the path
    my @path = stat $path;
  
    unless (@path) {
      carp "unlink0: $path is gone already" if $^W;
      return;
    }
  
    # this is no longer a file, but may be a directory, or worse
    unless (-f $path) {
      confess "panic: $path is no longer a file: SB=@fh";
    }
  
    # Do comparison of each member of the array
    # On WinNT dev and rdev seem to be different
    # depending on whether it is a file or a handle.
    # Cannot simply compare all members of the stat return
    # Select the ones we can use
    my @okstat = (0..$#fh);       # Use all by default
    if ($^O eq 'MSWin32') {
      @okstat = (1,2,3,4,5,7,8,9,10);
    } elsif ($^O eq 'os2') {
      @okstat = (0, 2..$#fh);
    } elsif ($^O eq 'VMS') {      # device and file ID are sufficient
      @okstat = (0, 1);
    } elsif ($^O eq 'dos') {
      @okstat = (0,2..7,11..$#fh);
    } elsif ($^O eq 'mpeix') {
      @okstat = (0..4,8..10);
    }
  
    # Now compare each entry explicitly by number
    for (@okstat) {
      print "Comparing: $_ : $fh[$_] and $path[$_]\n" if $DEBUG;
      # Use eq rather than == since rdev, blksize, and blocks (6, 11,
      # and 12) will be '' on platforms that do not support them.  This
      # is fine since we are only comparing integers.
      unless ($fh[$_] eq $path[$_]) {
        warn "Did not match $_ element of stat\n" if $DEBUG;
        return 0;
      }
    }
  
    return 1;
  }
  
  #pod =item B<unlink1>
  #pod
  #pod Similar to C<unlink0> except after file comparison using cmpstat, the
  #pod filehandle is closed prior to attempting to unlink the file. This
  #pod allows the file to be removed without using an END block, but does
  #pod mean that the post-unlink comparison of the filehandle state provided
  #pod by C<unlink0> is not available.
  #pod
  #pod   unlink1($fh, $path)
  #pod      or die "Error closing and unlinking file";
  #pod
  #pod Usually called from the object destructor when using the OO interface.
  #pod
  #pod Not exported by default.
  #pod
  #pod This function is disabled if the global variable $KEEP_ALL is true.
  #pod
  #pod Can call croak() if there is a security anomaly during the stat()
  #pod comparison.
  #pod
  #pod Current API available since 0.14.
  #pod
  #pod =cut
  
  sub unlink1 {
    croak 'Usage: unlink1(filehandle, filename)'
      unless scalar(@_) == 2;
  
    # Read args
    my ($fh, $path) = @_;
  
    cmpstat($fh, $path) or return 0;
  
    # Close the file
    close( $fh ) or return 0;
  
    # Make sure the file is writable (for windows)
    _force_writable( $path );
  
    # return early (without unlink) if we have been instructed to retain files.
    return 1 if $KEEP_ALL;
  
    # remove the file
    return unlink($path);
  }
  
  #pod =item B<cleanup>
  #pod
  #pod Calling this function will cause any temp files or temp directories
  #pod that are registered for removal to be removed. This happens automatically
  #pod when the process exits but can be triggered manually if the caller is sure
  #pod that none of the temp files are required. This method can be registered as
  #pod an Apache callback.
  #pod
  #pod Note that if a temp directory is your current directory, it cannot be
  #pod removed.  C<chdir()> out of the directory first before calling
  #pod C<cleanup()>. (For the cleanup at program exit when the CLEANUP flag
  #pod is set, this happens automatically.)
  #pod
  #pod On OSes where temp files are automatically removed when the temp file
  #pod is closed, calling this function will have no effect other than to remove
  #pod temporary directories (which may include temporary files).
  #pod
  #pod   File::Temp::cleanup();
  #pod
  #pod Not exported by default.
  #pod
  #pod Current API available since 0.15.
  #pod
  #pod =back
  #pod
  #pod =head1 PACKAGE VARIABLES
  #pod
  #pod These functions control the global state of the package.
  #pod
  #pod =over 4
  #pod
  #pod =item B<safe_level>
  #pod
  #pod Controls the lengths to which the module will go to check the safety of the
  #pod temporary file or directory before proceeding.
  #pod Options are:
  #pod
  #pod =over 8
  #pod
  #pod =item STANDARD
  #pod
  #pod Do the basic security measures to ensure the directory exists and is
  #pod writable, that temporary files are opened only if they do not already
  #pod exist, and that possible race conditions are avoided.  Finally the
  #pod L<unlink0|"unlink0"> function is used to remove files safely.
  #pod
  #pod =item MEDIUM
  #pod
  #pod In addition to the STANDARD security, the output directory is checked
  #pod to make sure that it is owned either by root or the user running the
  #pod program. If the directory is writable by group or by other, it is then
  #pod checked to make sure that the sticky bit is set.
  #pod
  #pod Will not work on platforms that do not support the C<-k> test
  #pod for sticky bit.
  #pod
  #pod =item HIGH
  #pod
  #pod In addition to the MEDIUM security checks, also check for the
  #pod possibility of ``chown() giveaway'' using the L<POSIX|POSIX>
  #pod sysconf() function. If this is a possibility, each directory in the
  #pod path is checked in turn for safeness, recursively walking back to the
  #pod root directory.
  #pod
  #pod For platforms that do not support the L<POSIX|POSIX>
  #pod C<_PC_CHOWN_RESTRICTED> symbol (for example, Windows NT) it is
  #pod assumed that ``chown() giveaway'' is possible and the recursive test
  #pod is performed.
  #pod
  #pod =back
  #pod
  #pod The level can be changed as follows:
  #pod
  #pod   File::Temp->safe_level( File::Temp::HIGH );
  #pod
  #pod The level constants are not exported by the module.
  #pod
  #pod Currently, you must be running at least perl v5.6.0 in order to
  #pod run with MEDIUM or HIGH security. This is simply because the
  #pod safety tests use functions from L<Fcntl|Fcntl> that are not
  #pod available in older versions of perl. The problem is that the version
  #pod number for Fcntl is the same in perl 5.6.0 and in 5.005_03 even though
  #pod they are different versions.
  #pod
  #pod On systems that do not support the HIGH or MEDIUM safety levels
  #pod (for example Win NT or OS/2) any attempt to change the level will
  #pod be ignored. The decision to ignore rather than raise an exception
  #pod allows portable programs to be written with high security in mind
  #pod for the systems that can support this without those programs failing
  #pod on systems where the extra tests are irrelevant.
  #pod
  #pod If you really need to see whether the change has been accepted
  #pod simply examine the return value of C<safe_level>.
  #pod
  #pod   $newlevel = File::Temp->safe_level( File::Temp::HIGH );
  #pod   die "Could not change to high security"
  #pod       if $newlevel != File::Temp::HIGH;
  #pod
  #pod Available since 0.05.
  #pod
  #pod =cut
  
  {
    # protect from using the variable itself
    my $LEVEL = STANDARD;
    sub safe_level {
      my $self = shift;
      if (@_) {
        my $level = shift;
        if (($level != STANDARD) && ($level != MEDIUM) && ($level != HIGH)) {
          carp "safe_level: Specified level ($level) not STANDARD, MEDIUM or HIGH - ignoring\n" if $^W;
        } else {
          # Don't allow this on perl 5.005 or earlier
          if ($] < 5.006 && $level != STANDARD) {
            # Cant do MEDIUM or HIGH checks
            croak "Currently requires perl 5.006 or newer to do the safe checks";
          }
          # Check that we are allowed to change level
          # Silently ignore if we can not.
          $LEVEL = $level if _can_do_level($level);
        }
      }
      return $LEVEL;
    }
  }
  
  #pod =item TopSystemUID
  #pod
  #pod This is the highest UID on the current system that refers to a root
  #pod UID. This is used to make sure that the temporary directory is
  #pod owned by a system UID (C<root>, C<bin>, C<sys> etc) rather than
  #pod simply by root.
  #pod
  #pod This is required since on many unix systems C</tmp> is not owned
  #pod by root.
  #pod
  #pod Default is to assume that any UID less than or equal to 10 is a root
  #pod UID.
  #pod
  #pod   File::Temp->top_system_uid(10);
  #pod   my $topid = File::Temp->top_system_uid;
  #pod
  #pod This value can be adjusted to reduce security checking if required.
  #pod The value is only relevant when C<safe_level> is set to MEDIUM or higher.
  #pod
  #pod Available since 0.05.
  #pod
  #pod =cut
  
  {
    my $TopSystemUID = 10;
    $TopSystemUID = 197108 if $^O eq 'interix'; # "Administrator"
    sub top_system_uid {
      my $self = shift;
      if (@_) {
        my $newuid = shift;
        croak "top_system_uid: UIDs should be numeric"
          unless $newuid =~ /^\d+$/s;
        $TopSystemUID = $newuid;
      }
      return $TopSystemUID;
    }
  }
  
  #pod =item B<$KEEP_ALL>
  #pod
  #pod Controls whether temporary files and directories should be retained
  #pod regardless of any instructions in the program to remove them
  #pod automatically.  This is useful for debugging but should not be used in
  #pod production code.
  #pod
  #pod   $File::Temp::KEEP_ALL = 1;
  #pod
  #pod Default is for files to be removed as requested by the caller.
  #pod
  #pod In some cases, files will only be retained if this variable is true
  #pod when the file is created. This means that you can not create a temporary
  #pod file, set this variable and expect the temp file to still be around
  #pod when the program exits.
  #pod
  #pod =item B<$DEBUG>
  #pod
  #pod Controls whether debugging messages should be enabled.
  #pod
  #pod   $File::Temp::DEBUG = 1;
  #pod
  #pod Default is for debugging mode to be disabled.
  #pod
  #pod Available since 0.15.
  #pod
  #pod =back
  #pod
  #pod =head1 WARNING
  #pod
  #pod For maximum security, endeavour always to avoid ever looking at,
  #pod touching, or even imputing the existence of the filename.  You do not
  #pod know that that filename is connected to the same file as the handle
  #pod you have, and attempts to check this can only trigger more race
  #pod conditions.  It's far more secure to use the filehandle alone and
  #pod dispense with the filename altogether.
  #pod
  #pod If you need to pass the handle to something that expects a filename
  #pod then on a unix system you can use C<"/dev/fd/" . fileno($fh)> for
  #pod arbitrary programs. Perl code that uses the 2-argument version of
  #pod C<< open >> can be passed C<< "+<=&" . fileno($fh) >>. Otherwise you
  #pod will need to pass the filename. You will have to clear the
  #pod close-on-exec bit on that file descriptor before passing it to another
  #pod process.
  #pod
  #pod     use Fcntl qw/F_SETFD F_GETFD/;
  #pod     fcntl($tmpfh, F_SETFD, 0)
  #pod         or die "Can't clear close-on-exec flag on temp fh: $!\n";
  #pod
  #pod =head2 Temporary files and NFS
  #pod
  #pod Some problems are associated with using temporary files that reside
  #pod on NFS file systems and it is recommended that a local filesystem
  #pod is used whenever possible. Some of the security tests will most probably
  #pod fail when the temp file is not local. Additionally, be aware that
  #pod the performance of I/O operations over NFS will not be as good as for
  #pod a local disk.
  #pod
  #pod =head2 Forking
  #pod
  #pod In some cases files created by File::Temp are removed from within an
  #pod END block. Since END blocks are triggered when a child process exits
  #pod (unless C<POSIX::_exit()> is used by the child) File::Temp takes care
  #pod to only remove those temp files created by a particular process ID. This
  #pod means that a child will not attempt to remove temp files created by the
  #pod parent process.
  #pod
  #pod If you are forking many processes in parallel that are all creating
  #pod temporary files, you may need to reset the random number seed using
  #pod srand(EXPR) in each child else all the children will attempt to walk
  #pod through the same set of random file names and may well cause
  #pod themselves to give up if they exceed the number of retry attempts.
  #pod
  #pod =head2 Directory removal
  #pod
  #pod Note that if you have chdir'ed into the temporary directory and it is
  #pod subsequently cleaned up (either in the END block or as part of object
  #pod destruction), then you will get a warning from File::Path::rmtree().
  #pod
  #pod =head2 Taint mode
  #pod
  #pod If you need to run code under taint mode, updating to the latest
  #pod L<File::Spec> is highly recommended.  On Windows, if the directory
  #pod given by L<File::Spec::tmpdir> isn't writable, File::Temp will attempt
  #pod to fallback to the user's local application data directory or croak
  #pod with an error.
  #pod
  #pod =head2 BINMODE
  #pod
  #pod The file returned by File::Temp will have been opened in binary mode
  #pod if such a mode is available. If that is not correct, use the C<binmode()>
  #pod function to change the mode of the filehandle.
  #pod
  #pod Note that you can modify the encoding of a file opened by File::Temp
  #pod also by using C<binmode()>.
  #pod
  #pod =head1 HISTORY
  #pod
  #pod Originally began life in May 1999 as an XS interface to the system
  #pod mkstemp() function. In March 2000, the OpenBSD mkstemp() code was
  #pod translated to Perl for total control of the code's
  #pod security checking, to ensure the presence of the function regardless of
  #pod operating system and to help with portability. The module was shipped
  #pod as a standard part of perl from v5.6.1.
  #pod
  #pod Thanks to Tom Christiansen for suggesting that this module
  #pod should be written and providing ideas for code improvements and
  #pod security enhancements.
  #pod
  #pod =head1 SEE ALSO
  #pod
  #pod L<POSIX/tmpnam>, L<POSIX/tmpfile>, L<File::Spec>, L<File::Path>
  #pod
  #pod See L<IO::File> and L<File::MkTemp>, L<Apache::TempFile> for
  #pod different implementations of temporary file handling.
  #pod
  #pod See L<File::Tempdir> for an alternative object-oriented wrapper for
  #pod the C<tempdir> function.
  #pod
  #pod =cut
  
  package ## hide from PAUSE
    File::Temp::Dir;
  
  our $VERSION = '0.2309';
  
  use File::Path qw/ rmtree /;
  use strict;
  use overload '""' => "STRINGIFY",
    '0+' => \&File::Temp::NUMIFY,
    fallback => 1;
  
  # private class specifically to support tempdir objects
  # created by File::Temp->newdir
  
  # ostensibly the same method interface as File::Temp but without
  # inheriting all the IO::Seekable methods and other cruft
  
  # Read-only - returns the name of the temp directory
  
  sub dirname {
    my $self = shift;
    return $self->{DIRNAME};
  }
  
  sub STRINGIFY {
    my $self = shift;
    return $self->dirname;
  }
  
  sub unlink_on_destroy {
    my $self = shift;
    if (@_) {
      $self->{CLEANUP} = shift;
    }
    return $self->{CLEANUP};
  }
  
  sub DESTROY {
    my $self = shift;
    local($., $@, $!, $^E, $?);
    if ($self->unlink_on_destroy && 
        $$ == $self->{LAUNCHPID} && !$File::Temp::KEEP_ALL) {
      if (-d $self->{REALNAME}) {
        # Some versions of rmtree will abort if you attempt to remove
        # the directory you are sitting in. We protect that and turn it
        # into a warning. We do this because this occurs during object
        # destruction and so can not be caught by the user.
        eval { rmtree($self->{REALNAME}, $File::Temp::DEBUG, 0); };
        warn $@ if ($@ && $^W);
      }
    }
  }
  
  1;
  
  
  # vim: ts=2 sts=2 sw=2 et:
  
  __END__
  
  =pod
  
  =encoding UTF-8
  
  =head1 NAME
  
  File::Temp - return name and handle of a temporary file safely
  
  =head1 VERSION
  
  version 0.2309
  
  =head1 SYNOPSIS
  
    use File::Temp qw/ tempfile tempdir /;
  
    $fh = tempfile();
    ($fh, $filename) = tempfile();
  
    ($fh, $filename) = tempfile( $template, DIR => $dir);
    ($fh, $filename) = tempfile( $template, SUFFIX => '.dat');
    ($fh, $filename) = tempfile( $template, TMPDIR => 1 );
  
    binmode( $fh, ":utf8" );
  
    $dir = tempdir( CLEANUP => 1 );
    ($fh, $filename) = tempfile( DIR => $dir );
  
  Object interface:
  
    require File::Temp;
    use File::Temp ();
    use File::Temp qw/ :seekable /;
  
    $fh = File::Temp->new();
    $fname = $fh->filename;
  
    $fh = File::Temp->new(TEMPLATE => $template);
    $fname = $fh->filename;
  
    $tmp = File::Temp->new( UNLINK => 0, SUFFIX => '.dat' );
    print $tmp "Some data\n";
    print "Filename is $tmp\n";
    $tmp->seek( 0, SEEK_END );
  
    $dir = File::Temp->newdir(); # CLEANUP => 1 by default
  
  The following interfaces are provided for compatibility with
  existing APIs. They should not be used in new code.
  
  MkTemp family:
  
    use File::Temp qw/ :mktemp  /;
  
    ($fh, $file) = mkstemp( "tmpfileXXXXX" );
    ($fh, $file) = mkstemps( "tmpfileXXXXXX", $suffix);
  
    $tmpdir = mkdtemp( $template );
  
    $unopened_file = mktemp( $template );
  
  POSIX functions:
  
    use File::Temp qw/ :POSIX /;
  
    $file = tmpnam();
    $fh = tmpfile();
  
    ($fh, $file) = tmpnam();
  
  Compatibility functions:
  
    $unopened_file = File::Temp::tempnam( $dir, $pfx );
  
  =head1 DESCRIPTION
  
  C<File::Temp> can be used to create and open temporary files in a safe
  way.  There is both a function interface and an object-oriented
  interface.  The File::Temp constructor or the tempfile() function can
  be used to return the name and the open filehandle of a temporary
  file.  The tempdir() function can be used to create a temporary
  directory.
  
  The security aspect of temporary file creation is emphasized such that
  a filehandle and filename are returned together.  This helps guarantee
  that a race condition can not occur where the temporary file is
  created by another process between checking for the existence of the
  file and its opening.  Additional security levels are provided to
  check, for example, that the sticky bit is set on world writable
  directories.  See L<"safe_level"> for more information.
  
  For compatibility with popular C library functions, Perl implementations of
  the mkstemp() family of functions are provided. These are, mkstemp(),
  mkstemps(), mkdtemp() and mktemp().
  
  Additionally, implementations of the standard L<POSIX|POSIX>
  tmpnam() and tmpfile() functions are provided if required.
  
  Implementations of mktemp(), tmpnam(), and tempnam() are provided,
  but should be used with caution since they return only a filename
  that was valid when function was called, so cannot guarantee
  that the file will not exist by the time the caller opens the filename.
  
  Filehandles returned by these functions support the seekable methods.
  
  =begin :__INTERNALS
  
  =head1 PORTABILITY
  
  This section is at the top in order to provide easier access to
  porters.  It is not expected to be rendered by a standard pod
  formatting tool. Please skip straight to the SYNOPSIS section if you
  are not trying to port this module to a new platform.
  
  This module is designed to be portable across operating systems and it
  currently supports Unix, VMS, DOS, OS/2, Windows and Mac OS
  (Classic). When porting to a new OS there are generally three main
  issues that have to be solved:
  
  =over 4
  
  =item *
  
  Can the OS unlink an open file? If it can not then the
  C<_can_unlink_opened_file> method should be modified.
  
  =item *
  
  Are the return values from C<stat> reliable? By default all the
  return values from C<stat> are compared when unlinking a temporary
  file using the filename and the handle. Operating systems other than
  unix do not always have valid entries in all fields. If utility function
  C<File::Temp::unlink0> fails then the C<stat> comparison should be
  modified accordingly.
  
  =item *
  
  Security. Systems that can not support a test for the sticky bit
  on a directory can not use the MEDIUM and HIGH security tests.
  The C<_can_do_level> method should be modified accordingly.
  
  =back
  
  =end :__INTERNALS
  
  =head1 OBJECT-ORIENTED INTERFACE
  
  This is the primary interface for interacting with
  C<File::Temp>. Using the OO interface a temporary file can be created
  when the object is constructed and the file can be removed when the
  object is no longer required.
  
  Note that there is no method to obtain the filehandle from the
  C<File::Temp> object. The object itself acts as a filehandle.  The object
  isa C<IO::Handle> and isa C<IO::Seekable> so all those methods are
  available.
  
  Also, the object is configured such that it stringifies to the name of the
  temporary file and so can be compared to a filename directly.  It numifies
  to the C<refaddr> the same as other handles and so can be compared to other
  handles with C<==>.
  
      $fh eq $filename       # as a string
      $fh != \*STDOUT        # as a number
  
  Available since 0.14.
  
  =over 4
  
  =item B<new>
  
  Create a temporary file object.
  
    my $tmp = File::Temp->new();
  
  by default the object is constructed as if C<tempfile>
  was called without options, but with the additional behaviour
  that the temporary file is removed by the object destructor
  if UNLINK is set to true (the default).
  
  Supported arguments are the same as for C<tempfile>: UNLINK
  (defaulting to true), DIR, EXLOCK and SUFFIX. Additionally, the filename
  template is specified using the TEMPLATE option. The OPEN option
  is not supported (the file is always opened).
  
   $tmp = File::Temp->new( TEMPLATE => 'tempXXXXX',
                          DIR => 'mydir',
                          SUFFIX => '.dat');
  
  Arguments are case insensitive.
  
  Can call croak() if an error occurs.
  
  Available since 0.14.
  
  TEMPLATE available since 0.23
  
  =item B<newdir>
  
  Create a temporary directory using an object oriented interface.
  
    $dir = File::Temp->newdir();
  
  By default the directory is deleted when the object goes out of scope.
  
  Supports the same options as the C<tempdir> function. Note that directories
  created with this method default to CLEANUP => 1.
  
    $dir = File::Temp->newdir( $template, %options );
  
  A template may be specified either with a leading template or
  with a TEMPLATE argument.
  
  Available since 0.19.
  
  TEMPLATE available since 0.23.
  
  =item B<filename>
  
  Return the name of the temporary file associated with this object
  (if the object was created using the "new" constructor).
  
    $filename = $tmp->filename;
  
  This method is called automatically when the object is used as
  a string.
  
  Current API available since 0.14
  
  =item B<dirname>
  
  Return the name of the temporary directory associated with this
  object (if the object was created using the "newdir" constructor).
  
    $dirname = $tmpdir->dirname;
  
  This method is called automatically when the object is used in string context.
  
  =item B<unlink_on_destroy>
  
  Control whether the file is unlinked when the object goes out of scope.
  The file is removed if this value is true and $KEEP_ALL is not.
  
   $fh->unlink_on_destroy( 1 );
  
  Default is for the file to be removed.
  
  Current API available since 0.15
  
  =item B<DESTROY>
  
  When the object goes out of scope, the destructor is called. This
  destructor will attempt to unlink the file (using L<unlink1|"unlink1">)
  if the constructor was called with UNLINK set to 1 (the default state
  if UNLINK is not specified).
  
  No error is given if the unlink fails.
  
  If the object has been passed to a child process during a fork, the
  file will be deleted when the object goes out of scope in the parent.
  
  For a temporary directory object the directory will be removed unless
  the CLEANUP argument was used in the constructor (and set to false) or
  C<unlink_on_destroy> was modified after creation.  Note that if a temp
  directory is your current directory, it cannot be removed - a warning
  will be given in this case.  C<chdir()> out of the directory before
  letting the object go out of scope.
  
  If the global variable $KEEP_ALL is true, the file or directory
  will not be removed.
  
  =back
  
  =head1 FUNCTIONS
  
  This section describes the recommended interface for generating
  temporary files and directories.
  
  =over 4
  
  =item B<tempfile>
  
  This is the basic function to generate temporary files.
  The behaviour of the file can be changed using various options:
  
    $fh = tempfile();
    ($fh, $filename) = tempfile();
  
  Create a temporary file in  the directory specified for temporary
  files, as specified by the tmpdir() function in L<File::Spec>.
  
    ($fh, $filename) = tempfile($template);
  
  Create a temporary file in the current directory using the supplied
  template.  Trailing `X' characters are replaced with random letters to
  generate the filename.  At least four `X' characters must be present
  at the end of the template.
  
    ($fh, $filename) = tempfile($template, SUFFIX => $suffix)
  
  Same as previously, except that a suffix is added to the template
  after the `X' translation.  Useful for ensuring that a temporary
  filename has a particular extension when needed by other applications.
  But see the WARNING at the end.
  
    ($fh, $filename) = tempfile($template, DIR => $dir);
  
  Translates the template as before except that a directory name
  is specified.
  
    ($fh, $filename) = tempfile($template, TMPDIR => 1);
  
  Equivalent to specifying a DIR of "File::Spec->tmpdir", writing the file
  into the same temporary directory as would be used if no template was
  specified at all.
  
    ($fh, $filename) = tempfile($template, UNLINK => 1);
  
  Return the filename and filehandle as before except that the file is
  automatically removed when the program exits (dependent on
  $KEEP_ALL). Default is for the file to be removed if a file handle is
  requested and to be kept if the filename is requested. In a scalar
  context (where no filename is returned) the file is always deleted
  either (depending on the operating system) on exit or when it is
  closed (unless $KEEP_ALL is true when the temp file is created).
  
  Use the object-oriented interface if fine-grained control of when
  a file is removed is required.
  
  If the template is not specified, a template is always
  automatically generated. This temporary file is placed in tmpdir()
  (L<File::Spec>) unless a directory is specified explicitly with the
  DIR option.
  
    $fh = tempfile( DIR => $dir );
  
  If called in scalar context, only the filehandle is returned and the
  file will automatically be deleted when closed on operating systems
  that support this (see the description of tmpfile() elsewhere in this
  document).  This is the preferred mode of operation, as if you only
  have a filehandle, you can never create a race condition by fumbling
  with the filename. On systems that can not unlink an open file or can
  not mark a file as temporary when it is opened (for example, Windows
  NT uses the C<O_TEMPORARY> flag) the file is marked for deletion when
  the program ends (equivalent to setting UNLINK to 1). The C<UNLINK>
  flag is ignored if present.
  
    (undef, $filename) = tempfile($template, OPEN => 0);
  
  This will return the filename based on the template but
  will not open this file.  Cannot be used in conjunction with
  UNLINK set to true. Default is to always open the file
  to protect from possible race conditions. A warning is issued
  if warnings are turned on. Consider using the tmpnam()
  and mktemp() functions described elsewhere in this document
  if opening the file is not required.
  
  To open the temporary filehandle with O_EXLOCK (open with exclusive
  file lock) use C<< EXLOCK=>1 >>. This is supported only by some
  operating systems (most notably BSD derived systems). By default
  EXLOCK will be false. Former C<File::Temp> versions set EXLOCK to
  true, so to be sure to get an unlocked filehandle also with older
  versions, explicitly set C<< EXLOCK=>0 >>.
  
    ($fh, $filename) = tempfile($template, EXLOCK => 1);
  
  Options can be combined as required.
  
  Will croak() if there is an error.
  
  Available since 0.05.
  
  UNLINK flag available since 0.10.
  
  TMPDIR flag available since 0.19.
  
  EXLOCK flag available since 0.19.
  
  =item B<tempdir>
  
  This is the recommended interface for creation of temporary
  directories.  By default the directory will not be removed on exit
  (that is, it won't be temporary; this behaviour can not be changed
  because of issues with backwards compatibility). To enable removal
  either use the CLEANUP option which will trigger removal on program
  exit, or consider using the "newdir" method in the object interface which
  will allow the directory to be cleaned up when the object goes out of
  scope.
  
  The behaviour of the function depends on the arguments:
  
    $tempdir = tempdir();
  
  Create a directory in tmpdir() (see L<File::Spec|File::Spec>).
  
    $tempdir = tempdir( $template );
  
  Create a directory from the supplied template. This template is
  similar to that described for tempfile(). `X' characters at the end
  of the template are replaced with random letters to construct the
  directory name. At least four `X' characters must be in the template.
  
    $tempdir = tempdir ( DIR => $dir );
  
  Specifies the directory to use for the temporary directory.
  The temporary directory name is derived from an internal template.
  
    $tempdir = tempdir ( $template, DIR => $dir );
  
  Prepend the supplied directory name to the template. The template
  should not include parent directory specifications itself. Any parent
  directory specifications are removed from the template before
  prepending the supplied directory.
  
    $tempdir = tempdir ( $template, TMPDIR => 1 );
  
  Using the supplied template, create the temporary directory in
  a standard location for temporary files. Equivalent to doing
  
    $tempdir = tempdir ( $template, DIR => File::Spec->tmpdir);
  
  but shorter. Parent directory specifications are stripped from the
  template itself. The C<TMPDIR> option is ignored if C<DIR> is set
  explicitly.  Additionally, C<TMPDIR> is implied if neither a template
  nor a directory are supplied.
  
    $tempdir = tempdir( $template, CLEANUP => 1);
  
  Create a temporary directory using the supplied template, but
  attempt to remove it (and all files inside it) when the program
  exits. Note that an attempt will be made to remove all files from
  the directory even if they were not created by this module (otherwise
  why ask to clean it up?). The directory removal is made with
  the rmtree() function from the L<File::Path|File::Path> module.
  Of course, if the template is not specified, the temporary directory
  will be created in tmpdir() and will also be removed at program exit.
  
  Will croak() if there is an error.
  
  Current API available since 0.05.
  
  =back
  
  =head1 MKTEMP FUNCTIONS
  
  The following functions are Perl implementations of the
  mktemp() family of temp file generation system calls.
  
  =over 4
  
  =item B<mkstemp>
  
  Given a template, returns a filehandle to the temporary file and the name
  of the file.
  
    ($fh, $name) = mkstemp( $template );
  
  In scalar context, just the filehandle is returned.
  
  The template may be any filename with some number of X's appended
  to it, for example F</tmp/temp.XXXX>. The trailing X's are replaced
  with unique alphanumeric combinations.
  
  Will croak() if there is an error.
  
  Current API available since 0.05.
  
  =item B<mkstemps>
  
  Similar to mkstemp(), except that an extra argument can be supplied
  with a suffix to be appended to the template.
  
    ($fh, $name) = mkstemps( $template, $suffix );
  
  For example a template of C<testXXXXXX> and suffix of C<.dat>
  would generate a file similar to F<testhGji_w.dat>.
  
  Returns just the filehandle alone when called in scalar context.
  
  Will croak() if there is an error.
  
  Current API available since 0.05.
  
  =item B<mkdtemp>
  
  Create a directory from a template. The template must end in
  X's that are replaced by the routine.
  
    $tmpdir_name = mkdtemp($template);
  
  Returns the name of the temporary directory created.
  
  Directory must be removed by the caller.
  
  Will croak() if there is an error.
  
  Current API available since 0.05.
  
  =item B<mktemp>
  
  Returns a valid temporary filename but does not guarantee
  that the file will not be opened by someone else.
  
    $unopened_file = mktemp($template);
  
  Template is the same as that required by mkstemp().
  
  Will croak() if there is an error.
  
  Current API available since 0.05.
  
  =back
  
  =head1 POSIX FUNCTIONS
  
  This section describes the re-implementation of the tmpnam()
  and tmpfile() functions described in L<POSIX>
  using the mkstemp() from this module.
  
  Unlike the L<POSIX|POSIX> implementations, the directory used
  for the temporary file is not specified in a system include
  file (C<P_tmpdir>) but simply depends on the choice of tmpdir()
  returned by L<File::Spec|File::Spec>. On some implementations this
  location can be set using the C<TMPDIR> environment variable, which
  may not be secure.
  If this is a problem, simply use mkstemp() and specify a template.
  
  =over 4
  
  =item B<tmpnam>
  
  When called in scalar context, returns the full name (including path)
  of a temporary file (uses mktemp()). The only check is that the file does
  not already exist, but there is no guarantee that that condition will
  continue to apply.
  
    $file = tmpnam();
  
  When called in list context, a filehandle to the open file and
  a filename are returned. This is achieved by calling mkstemp()
  after constructing a suitable template.
  
    ($fh, $file) = tmpnam();
  
  If possible, this form should be used to prevent possible
  race conditions.
  
  See L<File::Spec/tmpdir> for information on the choice of temporary
  directory for a particular operating system.
  
  Will croak() if there is an error.
  
  Current API available since 0.05.
  
  =item B<tmpfile>
  
  Returns the filehandle of a temporary file.
  
    $fh = tmpfile();
  
  The file is removed when the filehandle is closed or when the program
  exits. No access to the filename is provided.
  
  If the temporary file can not be created undef is returned.
  Currently this command will probably not work when the temporary
  directory is on an NFS file system.
  
  Will croak() if there is an error.
  
  Available since 0.05.
  
  Returning undef if unable to create file added in 0.12.
  
  =back
  
  =head1 ADDITIONAL FUNCTIONS
  
  These functions are provided for backwards compatibility
  with common tempfile generation C library functions.
  
  They are not exported and must be addressed using the full package
  name.
  
  =over 4
  
  =item B<tempnam>
  
  Return the name of a temporary file in the specified directory
  using a prefix. The file is guaranteed not to exist at the time
  the function was called, but such guarantees are good for one
  clock tick only.  Always use the proper form of C<sysopen>
  with C<O_CREAT | O_EXCL> if you must open such a filename.
  
    $filename = File::Temp::tempnam( $dir, $prefix );
  
  Equivalent to running mktemp() with $dir/$prefixXXXXXXXX
  (using unix file convention as an example)
  
  Because this function uses mktemp(), it can suffer from race conditions.
  
  Will croak() if there is an error.
  
  Current API available since 0.05.
  
  =back
  
  =head1 UTILITY FUNCTIONS
  
  Useful functions for dealing with the filehandle and filename.
  
  =over 4
  
  =item B<unlink0>
  
  Given an open filehandle and the associated filename, make a safe
  unlink. This is achieved by first checking that the filename and
  filehandle initially point to the same file and that the number of
  links to the file is 1 (all fields returned by stat() are compared).
  Then the filename is unlinked and the filehandle checked once again to
  verify that the number of links on that file is now 0.  This is the
  closest you can come to making sure that the filename unlinked was the
  same as the file whose descriptor you hold.
  
    unlink0($fh, $path)
       or die "Error unlinking file $path safely";
  
  Returns false on error but croaks() if there is a security
  anomaly. The filehandle is not closed since on some occasions this is
  not required.
  
  On some platforms, for example Windows NT, it is not possible to
  unlink an open file (the file must be closed first). On those
  platforms, the actual unlinking is deferred until the program ends and
  good status is returned. A check is still performed to make sure that
  the filehandle and filename are pointing to the same thing (but not at
  the time the end block is executed since the deferred removal may not
  have access to the filehandle).
  
  Additionally, on Windows NT not all the fields returned by stat() can
  be compared. For example, the C<dev> and C<rdev> fields seem to be
  different.  Also, it seems that the size of the file returned by stat()
  does not always agree, with C<stat(FH)> being more accurate than
  C<stat(filename)>, presumably because of caching issues even when
  using autoflush (this is usually overcome by waiting a while after
  writing to the tempfile before attempting to C<unlink0> it).
  
  Finally, on NFS file systems the link count of the file handle does
  not always go to zero immediately after unlinking. Currently, this
  command is expected to fail on NFS disks.
  
  This function is disabled if the global variable $KEEP_ALL is true
  and an unlink on open file is supported. If the unlink is to be deferred
  to the END block, the file is still registered for removal.
  
  This function should not be called if you are using the object oriented
  interface since the it will interfere with the object destructor deleting
  the file.
  
  Available Since 0.05.
  
  If can not unlink open file, defer removal until later available since 0.06.
  
  =item B<cmpstat>
  
  Compare C<stat> of filehandle with C<stat> of provided filename.  This
  can be used to check that the filename and filehandle initially point
  to the same file and that the number of links to the file is 1 (all
  fields returned by stat() are compared).
  
    cmpstat($fh, $path)
       or die "Error comparing handle with file";
  
  Returns false if the stat information differs or if the link count is
  greater than 1. Calls croak if there is a security anomaly.
  
  On certain platforms, for example Windows, not all the fields returned by stat()
  can be compared. For example, the C<dev> and C<rdev> fields seem to be
  different in Windows.  Also, it seems that the size of the file
  returned by stat() does not always agree, with C<stat(FH)> being more
  accurate than C<stat(filename)>, presumably because of caching issues
  even when using autoflush (this is usually overcome by waiting a while
  after writing to the tempfile before attempting to C<unlink0> it).
  
  Not exported by default.
  
  Current API available since 0.14.
  
  =item B<unlink1>
  
  Similar to C<unlink0> except after file comparison using cmpstat, the
  filehandle is closed prior to attempting to unlink the file. This
  allows the file to be removed without using an END block, but does
  mean that the post-unlink comparison of the filehandle state provided
  by C<unlink0> is not available.
  
    unlink1($fh, $path)
       or die "Error closing and unlinking file";
  
  Usually called from the object destructor when using the OO interface.
  
  Not exported by default.
  
  This function is disabled if the global variable $KEEP_ALL is true.
  
  Can call croak() if there is a security anomaly during the stat()
  comparison.
  
  Current API available since 0.14.
  
  =item B<cleanup>
  
  Calling this function will cause any temp files or temp directories
  that are registered for removal to be removed. This happens automatically
  when the process exits but can be triggered manually if the caller is sure
  that none of the temp files are required. This method can be registered as
  an Apache callback.
  
  Note that if a temp directory is your current directory, it cannot be
  removed.  C<chdir()> out of the directory first before calling
  C<cleanup()>. (For the cleanup at program exit when the CLEANUP flag
  is set, this happens automatically.)
  
  On OSes where temp files are automatically removed when the temp file
  is closed, calling this function will have no effect other than to remove
  temporary directories (which may include temporary files).
  
    File::Temp::cleanup();
  
  Not exported by default.
  
  Current API available since 0.15.
  
  =back
  
  =head1 PACKAGE VARIABLES
  
  These functions control the global state of the package.
  
  =over 4
  
  =item B<safe_level>
  
  Controls the lengths to which the module will go to check the safety of the
  temporary file or directory before proceeding.
  Options are:
  
  =over 8
  
  =item STANDARD
  
  Do the basic security measures to ensure the directory exists and is
  writable, that temporary files are opened only if they do not already
  exist, and that possible race conditions are avoided.  Finally the
  L<unlink0|"unlink0"> function is used to remove files safely.
  
  =item MEDIUM
  
  In addition to the STANDARD security, the output directory is checked
  to make sure that it is owned either by root or the user running the
  program. If the directory is writable by group or by other, it is then
  checked to make sure that the sticky bit is set.
  
  Will not work on platforms that do not support the C<-k> test
  for sticky bit.
  
  =item HIGH
  
  In addition to the MEDIUM security checks, also check for the
  possibility of ``chown() giveaway'' using the L<POSIX|POSIX>
  sysconf() function. If this is a possibility, each directory in the
  path is checked in turn for safeness, recursively walking back to the
  root directory.
  
  For platforms that do not support the L<POSIX|POSIX>
  C<_PC_CHOWN_RESTRICTED> symbol (for example, Windows NT) it is
  assumed that ``chown() giveaway'' is possible and the recursive test
  is performed.
  
  =back
  
  The level can be changed as follows:
  
    File::Temp->safe_level( File::Temp::HIGH );
  
  The level constants are not exported by the module.
  
  Currently, you must be running at least perl v5.6.0 in order to
  run with MEDIUM or HIGH security. This is simply because the
  safety tests use functions from L<Fcntl|Fcntl> that are not
  available in older versions of perl. The problem is that the version
  number for Fcntl is the same in perl 5.6.0 and in 5.005_03 even though
  they are different versions.
  
  On systems that do not support the HIGH or MEDIUM safety levels
  (for example Win NT or OS/2) any attempt to change the level will
  be ignored. The decision to ignore rather than raise an exception
  allows portable programs to be written with high security in mind
  for the systems that can support this without those programs failing
  on systems where the extra tests are irrelevant.
  
  If you really need to see whether the change has been accepted
  simply examine the return value of C<safe_level>.
  
    $newlevel = File::Temp->safe_level( File::Temp::HIGH );
    die "Could not change to high security"
        if $newlevel != File::Temp::HIGH;
  
  Available since 0.05.
  
  =item TopSystemUID
  
  This is the highest UID on the current system that refers to a root
  UID. This is used to make sure that the temporary directory is
  owned by a system UID (C<root>, C<bin>, C<sys> etc) rather than
  simply by root.
  
  This is required since on many unix systems C</tmp> is not owned
  by root.
  
  Default is to assume that any UID less than or equal to 10 is a root
  UID.
  
    File::Temp->top_system_uid(10);
    my $topid = File::Temp->top_system_uid;
  
  This value can be adjusted to reduce security checking if required.
  The value is only relevant when C<safe_level> is set to MEDIUM or higher.
  
  Available since 0.05.
  
  =item B<$KEEP_ALL>
  
  Controls whether temporary files and directories should be retained
  regardless of any instructions in the program to remove them
  automatically.  This is useful for debugging but should not be used in
  production code.
  
    $File::Temp::KEEP_ALL = 1;
  
  Default is for files to be removed as requested by the caller.
  
  In some cases, files will only be retained if this variable is true
  when the file is created. This means that you can not create a temporary
  file, set this variable and expect the temp file to still be around
  when the program exits.
  
  =item B<$DEBUG>
  
  Controls whether debugging messages should be enabled.
  
    $File::Temp::DEBUG = 1;
  
  Default is for debugging mode to be disabled.
  
  Available since 0.15.
  
  =back
  
  =head1 WARNING
  
  For maximum security, endeavour always to avoid ever looking at,
  touching, or even imputing the existence of the filename.  You do not
  know that that filename is connected to the same file as the handle
  you have, and attempts to check this can only trigger more race
  conditions.  It's far more secure to use the filehandle alone and
  dispense with the filename altogether.
  
  If you need to pass the handle to something that expects a filename
  then on a unix system you can use C<"/dev/fd/" . fileno($fh)> for
  arbitrary programs. Perl code that uses the 2-argument version of
  C<< open >> can be passed C<< "+<=&" . fileno($fh) >>. Otherwise you
  will need to pass the filename. You will have to clear the
  close-on-exec bit on that file descriptor before passing it to another
  process.
  
      use Fcntl qw/F_SETFD F_GETFD/;
      fcntl($tmpfh, F_SETFD, 0)
          or die "Can't clear close-on-exec flag on temp fh: $!\n";
  
  =head2 Temporary files and NFS
  
  Some problems are associated with using temporary files that reside
  on NFS file systems and it is recommended that a local filesystem
  is used whenever possible. Some of the security tests will most probably
  fail when the temp file is not local. Additionally, be aware that
  the performance of I/O operations over NFS will not be as good as for
  a local disk.
  
  =head2 Forking
  
  In some cases files created by File::Temp are removed from within an
  END block. Since END blocks are triggered when a child process exits
  (unless C<POSIX::_exit()> is used by the child) File::Temp takes care
  to only remove those temp files created by a particular process ID. This
  means that a child will not attempt to remove temp files created by the
  parent process.
  
  If you are forking many processes in parallel that are all creating
  temporary files, you may need to reset the random number seed using
  srand(EXPR) in each child else all the children will attempt to walk
  through the same set of random file names and may well cause
  themselves to give up if they exceed the number of retry attempts.
  
  =head2 Directory removal
  
  Note that if you have chdir'ed into the temporary directory and it is
  subsequently cleaned up (either in the END block or as part of object
  destruction), then you will get a warning from File::Path::rmtree().
  
  =head2 Taint mode
  
  If you need to run code under taint mode, updating to the latest
  L<File::Spec> is highly recommended.  On Windows, if the directory
  given by L<File::Spec::tmpdir> isn't writable, File::Temp will attempt
  to fallback to the user's local application data directory or croak
  with an error.
  
  =head2 BINMODE
  
  The file returned by File::Temp will have been opened in binary mode
  if such a mode is available. If that is not correct, use the C<binmode()>
  function to change the mode of the filehandle.
  
  Note that you can modify the encoding of a file opened by File::Temp
  also by using C<binmode()>.
  
  =head1 HISTORY
  
  Originally began life in May 1999 as an XS interface to the system
  mkstemp() function. In March 2000, the OpenBSD mkstemp() code was
  translated to Perl for total control of the code's
  security checking, to ensure the presence of the function regardless of
  operating system and to help with portability. The module was shipped
  as a standard part of perl from v5.6.1.
  
  Thanks to Tom Christiansen for suggesting that this module
  should be written and providing ideas for code improvements and
  security enhancements.
  
  =head1 SEE ALSO
  
  L<POSIX/tmpnam>, L<POSIX/tmpfile>, L<File::Spec>, L<File::Path>
  
  See L<IO::File> and L<File::MkTemp>, L<Apache::TempFile> for
  different implementations of temporary file handling.
  
  See L<File::Tempdir> for an alternative object-oriented wrapper for
  the C<tempdir> function.
  
  =for Pod::Coverage STRINGIFY NUMIFY top_system_uid
  
  =head1 SUPPORT
  
  Bugs may be submitted through L<the RT bug tracker|https://rt.cpan.org/Public/Dist/Display.html?Name=File-Temp>
  (or L<bug-File-Temp@rt.cpan.org|mailto:bug-File-Temp@rt.cpan.org>).
  
  There is also a mailing list available for users of this distribution, at
  L<http://lists.perl.org/list/cpan-workers.html>.
  
  There is also an irc channel available for users of this distribution, at
  L<C<#toolchain> on C<irc.perl.org>|irc://irc.perl.org/#toolchain>.
  
  =head1 AUTHOR
  
  Tim Jenness <tjenness@cpan.org>
  
  =head1 CONTRIBUTORS
  
  =for stopwords David Golden Karen Etheridge Slaven Rezic Peter Rabbitson Olivier Mengue Kevin Ryde John Acklam James E. Keenan Brian Mowrey Dagfinn Ilmari Mannsåker Steinbrunner Ed Avis Guillem Jover Ben Tilly
  
  =over 4
  
  =item *
  
  David Golden <dagolden@cpan.org>
  
  =item *
  
  Karen Etheridge <ether@cpan.org>
  
  =item *
  
  Slaven Rezic <slaven@rezic.de>
  
  =item *
  
  Peter Rabbitson <ribasushi@cpan.org>
  
  =item *
  
  Olivier Mengue <dolmen@cpan.org>
  
  =item *
  
  David Golden <xdg@xdg.me>
  
  =item *
  
  Kevin Ryde <user42@zip.com.au>
  
  =item *
  
  Peter John Acklam <pjacklam@online.no>
  
  =item *
  
  Slaven Rezic <slaven.rezic@idealo.de>
  
  =item *
  
  James E. Keenan <jkeen@verizon.net>
  
  =item *
  
  Brian Mowrey <brian@drlabs.org>
  
  =item *
  
  Dagfinn Ilmari Mannsåker <ilmari@ilmari.org>
  
  =item *
  
  David Steinbrunner <dsteinbrunner@pobox.com>
  
  =item *
  
  Ed Avis <eda@linux01.wcl.local>
  
  =item *
  
  Guillem Jover <guillem@hadrons.org>
  
  =item *
  
  Ben Tilly <btilly@gmail.com>
  
  =back
  
  =head1 COPYRIGHT AND LICENSE
  
  This software is copyright (c) 2019 by Tim Jenness and the UK Particle Physics and Astronomy Research Council.
  
  This is free software; you can redistribute it and/or modify it under
  the same terms as the Perl 5 programming language system itself.
  
  =cut
FILE_TEMP

$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{"Method/Generate/Accessor.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'METHOD_GENERATE_ACCESSOR';
  package Method::Generate::Accessor;
  
  use Moo::_strictures;
  use Moo::_Utils qw(_load_module _maybe_load_module _install_coderef);
  use Moo::Object ();
  BEGIN { our @ISA = qw(Moo::Object) }
  use Sub::Quote qw(quote_sub quoted_from_sub quotify sanitize_identifier);
  use Scalar::Util 'blessed';
  use Carp qw(croak);
  BEGIN { our @CARP_NOT = qw(Moo::_Utils) }
  BEGIN {
    *_CAN_WEAKEN_READONLY = (
      "$]" < 5.008_003 or $ENV{MOO_TEST_PRE_583}
    ) ? sub(){0} : sub(){1};
    our $CAN_HAZ_XS =
      !$ENV{MOO_XS_DISABLE}
        &&
      _maybe_load_module('Class::XSAccessor')
        &&
      (eval { Class::XSAccessor->VERSION('1.07') })
    ;
    our $CAN_HAZ_XS_PRED =
      $CAN_HAZ_XS &&
      (eval { Class::XSAccessor->VERSION('1.17') })
    ;
  }
  BEGIN {
    package
      Method::Generate::Accessor::_Generated;
    $Carp::Internal{+__PACKAGE__} = 1;
  }
  
  my $module_name_only = qr/\A$Module::Runtime::module_name_rx\z/;
  
  sub _die_overwrite
  {
    my ($pkg, $method, $type) = @_;
    croak "You cannot overwrite a locally defined method ($method) with "
      . ( $type || 'an accessor' );
  }
  
  sub generate_method {
    my ($self, $into, $name, $spec, $quote_opts) = @_;
    $quote_opts = {
      no_defer => 1,
      package => 'Method::Generate::Accessor::_Generated',
      %{ $quote_opts||{} },
    };
    $spec->{allow_overwrite}++ if $name =~ s/^\+//;
    croak "Must have an is" unless my $is = $spec->{is};
    if ($is eq 'ro') {
      $spec->{reader} = $name unless exists $spec->{reader};
    } elsif ($is eq 'rw') {
      $spec->{accessor} = $name unless exists $spec->{accessor}
        or ( $spec->{reader} and $spec->{writer} );
    } elsif ($is eq 'lazy') {
      $spec->{reader} = $name unless exists $spec->{reader};
      $spec->{lazy} = 1;
      $spec->{builder} ||= '_build_'.$name unless exists $spec->{default};
    } elsif ($is eq 'rwp') {
      $spec->{reader} = $name unless exists $spec->{reader};
      $spec->{writer} = "_set_${name}" unless exists $spec->{writer};
    } elsif ($is ne 'bare') {
      croak "Unknown is ${is}";
    }
    if (exists $spec->{builder}) {
      if(ref $spec->{builder}) {
        $self->_validate_codulatable('builder', $spec->{builder},
          "$into->$name", 'or a method name');
        $spec->{builder_sub} = $spec->{builder};
        $spec->{builder} = 1;
      }
      $spec->{builder} = '_build_'.$name if ($spec->{builder}||0) eq 1;
      croak "Invalid builder for $into->$name - not a valid method name"
        if $spec->{builder} !~ $module_name_only;
    }
    if (($spec->{predicate}||0) eq 1) {
      $spec->{predicate} = $name =~ /^_/ ? "_has${name}" : "has_${name}";
    }
    if (($spec->{clearer}||0) eq 1) {
      $spec->{clearer} = $name =~ /^_/ ? "_clear${name}" : "clear_${name}";
    }
    if (($spec->{trigger}||0) eq 1) {
      $spec->{trigger} = quote_sub('shift->_trigger_'.$name.'(@_)');
    }
    if (($spec->{coerce}||0) eq 1) {
      my $isa = $spec->{isa};
      if (blessed $isa and $isa->can('coercion')) {
        $spec->{coerce} = $isa->coercion;
      } elsif (blessed $isa and $isa->can('coerce')) {
        $spec->{coerce} = sub { $isa->coerce(@_) };
      } else {
        croak "Invalid coercion for $into->$name - no appropriate type constraint";
      }
    }
  
    foreach my $setting (qw( isa coerce )) {
      next if !exists $spec->{$setting};
      $self->_validate_codulatable($setting, $spec->{$setting}, "$into->$name");
    }
  
    if (exists $spec->{default}) {
      if (ref $spec->{default}) {
        $self->_validate_codulatable('default', $spec->{default}, "$into->$name",
          'or a non-ref');
      }
    }
  
    if (exists $spec->{moosify}) {
      if (ref $spec->{moosify} ne 'ARRAY') {
        $spec->{moosify} = [$spec->{moosify}];
      }
  
      foreach my $spec (@{$spec->{moosify}}) {
        $self->_validate_codulatable('moosify', $spec, "$into->$name");
      }
    }
  
    my %methods;
    if (my $reader = $spec->{reader}) {
      _die_overwrite($into, $reader, 'a reader')
        if !$spec->{allow_overwrite} && defined &{"${into}::${reader}"};
      if (our $CAN_HAZ_XS && $self->is_simple_get($name, $spec)) {
        $methods{$reader} = $self->_generate_xs(
          getters => $into, $reader, $name, $spec
        );
      } else {
        $self->{captures} = {};
        $methods{$reader} =
          quote_sub "${into}::${reader}"
            => '    Carp::croak("'.$reader.' is a read-only accessor") if @_ > 1;'."\n"
               .$self->_generate_get($name, $spec)
            => delete $self->{captures}
            => $quote_opts
          ;
      }
    }
    if (my $accessor = $spec->{accessor}) {
      _die_overwrite($into, $accessor, 'an accessor')
        if !$spec->{allow_overwrite} && defined &{"${into}::${accessor}"};
      if (
        our $CAN_HAZ_XS
        && $self->is_simple_get($name, $spec)
        && $self->is_simple_set($name, $spec)
      ) {
        $methods{$accessor} = $self->_generate_xs(
          accessors => $into, $accessor, $name, $spec
        );
      } else {
        $self->{captures} = {};
        $methods{$accessor} =
          quote_sub "${into}::${accessor}"
            => $self->_generate_getset($name, $spec)
            => delete $self->{captures}
            => $quote_opts
          ;
      }
    }
    if (my $writer = $spec->{writer}) {
      _die_overwrite($into, $writer, 'a writer')
        if !$spec->{allow_overwrite} && defined &{"${into}::${writer}"};
      if (
        our $CAN_HAZ_XS
        && $self->is_simple_set($name, $spec)
      ) {
        $methods{$writer} = $self->_generate_xs(
          setters => $into, $writer, $name, $spec
        );
      } else {
        $self->{captures} = {};
        $methods{$writer} =
          quote_sub "${into}::${writer}"
            => $self->_generate_set($name, $spec)
            => delete $self->{captures}
            => $quote_opts
          ;
      }
    }
    if (my $pred = $spec->{predicate}) {
      _die_overwrite($into, $pred, 'a predicate')
        if !$spec->{allow_overwrite} && defined &{"${into}::${pred}"};
      if (our $CAN_HAZ_XS && our $CAN_HAZ_XS_PRED) {
        $methods{$pred} = $self->_generate_xs(
          exists_predicates => $into, $pred, $name, $spec
        );
      } else {
        $self->{captures} = {};
        $methods{$pred} =
          quote_sub "${into}::${pred}"
            => $self->_generate_simple_has('$_[0]', $name, $spec)."\n"
            => delete $self->{captures}
            => $quote_opts
          ;
      }
    }
    if (my $builder = delete $spec->{builder_sub}) {
      _install_coderef( "${into}::$spec->{builder}" => $builder );
    }
    if (my $cl = $spec->{clearer}) {
      _die_overwrite($into, $cl, 'a clearer')
        if !$spec->{allow_overwrite} && defined &{"${into}::${cl}"};
      $self->{captures} = {};
      $methods{$cl} =
        quote_sub "${into}::${cl}"
          => $self->_generate_simple_clear('$_[0]', $name, $spec)."\n"
          => delete $self->{captures}
          => $quote_opts
        ;
    }
    if (my $hspec = $spec->{handles}) {
      my $asserter = $spec->{asserter} ||= '_assert_'.$name;
      my @specs = do {
        if (ref($hspec) eq 'ARRAY') {
          map [ $_ => $_ ], @$hspec;
        } elsif (ref($hspec) eq 'HASH') {
          map [ $_ => ref($hspec->{$_}) ? @{$hspec->{$_}} : $hspec->{$_} ],
            keys %$hspec;
        } elsif (!ref($hspec)) {
          require Moo::Role;
          _load_module $hspec;
          map [ $_ => $_ ], Moo::Role->methods_provided_by($hspec)
        } else {
          croak "You gave me a handles of ${hspec} and I have no idea why";
        }
      };
      foreach my $delegation_spec (@specs) {
        my ($proxy, $target, @args) = @$delegation_spec;
        _die_overwrite($into, $proxy, 'a delegation')
          if !$spec->{allow_overwrite} && defined &{"${into}::${proxy}"};
        $self->{captures} = {};
        $methods{$proxy} =
          quote_sub "${into}::${proxy}"
            => $self->_generate_delegation($asserter, $target, \@args)
            => delete $self->{captures}
            => $quote_opts
          ;
      }
    }
    if (my $asserter = $spec->{asserter}) {
      _die_overwrite($into, $asserter, 'an asserter')
        if !$spec->{allow_overwrite} && defined &{"${into}::${asserter}"};
      local $self->{captures} = {};
      $methods{$asserter} =
        quote_sub "${into}::${asserter}"
          => $self->_generate_asserter($name, $spec)
          => delete $self->{captures}
          => $quote_opts
        ;
    }
    \%methods;
  }
  
  sub merge_specs {
    my ($self, @specs) = @_;
    my $spec = shift @specs;
    for my $old_spec (@specs) {
      foreach my $key (keys %$old_spec) {
        if ($key eq 'handles') {
        }
        elsif ($key eq 'moosify') {
          $spec->{$key} = [
            map { ref $_ eq 'ARRAY' ? @$_ : $_ }
            grep defined,
            ($old_spec->{$key}, $spec->{$key})
          ];
        }
        elsif (!exists $spec->{$key}) {
          $spec->{$key} = $old_spec->{$key};
        }
      }
    }
    $spec;
  }
  
  sub is_simple_attribute {
    my ($self, $name, $spec) = @_;
    # clearer doesn't have to be listed because it doesn't
    # affect whether defined/exists makes a difference
    !grep $spec->{$_},
      qw(lazy default builder coerce isa trigger predicate weak_ref);
  }
  
  sub is_simple_get {
    my ($self, $name, $spec) = @_;
    !($spec->{lazy} and (exists $spec->{default} or $spec->{builder}));
  }
  
  sub is_simple_set {
    my ($self, $name, $spec) = @_;
    !grep $spec->{$_}, qw(coerce isa trigger weak_ref);
  }
  
  sub has_default {
    my ($self, $name, $spec) = @_;
    $spec->{builder} or exists $spec->{default} or (($spec->{is}||'') eq 'lazy');
  }
  
  sub has_eager_default {
    my ($self, $name, $spec) = @_;
    (!$spec->{lazy} and (exists $spec->{default} or $spec->{builder}));
  }
  
  sub _generate_get {
    my ($self, $name, $spec) = @_;
    my $simple = $self->_generate_simple_get('$_[0]', $name, $spec);
    if ($self->is_simple_get($name, $spec)) {
      $simple;
    } else {
      $self->_generate_use_default(
        '$_[0]', $name, $spec,
        $self->_generate_simple_has('$_[0]', $name, $spec),
      );
    }
  }
  
  sub generate_simple_has {
    my $self = shift;
    $self->{captures} = {};
    my $code = $self->_generate_simple_has(@_);
    ($code, delete $self->{captures});
  }
  
  sub _generate_simple_has {
    my ($self, $me, $name) = @_;
    "exists ${me}->{${\quotify $name}}";
  }
  
  sub _generate_simple_clear {
    my ($self, $me, $name) = @_;
    "    delete ${me}->{${\quotify $name}}\n"
  }
  
  sub generate_get_default {
    my $self = shift;
    $self->{captures} = {};
    my $code = $self->_generate_get_default(@_);
    ($code, delete $self->{captures});
  }
  
  sub generate_use_default {
    my $self = shift;
    $self->{captures} = {};
    my $code = $self->_generate_use_default(@_);
    ($code, delete $self->{captures});
  }
  
  sub _generate_use_default {
    my ($self, $me, $name, $spec, $test) = @_;
    my $get_value = $self->_generate_get_default($me, $name, $spec);
    if ($spec->{coerce}) {
      $get_value = $self->_generate_coerce(
        $name, $get_value,
        $spec->{coerce}
      )
    }
    $test." ? \n"
    .$self->_generate_simple_get($me, $name, $spec)."\n:"
    .($spec->{isa} ?
         "    do {\n      my \$value = ".$get_value.";\n"
        ."      ".$self->_generate_isa_check($name, '$value', $spec->{isa}).";\n"
        ."      ".$self->_generate_simple_set($me, $name, $spec, '$value')."\n"
        ."    }\n"
      : '    ('.$self->_generate_simple_set($me, $name, $spec, $get_value).")\n"
    );
  }
  
  sub _generate_get_default {
    my ($self, $me, $name, $spec) = @_;
    if (exists $spec->{default}) {
      ref $spec->{default}
        ? $self->_generate_call_code($name, 'default', $me, $spec->{default})
      : quotify $spec->{default};
    }
    else {
      "${me}->${\$spec->{builder}}"
    }
  }
  
  sub generate_simple_get {
    my ($self, @args) = @_;
    $self->{captures} = {};
    my $code = $self->_generate_simple_get(@args);
    ($code, delete $self->{captures});
  }
  
  sub _generate_simple_get {
    my ($self, $me, $name) = @_;
    my $name_str = quotify $name;
    "${me}->{${name_str}}";
  }
  
  sub _generate_set {
    my ($self, $name, $spec) = @_;
    my ($me, $source) = ('$_[0]', '$_[1]');
    if ($self->is_simple_set($name, $spec)) {
      return $self->_generate_simple_set($me, $name, $spec, $source);
    }
  
    my ($coerce, $trigger, $isa_check) = @{$spec}{qw(coerce trigger isa)};
    if ($coerce) {
      $source = $self->_generate_coerce($name, $source, $coerce);
    }
    if ($isa_check) {
      'scalar do { my $value = '.$source.";\n"
      .'  ('.$self->_generate_isa_check($name, '$value', $isa_check)."),\n"
      .'  ('.$self->_generate_simple_set($me, $name, $spec, '$value')."),\n"
      .($trigger
        ? '('.$self->_generate_trigger($name, $me, '$value', $trigger)."),\n"
        : '')
      .'  ('.$self->_generate_simple_get($me, $name, $spec)."),\n"
      ."}";
    }
    elsif ($trigger) {
      my $set = $self->_generate_simple_set($me, $name, $spec, $source);
      "scalar (\n"
      . '  ('.$self->_generate_trigger($name, $me, "($set)", $trigger)."),\n"
      . '  ('.$self->_generate_simple_get($me, $name, $spec)."),\n"
      . ")";
    }
    else {
      '('.$self->_generate_simple_set($me, $name, $spec, $source).')';
    }
  }
  
  sub generate_coerce {
    my $self = shift;
    $self->{captures} = {};
    my $code = $self->_generate_coerce(@_);
    ($code, delete $self->{captures});
  }
  
  sub _attr_desc {
    my ($name, $init_arg) = @_;
    return quotify($name) if !defined($init_arg) or $init_arg eq $name;
    return quotify($name).' (constructor argument: '.quotify($init_arg).')';
  }
  
  sub _generate_coerce {
    my ($self, $name, $value, $coerce, $init_arg) = @_;
    $self->_wrap_attr_exception(
      $name,
      "coercion",
      $init_arg,
      $self->_generate_call_code($name, 'coerce', "${value}", $coerce),
      1,
    );
  }
  
  sub generate_trigger {
    my $self = shift;
    $self->{captures} = {};
    my $code = $self->_generate_trigger(@_);
    ($code, delete $self->{captures});
  }
  
  sub _generate_trigger {
    my ($self, $name, $obj, $value, $trigger) = @_;
    $self->_generate_call_code($name, 'trigger', "${obj}, ${value}", $trigger);
  }
  
  sub generate_isa_check {
    my ($self, @args) = @_;
    $self->{captures} = {};
    my $code = $self->_generate_isa_check(@args);
    ($code, delete $self->{captures});
  }
  
  sub _wrap_attr_exception {
    my ($self, $name, $step, $arg, $code, $want_return) = @_;
    my $prefix = quotify("${step} for "._attr_desc($name, $arg).' failed: ');
    "do {\n"
    .'  local $Method::Generate::Accessor::CurrentAttribute = {'."\n"
    .'    init_arg => '.quotify($arg).",\n"
    .'    name     => '.quotify($name).",\n"
    .'    step     => '.quotify($step).",\n"
    ."  };\n"
    .($want_return ? '  (my $_return),'."\n" : '')
    .'  (my $_error), (my $_old_error = $@);'."\n"
    ."  (eval {\n"
    .'    ($@ = $_old_error),'."\n"
    .'    ('
    .($want_return ? '$_return ='."\n" : '')
    .$code."),\n"
    ."    1\n"
    ."  } or\n"
    .'    $_error = CORE::ref $@ ? $@ : '.$prefix.'.$@);'."\n"
    .'  ($@ = $_old_error),'."\n"
    .'  (defined $_error and CORE::die $_error);'."\n"
    .($want_return ? '  $_return;'."\n" : '')
    ."}\n"
  }
  
  sub _generate_isa_check {
    my ($self, $name, $value, $check, $init_arg) = @_;
    $self->_wrap_attr_exception(
      $name,
      "isa check",
      $init_arg,
      $self->_generate_call_code($name, 'isa_check', $value, $check)
    );
  }
  
  sub _generate_call_code {
    my ($self, $name, $type, $values, $sub) = @_;
    $sub = \&{$sub} if blessed($sub);  # coderef if blessed
    if (my $quoted = quoted_from_sub($sub)) {
      my $local = 1;
      if ($values eq '@_' || $values eq '$_[0]') {
        $local = 0;
        $values = '@_';
      }
      my $code = $quoted->[1];
      if (my $captures = $quoted->[2]) {
        my $cap_name = qq{\$${type}_captures_for_}.sanitize_identifier($name);
        $self->{captures}->{$cap_name} = \$captures;
        Sub::Quote::inlinify($code, $values,
          Sub::Quote::capture_unroll($cap_name, $captures, 6), $local);
      } else {
        Sub::Quote::inlinify($code, $values, undef, $local);
      }
    } else {
      my $cap_name = qq{\$${type}_for_}.sanitize_identifier($name);
      $self->{captures}->{$cap_name} = \$sub;
      "${cap_name}->(${values})";
    }
  }
  
  sub _sanitize_name { sanitize_identifier($_[1]) }
  
  sub generate_populate_set {
    my $self = shift;
    $self->{captures} = {};
    my $code = $self->_generate_populate_set(@_);
    ($code, delete $self->{captures});
  }
  
  sub _generate_populate_set {
    my ($self, $me, $name, $spec, $source, $test, $init_arg) = @_;
  
    my $has_default = $self->has_eager_default($name, $spec);
    if (!($has_default || $test)) {
      return '';
    }
    if ($has_default) {
      my $get_default = $self->_generate_get_default($me, $name, $spec);
      $source =
        $test
          ? "(\n  ${test}\n"
              ."   ? ${source}\n   : "
              .$get_default
              .")"
          : $get_default;
    }
    if ($spec->{coerce}) {
      $source = $self->_generate_coerce(
        $name, $source,
        $spec->{coerce}, $init_arg
      )
    }
    if ($spec->{isa}) {
      $source = 'scalar do { my $value = '.$source.";\n"
      .'  ('.$self->_generate_isa_check(
          $name, '$value', $spec->{isa}, $init_arg
        )."),\n"
      ."  \$value\n"
      ."}\n";
    }
    my $set = $self->_generate_simple_set($me, $name, $spec, $source);
    my $trigger = $spec->{trigger} ? $self->_generate_trigger(
      $name, $me, $self->_generate_simple_get($me, $name, $spec),
      $spec->{trigger}
    ) : undef;
    if ($has_default) {
      "($set)," . ($trigger && $test ? "($test and $trigger)," : '') . "\n";
    }
    else {
      "($test and ($set)" . ($trigger ? ", ($trigger)" : '') . "),\n";
    }
  }
  
  sub _generate_core_set {
    my ($self, $me, $name, $spec, $value) = @_;
    my $name_str = quotify $name;
    "${me}->{${name_str}} = ${value}";
  }
  
  sub _generate_simple_set {
    my ($self, $me, $name, $spec, $value) = @_;
    my $name_str = quotify $name;
    my $simple = $self->_generate_core_set($me, $name, $spec, $value);
  
    if ($spec->{weak_ref}) {
      require Scalar::Util;
      my $get = $self->_generate_simple_get($me, $name, $spec);
  
      # Perl < 5.8.3 can't weaken refs to readonly vars
      # (e.g. string constants). This *can* be solved by:
      #
      # &Internals::SvREADONLY($foo, 0);
      # Scalar::Util::weaken($foo);
      # &Internals::SvREADONLY($foo, 1);
      #
      # but requires Internal functions and is just too damn crazy
      # so simply throw a better exception
      my $weak_simple = _CAN_WEAKEN_READONLY
        ? "do { Scalar::Util::weaken(${simple}); no warnings 'void'; $get }"
        : <<"EOC"
          ( eval { Scalar::Util::weaken($simple); 1 }
            ? do { no warnings 'void'; $get }
            : do {
              if( \$@ =~ /Modification of a read-only value attempted/) {
                require Carp;
                Carp::croak( sprintf (
                  'Reference to readonly value in "%s" can not be weakened on Perl < 5.8.3',
                  $name_str,
                ) );
              } else {
                die \$@;
              }
            }
          )
  EOC
    } else {
      $simple;
    }
  }
  
  sub _generate_getset {
    my ($self, $name, $spec) = @_;
    q{(@_ > 1}."\n      ? ".$self->_generate_set($name, $spec)
      ."\n      : ".$self->_generate_get($name, $spec)."\n    )";
  }
  
  sub _generate_asserter {
    my ($self, $name, $spec) = @_;
    my $name_str = quotify($name);
    "do {\n"
     ."  my \$val = ".$self->_generate_get($name, $spec).";\n"
     ."  ".$self->_generate_simple_has('$_[0]', $name, $spec)."\n"
     ."    or Carp::croak(q{Attempted to access '}.${name_str}.q{' but it is not set});\n"
     ."  \$val;\n"
     ."}\n";
  }
  sub _generate_delegation {
    my ($self, $asserter, $target, $args) = @_;
    my $arg_string = do {
      if (@$args) {
        # I could, I reckon, linearise out non-refs here using quotify
        # plus something to check for numbers but I'm unsure if it's worth it
        $self->{captures}{'@curries'} = $args;
        '@curries, @_';
      } else {
        '@_';
      }
    };
    "shift->${asserter}->${target}(${arg_string});";
  }
  
  sub _generate_xs {
    my ($self, $type, $into, $name, $slot) = @_;
    Class::XSAccessor->import(
      class => $into,
      $type => { $name => $slot },
      replace => 1,
    );
    $into->can($name);
  }
  
  sub default_construction_string { '{}' }
  
  sub _validate_codulatable {
    my ($self, $setting, $value, $into, $appended) = @_;
  
    my $error;
  
    if (blessed $value) {
      local $@;
      no warnings 'void';
      eval { \&$value; 1 }
        and return 1;
      $error = "could not be converted to a coderef: $@";
    }
    elsif (ref $value eq 'CODE') {
      return 1;
    }
    else {
      $error = 'is not a coderef or code-convertible object';
    }
  
    croak "Invalid $setting '"
      . ($INC{'overload.pm'} ? overload::StrVal($value) : $value)
      . "' for $into " . $error
      . ($appended ? " $appended" : '');
  }
  
  1;
METHOD_GENERATE_ACCESSOR

$fatpacked{"Method/Generate/BuildAll.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'METHOD_GENERATE_BUILDALL';
  package Method::Generate::BuildAll;
  
  use Moo::_strictures;
  use Moo::Object ();
  BEGIN { our @ISA = qw(Moo::Object) }
  use Sub::Quote qw(quote_sub quotify);
  use Moo::_Utils qw(_getglob);
  use Moo::_mro;
  
  sub generate_method {
    my ($self, $into) = @_;
    quote_sub "${into}::BUILDALL"
      => join('',
        $self->_handle_subbuild($into),
        qq{    my \$self = shift;\n},
        $self->buildall_body_for($into, '$self', '@_'),
        qq{    return \$self\n},
      )
      => {}
      => { no_defer => 1 }
    ;
  }
  
  sub _handle_subbuild {
    my ($self, $into) = @_;
    '    if (ref($_[0]) ne '.quotify($into).') {'."\n".
    '      return shift->Moo::Object::BUILDALL(@_)'.";\n".
    '    }'."\n";
  }
  
  sub buildall_body_for {
    my ($self, $into, $me, $args) = @_;
    my @builds =
      grep *{_getglob($_)}{CODE},
      map "${_}::BUILD",
      reverse @{mro::get_linear_isa($into)};
    '    (('.$args.')[0]->{__no_BUILD__} or ('."\n"
    .join('', map qq{      ${me}->${_}(${args}),\n}, @builds)
    ."    )),\n";
  }
  
  1;
METHOD_GENERATE_BUILDALL

$fatpacked{"Method/Generate/Constructor.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'METHOD_GENERATE_CONSTRUCTOR';
  package Method::Generate::Constructor;
  
  use Moo::_strictures;
  use Sub::Quote qw(quote_sub quotify);
  use Sub::Defer;
  use Moo::_Utils qw(_getstash _getglob);
  use Moo::_mro;
  use Scalar::Util qw(weaken);
  use Carp qw(croak);
  use Carp::Heavy ();
  BEGIN { our @CARP_NOT = qw(Sub::Defer) }
  BEGIN {
    local $Moo::sification::disabled = 1;
    require Moo;
    Moo->import;
  }
  
  sub register_attribute_specs {
    my ($self, @new_specs) = @_;
    $self->assert_constructor;
    my $specs = $self->{attribute_specs}||={};
    my $ag = $self->accessor_generator;
    while (my ($name, $new_spec) = splice @new_specs, 0, 2) {
      if ($name =~ s/^\+//) {
        croak "has '+${name}' given but no ${name} attribute already exists"
          unless my $old_spec = $specs->{$name};
        $ag->merge_specs($new_spec, $old_spec);
      }
      if ($new_spec->{required}
        && !(
          $ag->has_default($name, $new_spec)
          || !exists $new_spec->{init_arg}
          || defined $new_spec->{init_arg}
        )
      ) {
        croak "You cannot have a required attribute (${name})"
          . " without a default, builder, or an init_arg";
      }
      $new_spec->{index} = scalar keys %$specs
        unless defined $new_spec->{index};
      $specs->{$name} = $new_spec;
    }
    $self;
  }
  
  sub all_attribute_specs {
    $_[0]->{attribute_specs}
  }
  
  sub accessor_generator {
    $_[0]->{accessor_generator}
  }
  
  sub construction_string {
    my ($self) = @_;
    $self->{construction_string}
      ||= $self->_build_construction_string;
  }
  
  sub buildall_generator {
    require Method::Generate::BuildAll;
    Method::Generate::BuildAll->new;
  }
  
  sub _build_construction_string {
    my ($self) = @_;
    my $builder = $self->{construction_builder};
    $builder ? $self->$builder
      : 'bless('
      .$self->accessor_generator->default_construction_string
      .', $class);'
  }
  
  sub install_delayed {
    my ($self) = @_;
    $self->assert_constructor;
    my $package = $self->{package};
    my (undef, @isa) = @{mro::get_linear_isa($package)};
    my $isa = join ',', @isa;
    my (undef, $from_file, $from_line) = caller(Carp::short_error_loc());
    my $constructor = defer_sub "${package}::new" => sub {
      my (undef, @new_isa) = @{mro::get_linear_isa($package)};
      if (join(',', @new_isa) ne $isa) {
        my ($expected_new) = grep { *{_getglob($_.'::new')}{CODE} } @isa;
        my ($found_new) = grep { *{_getglob($_.'::new')}{CODE} } @new_isa;
        if (($found_new||'') ne ($expected_new||'')) {
          $found_new ||= 'none';
          $expected_new ||= 'none';
          croak "Expected parent constructor of $package to be"
          . " $expected_new, but found $found_new: changing the inheritance"
          . " chain (\@ISA) at runtime (after $from_file line $from_line) is unsupported";
        }
      }
  
      my $constructor = $self->generate_method(
        $package, 'new', $self->{attribute_specs}, { no_install => 1, no_defer => 1 }
      );
      $self->{inlined} = 1;
      weaken($self->{constructor} = $constructor);
      $constructor;
    };
    $self->{inlined} = 0;
    weaken($self->{constructor} = $constructor);
    $self;
  }
  
  sub current_constructor {
    my ($self, $package) = @_;
    return *{_getglob("${package}::new")}{CODE};
  }
  
  sub assert_constructor {
    my ($self) = @_;
    my $package = $self->{package} or return 1;
    my $current = $self->current_constructor($package)
      or return 1;
    my $constructor = $self->{constructor}
      or croak "Unknown constructor for $package already exists";
    croak "Constructor for $package has been replaced with an unknown sub"
      if $constructor != $current;
    croak "Constructor for $package has been inlined and cannot be updated"
      if $self->{inlined};
  }
  
  sub generate_method {
    my ($self, $into, $name, $spec, $quote_opts) = @_;
    $quote_opts = {
      %{$quote_opts||{}},
      package => $into,
    };
    foreach my $no_init (grep !exists($spec->{$_}{init_arg}), keys %$spec) {
      $spec->{$no_init}{init_arg} = $no_init;
    }
    local $self->{captures} = {};
  
    my $into_buildargs = $into->can('BUILDARGS');
  
    my $body
      = '    my $invoker = CORE::shift();'."\n"
      . '    my $class = CORE::ref($invoker) ? CORE::ref($invoker) : $invoker;'."\n"
      . $self->_handle_subconstructor($into, $name)
      . ( $into_buildargs && $into_buildargs != \&Moo::Object::BUILDARGS
        ? $self->_generate_args_via_buildargs
        : $self->_generate_args
      )
      . $self->_check_required($spec)
      . '    my $new = '.$self->construction_string.";\n"
      . $self->_assign_new($spec)
      . ( $into->can('BUILD')
        ? $self->buildall_generator->buildall_body_for( $into, '$new', '$args' )
        : ''
      )
      . '    return $new;'."\n";
  
    if ($into->can('DEMOLISH')) {
      require Method::Generate::DemolishAll;
      Method::Generate::DemolishAll->new->generate_method($into);
    }
    quote_sub
      "${into}::${name}" => $body,
      $self->{captures}, $quote_opts||{}
    ;
  }
  
  sub _handle_subconstructor {
    my ($self, $into, $name) = @_;
    if (my $gen = $self->{subconstructor_handler}) {
      '    if ($class ne '.quotify($into).') {'."\n".
      $gen.
      '    }'."\n";
    } else {
      ''
    }
  }
  
  sub _cap_call {
    my ($self, $code, $captures) = @_;
    @{$self->{captures}}{keys %$captures} = values %$captures if $captures;
    $code;
  }
  
  sub _generate_args_via_buildargs {
    my ($self) = @_;
    q{    my $args = $class->BUILDARGS(@_);}."\n"
    .q{    Carp::croak("BUILDARGS did not return a hashref") unless CORE::ref($args) eq 'HASH';}
    ."\n";
  }
  
  # inlined from Moo::Object - update that first.
  sub _generate_args {
    my ($self) = @_;
    return <<'_EOA';
      my $args = scalar @_ == 1
        ? CORE::ref $_[0] eq 'HASH'
          ? { %{ $_[0] } }
          : Carp::croak("Single parameters to new() must be a HASH ref"
              . " data => ". $_[0])
        : @_ % 2
          ? Carp::croak("The new() method for $class expects a hash reference or a"
              . " key/value list. You passed an odd number of arguments")
          : {@_}
      ;
  _EOA
  
  }
  
  sub _assign_new {
    my ($self, $spec) = @_;
    my $ag = $self->accessor_generator;
    my %test;
    NAME: foreach my $name (sort keys %$spec) {
      my $attr_spec = $spec->{$name};
      next NAME unless defined($attr_spec->{init_arg})
                         or $ag->has_eager_default($name, $attr_spec);
      $test{$name} = $attr_spec->{init_arg};
    }
    join '', map {
      my $arg = $test{$_};
      my $arg_key = quotify($arg);
      my $test = defined $arg ? "exists \$args->{$arg_key}" : undef;
      my $source = defined $arg ? "\$args->{$arg_key}" : undef;
      my $attr_spec = $spec->{$_};
      $self->_cap_call($ag->generate_populate_set(
        '$new', $_, $attr_spec, $source, $test, $arg,
      ));
    } sort keys %test;
  }
  
  sub _check_required {
    my ($self, $spec) = @_;
    my @required_init =
      map $spec->{$_}{init_arg},
        grep {
          my $s = $spec->{$_}; # ignore required if default or builder set
          $s->{required} and not($s->{builder} or exists $s->{default})
        } sort keys %$spec;
    return '' unless @required_init;
    '    if (my @missing = grep !exists $args->{$_}, '
      .join(', ', map quotify($_), @required_init).') {'."\n"
      .q{      Carp::croak("Missing required arguments: ".CORE::join(', ', sort @missing));}."\n"
      ."    }\n";
  }
  
  # bootstrap our own constructor
  sub new {
    my $class = shift;
    delete _getstash(__PACKAGE__)->{new};
    bless $class->BUILDARGS(@_), $class;
  }
  Moo->_constructor_maker_for(__PACKAGE__)
  ->register_attribute_specs(
    attribute_specs => {
      is => 'ro',
      reader => 'all_attribute_specs',
    },
    accessor_generator => { is => 'ro' },
    construction_string => { is => 'lazy' },
    construction_builder => { is => 'bare' },
    subconstructor_handler => { is => 'ro' },
    package => { is => 'bare' },
  );
  if ($INC{'Moo/HandleMoose.pm'} && !$Moo::sification::disabled) {
    Moo::HandleMoose::inject_fake_metaclass_for(__PACKAGE__);
  }
  
  1;
METHOD_GENERATE_CONSTRUCTOR

$fatpacked{"Method/Generate/DemolishAll.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'METHOD_GENERATE_DEMOLISHALL';
  package Method::Generate::DemolishAll;
  
  use Moo::_strictures;
  use Moo::Object ();
  BEGIN { our @ISA = qw(Moo::Object) }
  use Sub::Quote qw(quote_sub quotify);
  use Moo::_Utils qw(_getglob);
  use Moo::_mro;
  
  sub generate_method {
    my ($self, $into) = @_;
    quote_sub "${into}::DEMOLISHALL", join '',
      $self->_handle_subdemolish($into),
      qq{    my \$self = shift;\n},
      $self->demolishall_body_for($into, '$self', '@_'),
      qq{    return \$self\n};
    quote_sub "${into}::DESTROY", join '',
      q!    my $self = shift;
      my $e = do {
        local $?;
        local $@;
        require Devel::GlobalDestruction;
        eval {
          $self->DEMOLISHALL(Devel::GlobalDestruction::in_global_destruction);
        };
        $@;
      };
  
      # fatal warnings+die in DESTROY = bad times (perl rt#123398)
      no warnings FATAL => 'all';
      use warnings 'all';
      die $e if $e; # rethrow
    !;
  }
  
  sub demolishall_body_for {
    my ($self, $into, $me, $args) = @_;
    my @demolishers =
      grep *{_getglob($_)}{CODE},
      map "${_}::DEMOLISH",
      @{mro::get_linear_isa($into)};
    join '', map qq{    ${me}->${_}(${args});\n}, @demolishers;
  }
  
  sub _handle_subdemolish {
    my ($self, $into) = @_;
    '    if (ref($_[0]) ne '.quotify($into).') {'."\n".
    '      return shift->Moo::Object::DEMOLISHALL(@_)'.";\n".
    '    }'."\n";
  }
  
  1;
METHOD_GENERATE_DEMOLISHALL

$fatpacked{"Module/Runtime.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'MODULE_RUNTIME';
  =head1 NAME
  
  Module::Runtime - runtime module handling
  
  =head1 SYNOPSIS
  
      use Module::Runtime qw(
  	$module_name_rx is_module_name check_module_name
  	module_notional_filename require_module);
  
      if($module_name =~ /\A$module_name_rx\z/o) { ...
      if(is_module_name($module_name)) { ...
      check_module_name($module_name);
  
      $notional_filename = module_notional_filename($module_name);
      require_module($module_name);
  
      use Module::Runtime qw(use_module use_package_optimistically);
  
      $bi = use_module("Math::BigInt", 1.31)->new("1_234");
      $widget = use_package_optimistically("Local::Widget")->new;
  
      use Module::Runtime qw(
  	$top_module_spec_rx $sub_module_spec_rx
  	is_module_spec check_module_spec
  	compose_module_name);
  
      if($spec =~ /\A$top_module_spec_rx\z/o) { ...
      if($spec =~ /\A$sub_module_spec_rx\z/o) { ...
      if(is_module_spec("Standard::Prefix", $spec)) { ...
      check_module_spec("Standard::Prefix", $spec);
  
      $module_name = compose_module_name("Standard::Prefix", $spec);
  
  =head1 DESCRIPTION
  
  The functions exported by this module deal with runtime handling of
  Perl modules, which are normally handled at compile time.  This module
  avoids using any other modules, so that it can be used in low-level
  infrastructure.
  
  The parts of this module that work with module names apply the same syntax
  that is used for barewords in Perl source.  In principle this syntax
  can vary between versions of Perl, and this module applies the syntax of
  the Perl on which it is running.  In practice the usable syntax hasn't
  changed yet.  There's some intent for Unicode module names to be supported
  in the future, but this hasn't yet amounted to any consistent facility.
  
  The functions of this module whose purpose is to load modules include
  workarounds for three old Perl core bugs regarding C<require>.  These
  workarounds are applied on any Perl version where the bugs exist, except
  for a case where one of the bugs cannot be adequately worked around in
  pure Perl.
  
  =head2 Module name syntax
  
  The usable module name syntax has not changed from Perl 5.000 up to
  Perl 5.19.8.  The syntax is composed entirely of ASCII characters.
  From Perl 5.6 onwards there has been some attempt to allow the use of
  non-ASCII Unicode characters in Perl source, but it was fundamentally
  broken (like the entirety of Perl 5.6's Unicode handling) and remained
  pretty much entirely unusable until it got some attention in the Perl
  5.15 series.  Although Unicode is now consistently accepted by the
  parser in some places, it remains broken for module names.  Furthermore,
  there has not yet been any work on how to map Unicode module names into
  filenames, so in that respect also Unicode module names are unusable.
  
  The module name syntax is, precisely: the string must consist of one or
  more segments separated by C<::>; each segment must consist of one or more
  identifier characters (ASCII alphanumerics plus "_"); the first character
  of the string must not be a digit.  Thus "C<IO::File>", "C<warnings>",
  and "C<foo::123::x_0>" are all valid module names, whereas "C<IO::>"
  and "C<1foo::bar>" are not.  C<'> separators are not permitted by this
  module, though they remain usable in Perl source, being translated to
  C<::> in the parser.
  
  =head2 Core bugs worked around
  
  The first bug worked around is core bug [perl #68590], which causes
  lexical state in one file to leak into another that is C<require>d/C<use>d
  from it.  This bug is present from Perl 5.6 up to Perl 5.10, and is
  fixed in Perl 5.11.0.  From Perl 5.9.4 up to Perl 5.10.0 no satisfactory
  workaround is possible in pure Perl.  The workaround means that modules
  loaded via this module don't suffer this pollution of their lexical
  state.  Modules loaded in other ways, or via this module on the Perl
  versions where the pure Perl workaround is impossible, remain vulnerable.
  The module L<Lexical::SealRequireHints> provides a complete workaround
  for this bug.
  
  The second bug worked around causes some kinds of failure in module
  loading, principally compilation errors in the loaded module, to be
  recorded in C<%INC> as if they were successful, so later attempts to load
  the same module immediately indicate success.  This bug is present up
  to Perl 5.8.9, and is fixed in Perl 5.9.0.  The workaround means that a
  compilation error in a module loaded via this module won't be cached as
  a success.  Modules loaded in other ways remain liable to produce bogus
  C<%INC> entries, and if a bogus entry exists then it will mislead this
  module if it is used to re-attempt loading.
  
  The third bug worked around causes the wrong context to be seen at
  file scope of a loaded module, if C<require> is invoked in a location
  that inherits context from a higher scope.  This bug is present up to
  Perl 5.11.2, and is fixed in Perl 5.11.3.  The workaround means that
  a module loaded via this module will always see the correct context.
  Modules loaded in other ways remain vulnerable.
  
  =cut
  
  package Module::Runtime;
  
  # Don't "use 5.006" here, because Perl 5.15.6 will load feature.pm if
  # the version check is done that way.
  BEGIN { require 5.006; }
  # Don't "use warnings" here, to avoid dependencies.  Do standardise the
  # warning status by lexical override; unfortunately the only safe bitset
  # to build in is the empty set, equivalent to "no warnings".
  BEGIN { ${^WARNING_BITS} = ""; }
  # Don't "use strict" here, to avoid dependencies.
  
  our $VERSION = "0.016";
  
  # Don't use Exporter here, to avoid dependencies.
  our @EXPORT_OK = qw(
  	$module_name_rx is_module_name is_valid_module_name check_module_name
  	module_notional_filename require_module
  	use_module use_package_optimistically
  	$top_module_spec_rx $sub_module_spec_rx
  	is_module_spec is_valid_module_spec check_module_spec
  	compose_module_name
  );
  my %export_ok = map { ($_ => undef) } @EXPORT_OK;
  sub import {
  	my $me = shift;
  	my $callpkg = caller(0);
  	my $errs = "";
  	foreach(@_) {
  		if(exists $export_ok{$_}) {
  			# We would need to do "no strict 'refs'" here
  			# if we had enabled strict at file scope.
  			if(/\A\$(.*)\z/s) {
  				*{$callpkg."::".$1} = \$$1;
  			} else {
  				*{$callpkg."::".$_} = \&$_;
  			}
  		} else {
  			$errs .= "\"$_\" is not exported by the $me module\n";
  		}
  	}
  	if($errs ne "") {
  		die "${errs}Can't continue after import errors ".
  			"at @{[(caller(0))[1]]} line @{[(caller(0))[2]]}.\n";
  	}
  }
  
  # Logic duplicated from Params::Classify.  Duplicating it here avoids
  # an extensive and potentially circular dependency graph.
  sub _is_string($) {
  	my($arg) = @_;
  	return defined($arg) && ref(\$arg) eq "SCALAR";
  }
  
  =head1 REGULAR EXPRESSIONS
  
  These regular expressions do not include any anchors, so to check
  whether an entire string matches a syntax item you must supply the
  anchors yourself.
  
  =over
  
  =item $module_name_rx
  
  Matches a valid Perl module name in bareword syntax.
  
  =cut
  
  our $module_name_rx = qr/[A-Z_a-z][0-9A-Z_a-z]*(?:::[0-9A-Z_a-z]+)*/;
  
  =item $top_module_spec_rx
  
  Matches a module specification for use with L</compose_module_name>,
  where no prefix is being used.
  
  =cut
  
  my $qual_module_spec_rx =
  	qr#(?:/|::)[A-Z_a-z][0-9A-Z_a-z]*(?:(?:/|::)[0-9A-Z_a-z]+)*#;
  
  my $unqual_top_module_spec_rx =
  	qr#[A-Z_a-z][0-9A-Z_a-z]*(?:(?:/|::)[0-9A-Z_a-z]+)*#;
  
  our $top_module_spec_rx = qr/$qual_module_spec_rx|$unqual_top_module_spec_rx/o;
  
  =item $sub_module_spec_rx
  
  Matches a module specification for use with L</compose_module_name>,
  where a prefix is being used.
  
  =cut
  
  my $unqual_sub_module_spec_rx = qr#[0-9A-Z_a-z]+(?:(?:/|::)[0-9A-Z_a-z]+)*#;
  
  our $sub_module_spec_rx = qr/$qual_module_spec_rx|$unqual_sub_module_spec_rx/o;
  
  =back
  
  =head1 FUNCTIONS
  
  =head2 Basic module handling
  
  =over
  
  =item is_module_name(ARG)
  
  Returns a truth value indicating whether I<ARG> is a plain string
  satisfying Perl module name syntax as described for L</$module_name_rx>.
  
  =cut
  
  sub is_module_name($) { _is_string($_[0]) && $_[0] =~ /\A$module_name_rx\z/o }
  
  =item is_valid_module_name(ARG)
  
  Deprecated alias for L</is_module_name>.
  
  =cut
  
  *is_valid_module_name = \&is_module_name;
  
  =item check_module_name(ARG)
  
  Check whether I<ARG> is a plain string
  satisfying Perl module name syntax as described for L</$module_name_rx>.
  Return normally if it is, or C<die> if it is not.
  
  =cut
  
  sub check_module_name($) {
  	unless(&is_module_name) {
  		die +(_is_string($_[0]) ? "`$_[0]'" : "argument").
  			" is not a module name\n";
  	}
  }
  
  =item module_notional_filename(NAME)
  
  Generates a notional relative filename for a module, which is used in
  some Perl core interfaces.
  The I<NAME> is a string, which should be a valid module name (one or
  more C<::>-separated segments).  If it is not a valid name, the function
  C<die>s.
  
  The notional filename for the named module is generated and returned.
  This filename is always in Unix style, with C</> directory separators
  and a C<.pm> suffix.  This kind of filename can be used as an argument to
  C<require>, and is the key that appears in C<%INC> to identify a module,
  regardless of actual local filename syntax.
  
  =cut
  
  sub module_notional_filename($) {
  	&check_module_name;
  	my($name) = @_;
  	$name =~ s!::!/!g;
  	return $name.".pm";
  }
  
  =item require_module(NAME)
  
  This is essentially the bareword form of C<require>, in runtime form.
  The I<NAME> is a string, which should be a valid module name (one or
  more C<::>-separated segments).  If it is not a valid name, the function
  C<die>s.
  
  The module specified by I<NAME> is loaded, if it hasn't been already,
  in the manner of the bareword form of C<require>.  That means that a
  search through C<@INC> is performed, and a byte-compiled form of the
  module will be used if available.
  
  The return value is as for C<require>.  That is, it is the value returned
  by the module itself if the module is loaded anew, or C<1> if the module
  was already loaded.
  
  =cut
  
  # Don't "use constant" here, to avoid dependencies.
  BEGIN {
  	*_WORK_AROUND_HINT_LEAKAGE =
  		"$]" < 5.011 && !("$]" >= 5.009004 && "$]" < 5.010001)
  			? sub(){1} : sub(){0};
  	*_WORK_AROUND_BROKEN_MODULE_STATE = "$]" < 5.009 ? sub(){1} : sub(){0};
  }
  
  BEGIN { if(_WORK_AROUND_BROKEN_MODULE_STATE) { eval q{
  	sub Module::Runtime::__GUARD__::DESTROY {
  		delete $INC{$_[0]->[0]} if @{$_[0]};
  	}
  	1;
  }; die $@ if $@ ne ""; } }
  
  sub require_module($) {
  	# Localise %^H to work around [perl #68590], where the bug exists
  	# and this is a satisfactory workaround.  The bug consists of
  	# %^H state leaking into each required module, polluting the
  	# module's lexical state.
  	local %^H if _WORK_AROUND_HINT_LEAKAGE;
  	if(_WORK_AROUND_BROKEN_MODULE_STATE) {
  		my $notional_filename = &module_notional_filename;
  		my $guard = bless([ $notional_filename ],
  				"Module::Runtime::__GUARD__");
  		my $result = CORE::require($notional_filename);
  		pop @$guard;
  		return $result;
  	} else {
  		return scalar(CORE::require(&module_notional_filename));
  	}
  }
  
  =back
  
  =head2 Structured module use
  
  =over
  
  =item use_module(NAME[, VERSION])
  
  This is essentially C<use> in runtime form, but without the importing
  feature (which is fundamentally a compile-time thing).  The I<NAME> is
  handled just like in C<require_module> above: it must be a module name,
  and the named module is loaded as if by the bareword form of C<require>.
  
  If a I<VERSION> is specified, the C<VERSION> method of the loaded module is
  called with the specified I<VERSION> as an argument.  This normally serves to
  ensure that the version loaded is at least the version required.  This is
  the same functionality provided by the I<VERSION> parameter of C<use>.
  
  On success, the name of the module is returned.  This is unlike
  L</require_module>, and is done so that the entire call to L</use_module>
  can be used as a class name to call a constructor, as in the example in
  the synopsis.
  
  =cut
  
  sub use_module($;$) {
  	my($name, $version) = @_;
  	require_module($name);
  	$name->VERSION($version) if @_ >= 2;
  	return $name;
  }
  
  =item use_package_optimistically(NAME[, VERSION])
  
  This is an analogue of L</use_module> for the situation where there is
  uncertainty as to whether a package/class is defined in its own module
  or by some other means.  It attempts to arrange for the named package to
  be available, either by loading a module or by doing nothing and hoping.
  
  An attempt is made to load the named module (as if by the bareword form
  of C<require>).  If the module cannot be found then it is assumed that
  the package was actually already loaded by other means, and no error
  is signalled.  That's the optimistic bit.
  
  I<Warning:> this optional module loading is liable to cause unreliable
  behaviour, including security problems.  It interacts especially badly
  with having C<.> in C<@INC>, which was the default state of affairs in
  Perls prior to 5.25.11.  If a package is actually defined by some means
  other than a module, then applying this function to it causes a spurious
  attempt to load a module that is expected to be non-existent.  If a
  module actually exists under that name then it will be unintentionally
  loaded.  If C<.> is in C<@INC> and this code is ever run with the current
  directory being one writable by a malicious user (such as F</tmp>), then
  the malicious user can easily cause the victim to run arbitrary code, by
  creating a module file under the predictable spuriously-loaded name in the
  writable directory.  Generally, optional module loading should be avoided.
  
  This is mostly the same operation that is performed by the L<base> pragma
  to ensure that the specified base classes are available.  The behaviour
  of L<base> was simplified in version 2.18, and later improved in version
  2.20, and on both occasions this function changed to match.
  
  If a I<VERSION> is specified, the C<VERSION> method of the loaded package is
  called with the specified I<VERSION> as an argument.  This normally serves
  to ensure that the version loaded is at least the version required.
  On success, the name of the package is returned.  These aspects of the
  function work just like L</use_module>.
  
  =cut
  
  sub use_package_optimistically($;$) {
  	my($name, $version) = @_;
  	my $fn = module_notional_filename($name);
  	eval { local $SIG{__DIE__}; require_module($name); };
  	die $@ if $@ ne "" &&
  		($@ !~ /\ACan't locate \Q$fn\E .+ at \Q@{[__FILE__]}\E line/s ||
  		 $@ =~ /^Compilation\ failed\ in\ require
  			 \ at\ \Q@{[__FILE__]}\E\ line/xm);
  	$name->VERSION($version) if @_ >= 2;
  	return $name;
  }
  
  =back
  
  =head2 Module name composition
  
  =over
  
  =item is_module_spec(PREFIX, SPEC)
  
  Returns a truth value indicating
  whether I<SPEC> is valid input for L</compose_module_name>.
  See below for what that entails.  Whether a I<PREFIX> is supplied affects
  the validity of I<SPEC>, but the exact value of the prefix is unimportant,
  so this function treats I<PREFIX> as a truth value.
  
  =cut
  
  sub is_module_spec($$) {
  	my($prefix, $spec) = @_;
  	return _is_string($spec) &&
  		$spec =~ ($prefix ? qr/\A$sub_module_spec_rx\z/o :
  				    qr/\A$top_module_spec_rx\z/o);
  }
  
  =item is_valid_module_spec(PREFIX, SPEC)
  
  Deprecated alias for L</is_module_spec>.
  
  =cut
  
  *is_valid_module_spec = \&is_module_spec;
  
  =item check_module_spec(PREFIX, SPEC)
  
  Check whether I<SPEC> is valid input for L</compose_module_name>.
  Return normally if it is, or C<die> if it is not.
  
  =cut
  
  sub check_module_spec($$) {
  	unless(&is_module_spec) {
  		die +(_is_string($_[1]) ? "`$_[1]'" : "argument").
  			" is not a module specification\n";
  	}
  }
  
  =item compose_module_name(PREFIX, SPEC)
  
  This function is intended to make it more convenient for a user to specify
  a Perl module name at runtime.  Users have greater need for abbreviations
  and context-sensitivity than programmers, and Perl module names get a
  little unwieldy.  I<SPEC> is what the user specifies, and this function
  translates it into a module name in standard form, which it returns.
  
  I<SPEC> has syntax approximately that of a standard module name: it
  should consist of one or more name segments, each of which consists
  of one or more identifier characters.  However, C</> is permitted as a
  separator, in addition to the standard C<::>.  The two separators are
  entirely interchangeable.
  
  Additionally, if I<PREFIX> is not C<undef> then it must be a module
  name in standard form, and it is prefixed to the user-specified name.
  The user can inhibit the prefix addition by starting I<SPEC> with a
  separator (either C</> or C<::>).
  
  =cut
  
  sub compose_module_name($$) {
  	my($prefix, $spec) = @_;
  	check_module_name($prefix) if defined $prefix;
  	&check_module_spec;
  	if($spec =~ s#\A(?:/|::)##) {
  		# OK
  	} else {
  		$spec = $prefix."::".$spec if defined $prefix;
  	}
  	$spec =~ s#/#::#g;
  	return $spec;
  }
  
  =back
  
  =head1 BUGS
  
  On Perl versions 5.7.2 to 5.8.8, if C<require> is overridden by the
  C<CORE::GLOBAL> mechanism, it is likely to break the heuristics used by
  L</use_package_optimistically>, making it signal an error for a missing
  module rather than assume that it was already loaded.  From Perl 5.8.9
  onwards, and on 5.7.1 and earlier, this module can avoid being confused
  by such an override.  On the affected versions, a C<require> override
  might be installed by L<Lexical::SealRequireHints>, if something requires
  its bugfix but for some reason its XS implementation isn't available.
  
  =head1 SEE ALSO
  
  L<Lexical::SealRequireHints>,
  L<base>,
  L<perlfunc/require>,
  L<perlfunc/use>
  
  =head1 AUTHOR
  
  Andrew Main (Zefram) <zefram@fysh.org>
  
  =head1 COPYRIGHT
  
  Copyright (C) 2004, 2006, 2007, 2009, 2010, 2011, 2012, 2014, 2017
  Andrew Main (Zefram) <zefram@fysh.org>
  
  =head1 LICENSE
  
  This module is free software; you can redistribute it and/or modify it
  under the same terms as Perl itself.
  
  =cut
  
  1;
MODULE_RUNTIME

$fatpacked{"Moo.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'MOO';
  package Moo;
  
  use Moo::_strictures;
  use Moo::_mro;
  use Moo::_Utils qw(
    _getglob
    _getstash
    _install_coderef
    _install_modifier
    _load_module
    _set_loaded
    _unimport_coderefs
  );
  use Scalar::Util qw(reftype);
  use Carp qw(croak);
  BEGIN {
    our @CARP_NOT = qw(
      Method::Generate::Constructor
      Method::Generate::Accessor
      Moo::sification
      Moo::_Utils
      Moo::Role
    );
  }
  
  our $VERSION = '2.003004';
  $VERSION =~ tr/_//d;
  
  require Moo::sification;
  Moo::sification->import;
  
  our %MAKERS;
  
  sub _install_tracked {
    my ($target, $name, $code) = @_;
    $MAKERS{$target}{exports}{$name} = $code;
    _install_coderef "${target}::${name}" => "Moo::${name}" => $code;
  }
  
  sub import {
    my $target = caller;
    my $class = shift;
    _set_loaded(caller);
  
    strict->import;
    warnings->import;
  
    if ($INC{'Role/Tiny.pm'} and Role::Tiny->is_role($target)) {
      croak "Cannot import Moo into a role";
    }
    $MAKERS{$target} ||= {};
    _install_tracked $target => extends => sub {
      $class->_set_superclasses($target, @_);
      $class->_maybe_reset_handlemoose($target);
      return;
    };
    _install_tracked $target => with => sub {
      require Moo::Role;
      Moo::Role->apply_roles_to_package($target, @_);
      $class->_maybe_reset_handlemoose($target);
    };
    _install_tracked $target => has => sub {
      my $name_proto = shift;
      my @name_proto = ref $name_proto eq 'ARRAY' ? @$name_proto : $name_proto;
      if (@_ % 2 != 0) {
        croak "Invalid options for " . join(', ', map "'$_'", @name_proto)
          . " attribute(s): even number of arguments expected, got " . scalar @_;
      }
      my %spec = @_;
      foreach my $name (@name_proto) {
        # Note that when multiple attributes specified, each attribute
        # needs a separate \%specs hashref
        my $spec_ref = @name_proto > 1 ? +{%spec} : \%spec;
        $class->_constructor_maker_for($target)
              ->register_attribute_specs($name, $spec_ref);
        $class->_accessor_maker_for($target)
              ->generate_method($target, $name, $spec_ref);
        $class->_maybe_reset_handlemoose($target);
      }
      return;
    };
    foreach my $type (qw(before after around)) {
      _install_tracked $target => $type => sub {
        _install_modifier($target, $type, @_);
        return;
      };
    }
    return if $MAKERS{$target}{is_class}; # already exported into this package
    my $stash = _getstash($target);
    my @not_methods = map +(
      !ref($_) ? *$_{CODE}||() : reftype($_) eq 'CODE' ? $_ : ()
    ), values %$stash;
    @{$MAKERS{$target}{not_methods}={}}{@not_methods} = @not_methods;
    $MAKERS{$target}{is_class} = 1;
    {
      no strict 'refs';
      @{"${target}::ISA"} = do {
        require Moo::Object; ('Moo::Object');
      } unless @{"${target}::ISA"};
    }
    if ($INC{'Moo/HandleMoose.pm'} && !$Moo::sification::disabled) {
      Moo::HandleMoose::inject_fake_metaclass_for($target);
    }
  }
  
  sub unimport {
    my $target = caller;
    _unimport_coderefs($target, $MAKERS{$target});
  }
  
  sub _set_superclasses {
    my $class = shift;
    my $target = shift;
    foreach my $superclass (@_) {
      _load_module($superclass);
      if ($INC{'Role/Tiny.pm'} && Role::Tiny->is_role($superclass)) {
        croak "Can't extend role '$superclass'";
      }
    }
    # Can't do *{...} = \@_ or 5.10.0's mro.pm stops seeing @ISA
    @{*{_getglob("${target}::ISA")}{ARRAY}} = @_;
    if (my $old = delete $Moo::MAKERS{$target}{constructor}) {
      $old->assert_constructor;
      delete _getstash($target)->{new};
      Moo->_constructor_maker_for($target)
         ->register_attribute_specs(%{$old->all_attribute_specs});
    }
    elsif (!$target->isa('Moo::Object')) {
      Moo->_constructor_maker_for($target);
    }
    $Moo::HandleMoose::MOUSE{$target} = [
      grep defined, map Mouse::Util::find_meta($_), @_
    ] if Mouse::Util->can('find_meta');
  }
  
  sub _maybe_reset_handlemoose {
    my ($class, $target) = @_;
    if ($INC{'Moo/HandleMoose.pm'} && !$Moo::sification::disabled) {
      Moo::HandleMoose::maybe_reinject_fake_metaclass_for($target);
    }
  }
  
  sub _accessor_maker_for {
    my ($class, $target) = @_;
    return unless $MAKERS{$target};
    $MAKERS{$target}{accessor} ||= do {
      my $maker_class = do {
        if (my $m = do {
              require Sub::Defer;
              if (my $defer_target =
                    (Sub::Defer::defer_info($target->can('new'))||[])->[0]
                ) {
                my ($pkg) = ($defer_target =~ /^(.*)::[^:]+$/);
                $MAKERS{$pkg} && $MAKERS{$pkg}{accessor};
              } else {
                undef;
              }
            }) {
          ref($m);
        } else {
          require Method::Generate::Accessor;
          'Method::Generate::Accessor'
        }
      };
      $maker_class->new;
    }
  }
  
  sub _constructor_maker_for {
    my ($class, $target) = @_;
    return unless $MAKERS{$target};
    $MAKERS{$target}{constructor} ||= do {
      require Method::Generate::Constructor;
  
      my %construct_opts = (
        package => $target,
        accessor_generator => $class->_accessor_maker_for($target),
        subconstructor_handler => (
          '      if ($Moo::MAKERS{$class}) {'."\n"
          .'        if ($Moo::MAKERS{$class}{constructor}) {'."\n"
          .'          package '.$target.';'."\n"
          .'          return $invoker->SUPER::new(@_);'."\n"
          .'        }'."\n"
          .'        '.$class.'->_constructor_maker_for($class);'."\n"
          .'        return $invoker->new(@_)'.";\n"
          .'      } elsif ($INC{"Moose.pm"} and my $meta = Class::MOP::get_metaclass_by_name($class)) {'."\n"
          .'        return $meta->new_object('."\n"
          .'          $class->can("BUILDARGS") ? $class->BUILDARGS(@_)'."\n"
          .'                      : $class->Moo::Object::BUILDARGS(@_)'."\n"
          .'        );'."\n"
          .'      }'."\n"
        ),
      );
  
      my $con;
      my @isa = @{mro::get_linear_isa($target)};
      shift @isa;
      no strict 'refs';
      if (my ($parent_new) = grep +(defined &{$_.'::new'}), @isa) {
        if ($parent_new eq 'Moo::Object') {
          # no special constructor needed
        }
        elsif (my $makers = $MAKERS{$parent_new}) {
          $con = $makers->{constructor};
          $construct_opts{construction_string} = $con->construction_string
            if $con;
        }
        elsif ($parent_new->can('BUILDALL')) {
          $construct_opts{construction_builder} = sub {
            my $inv = $target->can('BUILDARGS') ? '' : 'Moo::Object::';
            'do {'
            .'  my $args = $class->'.$inv.'BUILDARGS(@_);'
            .'  $args->{__no_BUILD__} = 1;'
            .'  $invoker->'.$target.'::SUPER::new($args);'
            .'}'
          };
        }
        else {
          $construct_opts{construction_builder} = sub {
            '$invoker->'.$target.'::SUPER::new('
              .($target->can('FOREIGNBUILDARGS') ?
                '$class->FOREIGNBUILDARGS(@_)' : '@_')
              .')'
          };
        }
      }
      ($con ? ref($con) : 'Method::Generate::Constructor')
        ->new(%construct_opts)
        ->install_delayed
        ->register_attribute_specs(%{$con?$con->all_attribute_specs:{}})
    }
  }
  
  sub _concrete_methods_of {
    my ($me, $class) = @_;
    my $makers = $MAKERS{$class};
    # grab class symbol table
    my $stash = _getstash($class);
    # reverse so our keys become the values (captured coderefs) in case
    # they got copied or re-used since
    my $not_methods = { reverse %{$makers->{not_methods}||{}} };
    +{
      # grab all code entries that aren't in the not_methods list
      map {;
        no strict 'refs';
        my $code = exists &{"${class}::$_"} ? \&{"${class}::$_"} : undef;
        ( ! $code or exists $not_methods->{$code} ) ? () : ($_ => $code)
      } grep +(!ref($stash->{$_}) || reftype($stash->{$_}) eq 'CODE'), keys %$stash
    };
  }
  
  1;
  __END__
  
  =pod
  
  =encoding utf-8
  
  =head1 NAME
  
  Moo - Minimalist Object Orientation (with Moose compatibility)
  
  =head1 SYNOPSIS
  
    package Cat::Food;
  
    use Moo;
    use strictures 2;
    use namespace::clean;
  
    sub feed_lion {
      my $self = shift;
      my $amount = shift || 1;
  
      $self->pounds( $self->pounds - $amount );
    }
  
    has taste => (
      is => 'ro',
    );
  
    has brand => (
      is  => 'ro',
      isa => sub {
        die "Only SWEET-TREATZ supported!" unless $_[0] eq 'SWEET-TREATZ'
      },
    );
  
    has pounds => (
      is  => 'rw',
      isa => sub { die "$_[0] is too much cat food!" unless $_[0] < 15 },
    );
  
    1;
  
  And elsewhere:
  
    my $full = Cat::Food->new(
        taste  => 'DELICIOUS.',
        brand  => 'SWEET-TREATZ',
        pounds => 10,
    );
  
    $full->feed_lion;
  
    say $full->pounds;
  
  =head1 DESCRIPTION
  
  C<Moo> is an extremely light-weight Object Orientation system. It allows one to
  concisely define objects and roles with a convenient syntax that avoids the
  details of Perl's object system.  C<Moo> contains a subset of L<Moose> and is
  optimised for rapid startup.
  
  C<Moo> avoids depending on any XS modules to allow for simple deployments.  The
  name C<Moo> is based on the idea that it provides almost -- but not quite --
  two thirds of L<Moose>.
  
  Unlike L<Mouse> this module does not aim at full compatibility with
  L<Moose>'s surface syntax, preferring instead to provide full interoperability
  via the metaclass inflation capabilities described in L</MOO AND MOOSE>.
  
  For a full list of the minor differences between L<Moose> and L<Moo>'s surface
  syntax, see L</INCOMPATIBILITIES WITH MOOSE>.
  
  =head1 WHY MOO EXISTS
  
  If you want a full object system with a rich Metaprotocol, L<Moose> is
  already wonderful.
  
  But if you don't want to use L<Moose>, you may not want "less metaprotocol"
  like L<Mouse> offers, but you probably want "no metaprotocol", which is what
  Moo provides. C<Moo> is ideal for some situations where deployment or startup
  time precludes using L<Moose> and L<Mouse>:
  
  =over 2
  
  =item a command line or CGI script where fast startup is essential
  
  =item code designed to be deployed as a single file via L<App::FatPacker>
  
  =item a CPAN module that may be used by others in the above situations
  
  =back
  
  C<Moo> maintains transparent compatibility with L<Moose> so if you install and
  load L<Moose> you can use Moo classes and roles in L<Moose> code without
  modification.
  
  Moo -- Minimal Object Orientation -- aims to make it smooth to upgrade to
  L<Moose> when you need more than the minimal features offered by Moo.
  
  =head1 MOO AND MOOSE
  
  If L<Moo> detects L<Moose> being loaded, it will automatically register
  metaclasses for your L<Moo> and L<Moo::Role> packages, so you should be able
  to use them in L<Moose> code without modification.
  
  L<Moo> will also create L<Moose type constraints|Moose::Manual::Types> for
  L<Moo> classes and roles, so that in Moose classes C<< isa => 'MyMooClass' >>
  and C<< isa => 'MyMooRole' >> work the same as for L<Moose> classes and roles.
  
  Extending a L<Moose> class or consuming a L<Moose::Role> will also work.
  
  Extending a L<Mouse> class or consuming a L<Mouse::Role> will also work. But
  note that we don't provide L<Mouse> metaclasses or metaroles so the other way
  around doesn't work. This feature exists for L<Any::Moose> users porting to
  L<Moo>; enabling L<Mouse> users to use L<Moo> classes is not a priority for us.
  
  This means that there is no need for anything like L<Any::Moose> for Moo
  code - Moo and Moose code should simply interoperate without problem. To
  handle L<Mouse> code, you'll likely need an empty Moo role or class consuming
  or extending the L<Mouse> stuff since it doesn't register true L<Moose>
  metaclasses like L<Moo> does.
  
  If you need to disable the metaclass creation, add:
  
    no Moo::sification;
  
  to your code before Moose is loaded, but bear in mind that this switch is
  global and turns the mechanism off entirely so don't put this in library code.
  
  =head1 MOO AND CLASS::XSACCESSOR
  
  If a new enough version of L<Class::XSAccessor> is available, it will be used
  to generate simple accessors, readers, and writers for better performance.
  Simple accessors are those without lazy defaults, type checks/coercions, or
  triggers.  Simple readers are those without lazy defaults. Readers and writers
  generated by L<Class::XSAccessor> will behave slightly differently: they will
  reject attempts to call them with the incorrect number of parameters.
  
  =head1 MOO VERSUS ANY::MOOSE
  
  L<Any::Moose> will load L<Mouse> normally, and L<Moose> in a program using
  L<Moose> - which theoretically allows you to get the startup time of L<Mouse>
  without disadvantaging L<Moose> users.
  
  Sadly, this doesn't entirely work, since the selection is load order dependent
  - L<Moo>'s metaclass inflation system explained above in L</MOO AND MOOSE> is
  significantly more reliable.
  
  So if you want to write a CPAN module that loads fast or has only pure perl
  dependencies but is also fully usable by L<Moose> users, you should be using
  L<Moo>.
  
  For a full explanation, see the article
  L<http://shadow.cat/blog/matt-s-trout/moo-versus-any-moose> which explains
  the differing strategies in more detail and provides a direct example of
  where L<Moo> succeeds and L<Any::Moose> fails.
  
  =head1 PUBLIC METHODS
  
  Moo provides several methods to any class using it.
  
  =head2 new
  
    Foo::Bar->new( attr1 => 3 );
  
  or
  
    Foo::Bar->new({ attr1 => 3 });
  
  The constructor for the class.  By default it will accept attributes either as a
  hashref, or a list of key value pairs.  This can be customized with the
  L</BUILDARGS> method.
  
  =head2 does
  
    if ($foo->does('Some::Role1')) {
      ...
    }
  
  Returns true if the object composes in the passed role.
  
  =head2 DOES
  
    if ($foo->DOES('Some::Role1') || $foo->DOES('Some::Class1')) {
      ...
    }
  
  Similar to L</does>, but will also return true for both composed roles and
  superclasses.
  
  =head2 meta
  
    my $meta = Foo::Bar->meta;
    my @methods = $meta->get_method_list;
  
  Returns an object that will behave as if it is a
  L<Moose metaclass|Moose::Meta::Class> object for the class. If you call
  anything other than C<make_immutable> on it, the object will be transparently
  upgraded to a genuine L<Moose::Meta::Class> instance, loading Moose in the
  process if required. C<make_immutable> itself is a no-op, since we generate
  metaclasses that are already immutable, and users converting from Moose had
  an unfortunate tendency to accidentally load Moose by calling it.
  
  =head1 LIFECYCLE METHODS
  
  There are several methods that you can define in your class to control
  construction and destruction of objects.  They should be used rather than trying
  to modify C<new> or C<DESTROY> yourself.
  
  =head2 BUILDARGS
  
    around BUILDARGS => sub {
      my ( $orig, $class, @args ) = @_;
  
      return { attr1 => $args[0] }
        if @args == 1 && !ref $args[0];
  
      return $class->$orig(@args);
    };
  
    Foo::Bar->new( 3 );
  
  This class method is used to transform the arguments to C<new> into a hash
  reference of attribute values.
  
  The default implementation accepts a hash or hash reference of named parameters.
  If it receives a single argument that isn't a hash reference it will throw an
  error.
  
  You can override this method in your class to handle other types of options
  passed to the constructor.
  
  This method should always return a hash reference of named options.
  
  =head2 FOREIGNBUILDARGS
  
    sub FOREIGNBUILDARGS {
      my ( $class, $options ) = @_;
      return $options->{foo};
    }
  
  If you are inheriting from a non-Moo class, the arguments passed to the parent
  class constructor can be manipulated by defining a C<FOREIGNBUILDARGS> method.
  It will receive the same arguments as L</BUILDARGS>, and should return a list
  of arguments to pass to the parent class constructor.
  
  =head2 BUILD
  
    sub BUILD {
      my ($self, $args) = @_;
      die "foo and bar cannot be used at the same time"
        if exists $args->{foo} && exists $args->{bar};
    }
  
  On object creation, any C<BUILD> methods in the class's inheritance hierarchy
  will be called on the object and given the results of L</BUILDARGS>.  They each
  will be called in order from the parent classes down to the child, and thus
  should not themselves call the parent's method.  Typically this is used for
  object validation or possibly logging.
  
  =head2 DEMOLISH
  
    sub DEMOLISH {
      my ($self, $in_global_destruction) = @_;
      ...
    }
  
  When an object is destroyed, any C<DEMOLISH> methods in the inheritance
  hierarchy will be called on the object.  They are given boolean to inform them
  if global destruction is in progress, and are called from the child class upwards
  to the parent.  This is similar to L</BUILD> methods but in the opposite order.
  
  Note that this is implemented by a C<DESTROY> method, which is only created on
  on the first construction of an object of your class.  This saves on overhead for
  classes that are never instantiated or those without C<DEMOLISH> methods.  If you
  try to define your own C<DESTROY>, this will cause undefined results.
  
  =head1 IMPORTED SUBROUTINES
  
  =head2 extends
  
    extends 'Parent::Class';
  
  Declares a base class. Multiple superclasses can be passed for multiple
  inheritance but please consider using L<roles|Moo::Role> instead.  The class
  will be loaded but no errors will be triggered if the class can't be found and
  there are already subs in the class.
  
  Calling extends more than once will REPLACE your superclasses, not add to
  them like 'use base' would.
  
  =head2 with
  
    with 'Some::Role1';
  
  or
  
    with 'Some::Role1', 'Some::Role2';
  
  Composes one or more L<Moo::Role> (or L<Role::Tiny>) roles into the current
  class.  An error will be raised if these roles cannot be composed because they
  have conflicting method definitions.  The roles will be loaded using the same
  mechanism as C<extends> uses.
  
  =head2 has
  
    has attr => (
      is => 'ro',
    );
  
  Declares an attribute for the class.
  
    package Foo;
    use Moo;
    has 'attr' => (
      is => 'ro'
    );
  
    package Bar;
    use Moo;
    extends 'Foo';
    has '+attr' => (
      default => sub { "blah" },
    );
  
  Using the C<+> notation, it's possible to override an attribute.
  
    has [qw(attr1 attr2 attr3)] => (
      is => 'ro',
    );
  
  Using an arrayref with multiple attribute names, it's possible to declare
  multiple attributes with the same options.
  
  The options for C<has> are as follows:
  
  =over 2
  
  =item C<is>
  
  B<required>, may be C<ro>, C<lazy>, C<rwp> or C<rw>.
  
  C<ro> stands for "read-only" and generates an accessor that dies if you attempt
  to write to it - i.e.  a getter only - by defaulting C<reader> to the name of
  the attribute.
  
  C<lazy> generates a reader like C<ro>, but also sets C<lazy> to 1 and
  C<builder> to C<_build_${attribute_name}> to allow on-demand generated
  attributes.  This feature was my attempt to fix my incompetence when
  originally designing C<lazy_build>, and is also implemented by
  L<MooseX::AttributeShortcuts>. There is, however, nothing to stop you
  using C<lazy> and C<builder> yourself with C<rwp> or C<rw> - it's just that
  this isn't generally a good idea so we don't provide a shortcut for it.
  
  C<rwp> stands for "read-write protected" and generates a reader like C<ro>, but
  also sets C<writer> to C<_set_${attribute_name}> for attributes that are
  designed to be written from inside of the class, but read-only from outside.
  This feature comes from L<MooseX::AttributeShortcuts>.
  
  C<rw> stands for "read-write" and generates a normal getter/setter by
  defaulting the C<accessor> to the name of the attribute specified.
  
  =item C<isa>
  
  Takes a coderef which is used to validate the attribute.  Unlike L<Moose>, Moo
  does not include a basic type system, so instead of doing C<< isa => 'Num' >>,
  one should do
  
    use Scalar::Util qw(looks_like_number);
    ...
    isa => sub {
      die "$_[0] is not a number!" unless looks_like_number $_[0]
    },
  
  Note that the return value for C<isa> is discarded. Only if the sub dies does
  type validation fail.
  
  L<Sub::Quote aware|/SUB QUOTE AWARE>
  
  Since L<Moo> does B<not> run the C<isa> check before C<coerce> if a coercion
  subroutine has been supplied, C<isa> checks are not structural to your code
  and can, if desired, be omitted on non-debug builds (although if this results
  in an uncaught bug causing your program to break, the L<Moo> authors guarantee
  nothing except that you get to keep both halves).
  
  If you want L<Moose> compatible or L<MooseX::Types> style named types, look at
  L<Type::Tiny>.
  
  To cause your C<isa> entries to be automatically mapped to named
  L<Moose::Meta::TypeConstraint> objects (rather than the default behaviour
  of creating an anonymous type), set:
  
    $Moo::HandleMoose::TYPE_MAP{$isa_coderef} = sub {
      require MooseX::Types::Something;
      return MooseX::Types::Something::TypeName();
    };
  
  Note that this example is purely illustrative; anything that returns a
  L<Moose::Meta::TypeConstraint> object or something similar enough to it to
  make L<Moose> happy is fine.
  
  =item C<coerce>
  
  Takes a coderef which is meant to coerce the attribute.  The basic idea is to
  do something like the following:
  
   coerce => sub {
     $_[0] % 2 ? $_[0] : $_[0] + 1
   },
  
  Note that L<Moo> will always execute your coercion: this is to permit
  C<isa> entries to be used purely for bug trapping, whereas coercions are
  always structural to your code. We do, however, apply any supplied C<isa>
  check after the coercion has run to ensure that it returned a valid value.
  
  L<Sub::Quote aware|/SUB QUOTE AWARE>
  
  If the C<isa> option is a blessed object providing a C<coerce> or
  C<coercion> method, then the C<coerce> option may be set to just C<1>.
  
  =item C<handles>
  
  Takes a string
  
    handles => 'RobotRole'
  
  Where C<RobotRole> is a L<role|Moo::Role> that defines an interface which
  becomes the list of methods to handle.
  
  Takes a list of methods
  
    handles => [ qw( one two ) ]
  
  Takes a hashref
  
    handles => {
      un => 'one',
    }
  
  =item C<trigger>
  
  Takes a coderef which will get called any time the attribute is set. This
  includes the constructor, but not default or built values. The coderef will be
  invoked against the object with the new value as an argument.
  
  If you set this to just C<1>, it generates a trigger which calls the
  C<_trigger_${attr_name}> method on C<$self>. This feature comes from
  L<MooseX::AttributeShortcuts>.
  
  Note that Moose also passes the old value, if any; this feature is not yet
  supported.
  
  L<Sub::Quote aware|/SUB QUOTE AWARE>
  
  =item C<default>
  
  Takes a coderef which will get called with $self as its only argument to
  populate an attribute if no value for that attribute was supplied to the
  constructor. Alternatively, if the attribute is lazy, C<default> executes when
  the attribute is first retrieved if no value has yet been provided.
  
  If a simple scalar is provided, it will be inlined as a string. Any non-code
  reference (hash, array) will result in an error - for that case instead use
  a code reference that returns the desired value.
  
  Note that if your default is fired during new() there is no guarantee that
  other attributes have been populated yet so you should not rely on their
  existence.
  
  L<Sub::Quote aware|/SUB QUOTE AWARE>
  
  =item C<predicate>
  
  Takes a method name which will return true if an attribute has a value.
  
  If you set this to just C<1>, the predicate is automatically named
  C<has_${attr_name}> if your attribute's name does not start with an
  underscore, or C<_has_${attr_name_without_the_underscore}> if it does.
  This feature comes from L<MooseX::AttributeShortcuts>.
  
  =item C<builder>
  
  Takes a method name which will be called to create the attribute - functions
  exactly like default except that instead of calling
  
    $default->($self);
  
  Moo will call
  
    $self->$builder;
  
  The following features come from L<MooseX::AttributeShortcuts>:
  
  If you set this to just C<1>, the builder is automatically named
  C<_build_${attr_name}>.
  
  If you set this to a coderef or code-convertible object, that variable will be
  installed under C<$class::_build_${attr_name}> and the builder set to the same
  name.
  
  =item C<clearer>
  
  Takes a method name which will clear the attribute.
  
  If you set this to just C<1>, the clearer is automatically named
  C<clear_${attr_name}> if your attribute's name does not start with an
  underscore, or C<_clear_${attr_name_without_the_underscore}> if it does.
  This feature comes from L<MooseX::AttributeShortcuts>.
  
  B<NOTE:> If the attribute is C<lazy>, it will be regenerated from C<default> or
  C<builder> the next time it is accessed. If it is not lazy, it will be C<undef>.
  
  =item C<lazy>
  
  B<Boolean>.  Set this if you want values for the attribute to be grabbed
  lazily.  This is usually a good idea if you have a L</builder> which requires
  another attribute to be set.
  
  =item C<required>
  
  B<Boolean>.  Set this if the attribute must be passed on object instantiation.
  
  =item C<reader>
  
  The name of the method that returns the value of the attribute.  If you like
  Java style methods, you might set this to C<get_foo>
  
  =item C<writer>
  
  The value of this attribute will be the name of the method to set the value of
  the attribute.  If you like Java style methods, you might set this to
  C<set_foo>.
  
  =item C<weak_ref>
  
  B<Boolean>.  Set this if you want the reference that the attribute contains to
  be weakened. Use this when circular references, which cause memory leaks, are
  possible.
  
  =item C<init_arg>
  
  Takes the name of the key to look for at instantiation time of the object.  A
  common use of this is to make an underscored attribute have a non-underscored
  initialization name. C<undef> means that passing the value in on instantiation
  is ignored.
  
  =item C<moosify>
  
  Takes either a coderef or array of coderefs which is meant to transform the
  given attributes specifications if necessary when upgrading to a Moose role or
  class. You shouldn't need this by default, but is provided as a means of
  possible extensibility.
  
  =back
  
  =head2 before
  
    before foo => sub { ... };
  
  See L<< Class::Method::Modifiers/before method(s) => sub { ... }; >> for full
  documentation.
  
  =head2 around
  
    around foo => sub { ... };
  
  See L<< Class::Method::Modifiers/around method(s) => sub { ... }; >> for full
  documentation.
  
  =head2 after
  
    after foo => sub { ... };
  
  See L<< Class::Method::Modifiers/after method(s) => sub { ... }; >> for full
  documentation.
  
  =head1 SUB QUOTE AWARE
  
  L<Sub::Quote/quote_sub> allows us to create coderefs that are "inlineable,"
  giving us a handy, XS-free speed boost.  Any option that is L<Sub::Quote>
  aware can take advantage of this.
  
  To do this, you can write
  
    use Sub::Quote;
  
    use Moo;
    use namespace::clean;
  
    has foo => (
      is => 'ro',
      isa => quote_sub(q{ die "Not <3" unless $_[0] < 3 })
    );
  
  which will be inlined as
  
    do {
      local @_ = ($_[0]->{foo});
      die "Not <3" unless $_[0] < 3;
    }
  
  or to avoid localizing @_,
  
    has foo => (
      is => 'ro',
      isa => quote_sub(q{ my ($val) = @_; die "Not <3" unless $val < 3 })
    );
  
  which will be inlined as
  
    do {
      my ($val) = ($_[0]->{foo});
      die "Not <3" unless $val < 3;
    }
  
  See L<Sub::Quote> for more information, including how to pass lexical
  captures that will also be compiled into the subroutine.
  
  =head1 CLEANING UP IMPORTS
  
  L<Moo> will not clean up imported subroutines for you; you will have
  to do that manually. The recommended way to do this is to declare your
  imports first, then C<use Moo>, then C<use namespace::clean>.
  Anything imported before L<namespace::clean> will be scrubbed.
  Anything imported or declared after will be still be available.
  
    package Record;
  
    use Digest::MD5 qw(md5_hex);
  
    use Moo;
    use namespace::clean;
  
    has name => (is => 'ro', required => 1);
    has id => (is => 'lazy');
    sub _build_id {
      my ($self) = @_;
      return md5_hex($self->name);
    }
  
    1;
  
  If you were to import C<md5_hex> after L<namespace::clean> you would
  be able to call C<< ->md5_hex() >> on your C<Record> instances (and it
  probably wouldn't do what you expect!).
  
  L<Moo::Role>s behave slightly differently.  Since their methods are
  composed into the consuming class, they can do a little more for you
  automatically.  As long as you declare your imports before calling
  C<use Moo::Role>, those imports and the ones L<Moo::Role> itself
  provides will not be composed into consuming classes so there's usually
  no need to use L<namespace::clean>.
  
  B<On L<namespace::autoclean>:> Older versions of L<namespace::autoclean> would
  inflate Moo classes to full L<Moose> classes, losing the benefits of Moo.  If
  you want to use L<namespace::autoclean> with a Moo class, make sure you are
  using version 0.16 or newer.
  
  =head1 INCOMPATIBILITIES WITH MOOSE
  
  There is no built-in type system.  C<isa> is verified with a coderef; if you
  need complex types, L<Type::Tiny> can provide types, type libraries, and
  will work seamlessly with both L<Moo> and L<Moose>.  L<Type::Tiny> can be
  considered the successor to L<MooseX::Types> and provides a similar API, so
  that you can write
  
    use Types::Standard qw(Int);
    has days_to_live => (is => 'ro', isa => Int);
  
  C<initializer> is not supported in core since the author considers it to be a
  bad idea and Moose best practices recommend avoiding it. Meanwhile C<trigger> or
  C<coerce> are more likely to be able to fulfill your needs.
  
  There is no meta object.  If you need this level of complexity you need
  L<Moose> - Moo is small because it explicitly does not provide a metaprotocol.
  However, if you load L<Moose>, then
  
    Class::MOP::class_of($moo_class_or_role)
  
  will return an appropriate metaclass pre-populated by L<Moo>.
  
  No support for C<super>, C<override>, C<inner>, or C<augment> - the author
  considers augment to be a bad idea, and override can be translated:
  
    override foo => sub {
      ...
      super();
      ...
    };
  
    around foo => sub {
      my ($orig, $self) = (shift, shift);
      ...
      $self->$orig(@_);
      ...
    };
  
  The C<dump> method is not provided by default. The author suggests loading
  L<Devel::Dwarn> into C<main::> (via C<perl -MDevel::Dwarn ...> for example) and
  using C<$obj-E<gt>$::Dwarn()> instead.
  
  L</default> only supports coderefs and plain scalars, because passing a hash
  or array reference as a default is almost always incorrect since the value is
  then shared between all objects using that default.
  
  C<lazy_build> is not supported; you are instead encouraged to use the
  C<< is => 'lazy' >> option supported by L<Moo> and
  L<MooseX::AttributeShortcuts>.
  
  C<auto_deref> is not supported since the author considers it a bad idea and
  it has been considered best practice to avoid it for some time.
  
  C<documentation> will show up in a L<Moose> metaclass created from your class
  but is otherwise ignored. Then again, L<Moose> ignores it as well, so this
  is arguably not an incompatibility.
  
  Since C<coerce> does not require C<isa> to be defined but L<Moose> does
  require it, the metaclass inflation for coerce alone is a trifle insane
  and if you attempt to subtype the result will almost certainly break.
  
  Handling of warnings: when you C<use Moo> we enable strict and warnings, in a
  similar way to Moose. The authors recommend the use of C<strictures>, which
  enables FATAL warnings, and several extra pragmas when used in development:
  L<indirect>, L<multidimensional>, and L<bareword::filehandles>.
  
  Additionally, L<Moo> supports a set of attribute option shortcuts intended to
  reduce common boilerplate.  The set of shortcuts is the same as in the L<Moose>
  module L<MooseX::AttributeShortcuts> as of its version 0.009+.  So if you:
  
    package MyClass;
    use Moo;
    use strictures 2;
  
  The nearest L<Moose> invocation would be:
  
    package MyClass;
  
    use Moose;
    use warnings FATAL => "all";
    use MooseX::AttributeShortcuts;
  
  or, if you're inheriting from a non-Moose class,
  
    package MyClass;
  
    use Moose;
    use MooseX::NonMoose;
    use warnings FATAL => "all";
    use MooseX::AttributeShortcuts;
  
  Finally, Moose requires you to call
  
    __PACKAGE__->meta->make_immutable;
  
  at the end of your class to get an inlined (i.e. not horribly slow)
  constructor. Moo does it automatically the first time ->new is called
  on your class. (C<make_immutable> is a no-op in Moo to ease migration.)
  
  An extension L<MooX::late> exists to ease translating Moose packages
  to Moo by providing a more Moose-like interface.
  
  =head1 SUPPORT
  
  Users' IRC: #moose on irc.perl.org
  
  =for :html
  L<(click for instant chatroom login)|http://chat.mibbit.com/#moose@irc.perl.org>
  
  Development and contribution IRC: #web-simple on irc.perl.org
  
  =for :html
  L<(click for instant chatroom login)|http://chat.mibbit.com/#web-simple@irc.perl.org>
  
  Bugtracker: L<https://rt.cpan.org/Public/Dist/Display.html?Name=Moo>
  
  Git repository: L<git://github.com/moose/Moo.git>
  
  Git browser: L<https://github.com/moose/Moo>
  
  =head1 AUTHOR
  
  mst - Matt S. Trout (cpan:MSTROUT) <mst@shadowcat.co.uk>
  
  =head1 CONTRIBUTORS
  
  dg - David Leadbeater (cpan:DGL) <dgl@dgl.cx>
  
  frew - Arthur Axel "fREW" Schmidt (cpan:FREW) <frioux@gmail.com>
  
  hobbs - Andrew Rodland (cpan:ARODLAND) <arodland@cpan.org>
  
  jnap - John Napiorkowski (cpan:JJNAPIORK) <jjn1056@yahoo.com>
  
  ribasushi - Peter Rabbitson (cpan:RIBASUSHI) <ribasushi@cpan.org>
  
  chip - Chip Salzenberg (cpan:CHIPS) <chip@pobox.com>
  
  ajgb - Alex J. G. Burzyński (cpan:AJGB) <ajgb@cpan.org>
  
  doy - Jesse Luehrs (cpan:DOY) <doy at tozt dot net>
  
  perigrin - Chris Prather (cpan:PERIGRIN) <chris@prather.org>
  
  Mithaldu - Christian Walde (cpan:MITHALDU) <walde.christian@googlemail.com>
  
  ilmari - Dagfinn Ilmari Mannsåker (cpan:ILMARI) <ilmari@ilmari.org>
  
  tobyink - Toby Inkster (cpan:TOBYINK) <tobyink@cpan.org>
  
  haarg - Graham Knop (cpan:HAARG) <haarg@cpan.org>
  
  mattp - Matt Phillips (cpan:MATTP) <mattp@cpan.org>
  
  bluefeet - Aran Deltac (cpan:BLUEFEET) <bluefeet@gmail.com>
  
  bubaflub - Bob Kuo (cpan:BUBAFLUB) <bubaflub@cpan.org>
  
  ether = Karen Etheridge (cpan:ETHER) <ether@cpan.org>
  
  =head1 COPYRIGHT
  
  Copyright (c) 2010-2015 the Moo L</AUTHOR> and L</CONTRIBUTORS>
  as listed above.
  
  =head1 LICENSE
  
  This library is free software and may be distributed under the same terms
  as perl itself. See L<http://dev.perl.org/licenses/>.
  
  =cut
MOO

$fatpacked{"Moo/HandleMoose.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'MOO_HANDLEMOOSE';
  package Moo::HandleMoose;
  use Moo::_strictures;
  use Moo::_Utils qw(_getstash);
  use Sub::Quote qw(quotify);
  use Carp qw(croak);
  
  our %TYPE_MAP;
  
  our $SETUP_DONE;
  
  sub import { return if $SETUP_DONE; inject_all(); $SETUP_DONE = 1; }
  
  sub inject_all {
    croak "Can't inflate Moose metaclass with Moo::sification disabled"
      if $Moo::sification::disabled;
    require Class::MOP;
    inject_fake_metaclass_for($_)
      for grep $_ ne 'Moo::Object', keys %Moo::MAKERS;
    inject_fake_metaclass_for($_) for keys %Moo::Role::INFO;
    require Moose::Meta::Method::Constructor;
    @Moo::HandleMoose::FakeConstructor::ISA = 'Moose::Meta::Method::Constructor';
    @Moo::HandleMoose::FakeMeta::ISA = 'Moose::Meta::Method::Meta';
  }
  
  sub maybe_reinject_fake_metaclass_for {
    my ($name) = @_;
    our %DID_INJECT;
    if (delete $DID_INJECT{$name}) {
      unless ($Moo::Role::INFO{$name}) {
        Moo->_constructor_maker_for($name)->install_delayed;
      }
      inject_fake_metaclass_for($name);
    }
  }
  
  sub inject_fake_metaclass_for {
    my ($name) = @_;
    require Class::MOP;
    require Moo::HandleMoose::FakeMetaClass;
    Class::MOP::store_metaclass_by_name(
      $name, bless({ name => $name }, 'Moo::HandleMoose::FakeMetaClass')
    );
    require Moose::Util::TypeConstraints;
    if ($Moo::Role::INFO{$name}) {
      Moose::Util::TypeConstraints::find_or_create_does_type_constraint($name);
    } else {
      Moose::Util::TypeConstraints::find_or_create_isa_type_constraint($name);
    }
  }
  
  {
    package Moo::HandleMoose::FakeConstructor;
  
    sub _uninlined_body { \&Moose::Object::new }
  }
  
  sub inject_real_metaclass_for {
    my ($name) = @_;
    our %DID_INJECT;
    return Class::MOP::get_metaclass_by_name($name) if $DID_INJECT{$name};
    require Moose; require Moo; require Moo::Role; require Scalar::Util;
    require Sub::Defer;
    Class::MOP::remove_metaclass_by_name($name);
    my ($am_role, $am_class, $meta, $attr_specs, $attr_order) = do {
      if (my $info = $Moo::Role::INFO{$name}) {
        my @attr_info = @{$info->{attributes}||[]};
        (1, 0, Moose::Meta::Role->initialize($name),
         { @attr_info },
         [ @attr_info[grep !($_ % 2), 0..$#attr_info] ]
        )
      } elsif ( my $cmaker = Moo->_constructor_maker_for($name) ) {
        my $specs = $cmaker->all_attribute_specs;
        (0, 1, Moose::Meta::Class->initialize($name), $specs,
         [ sort { $specs->{$a}{index} <=> $specs->{$b}{index} } keys %$specs ]
        );
      } else {
         # This codepath is used if $name does not exist in $Moo::MAKERS
         (0, 0, Moose::Meta::Class->initialize($name), {}, [] )
      }
    };
  
    {
      local $DID_INJECT{$name} = 1;
      foreach my $spec (values %$attr_specs) {
        if (my $inflators = delete $spec->{moosify}) {
          $_->($spec) for @$inflators;
        }
      }
  
      my %methods
        = %{($am_role ? 'Moo::Role' : 'Moo')->_concrete_methods_of($name)};
  
      # if stuff gets added afterwards, _maybe_reset_handlemoose should
      # trigger the recreation of the metaclass but we need to ensure the
      # Moo::Role cache is cleared so we don't confuse Moo itself.
      if (my $info = $Moo::Role::INFO{$name}) {
        delete $info->{methods};
      }
  
      # needed to ensure the method body is stable and get things named
      $methods{$_} = Sub::Defer::undefer_sub($methods{$_})
        for
          grep $_ ne 'new',
          keys %methods;
      my @attrs;
      {
        # This local is completely not required for roles but harmless
        local @{_getstash($name)}{keys %methods};
        my %seen_name;
        foreach my $attr_name (@$attr_order) {
          $seen_name{$attr_name} = 1;
          my %spec = %{$attr_specs->{$attr_name}};
          my %spec_map = (
            map { $_->name => $_->init_arg||$_->name }
            (
              (grep { $_->has_init_arg }
                $meta->attribute_metaclass->meta->get_all_attributes),
              grep { exists($_->{init_arg}) ? defined($_->init_arg) : 1 }
              map {
                my $meta = Moose::Util::resolve_metatrait_alias('Attribute', $_)
                            ->meta;
                map $meta->get_attribute($_), $meta->get_attribute_list
              }  @{$spec{traits}||[]}
            )
          );
          # have to hard code this because Moose's role meta-model is lacking
          $spec_map{traits} ||= 'traits';
  
          $spec{is} = 'ro' if $spec{is} eq 'lazy' or $spec{is} eq 'rwp';
          my $coerce = $spec{coerce};
          if (my $isa = $spec{isa}) {
            my $tc = $spec{isa} = do {
              if (my $mapped = $TYPE_MAP{$isa}) {
                my $type = $mapped->();
                unless ( Scalar::Util::blessed($type)
                    && $type->isa("Moose::Meta::TypeConstraint") ) {
                  croak "error inflating attribute '$attr_name' for package '$name': "
                    ."\$TYPE_MAP{$isa} did not return a valid type constraint'";
                }
                $coerce ? $type->create_child_type(name => $type->name) : $type;
              } else {
                Moose::Meta::TypeConstraint->new(
                  constraint => sub { eval { &$isa; 1 } }
                );
              }
            };
            if ($coerce) {
              $tc->coercion(Moose::Meta::TypeCoercion->new)
                ->_compiled_type_coercion($coerce);
              $spec{coerce} = 1;
            }
          } elsif ($coerce) {
            my $attr = quotify($attr_name);
            my $tc = Moose::Meta::TypeConstraint->new(
                      constraint => sub { die "This is not going to work" },
                      inlined => sub {
                          'my $r = $_[42]{'.$attr.'}; $_[42]{'.$attr.'} = 1; $r'
                      },
                    );
            $tc->coercion(Moose::Meta::TypeCoercion->new)
              ->_compiled_type_coercion($coerce);
            $spec{isa} = $tc;
            $spec{coerce} = 1;
          }
          %spec =
            map { $spec_map{$_} => $spec{$_} }
            grep { exists $spec_map{$_} }
            keys %spec;
          push @attrs, $meta->add_attribute($attr_name => %spec);
        }
        foreach my $mouse (do { our %MOUSE; @{$MOUSE{$name}||[]} }) {
          foreach my $attr ($mouse->get_all_attributes) {
            my %spec = %{$attr};
            delete @spec{qw(
              associated_class associated_methods __METACLASS__
              provides curries
            )};
            my $attr_name = delete $spec{name};
            next if $seen_name{$attr_name}++;
            push @attrs, $meta->add_attribute($attr_name => %spec);
          }
        }
      }
      foreach my $meth_name (keys %methods) {
        my $meth_code = $methods{$meth_name};
        $meta->add_method($meth_name, $meth_code);
      }
  
      if ($am_role) {
        my $info = $Moo::Role::INFO{$name};
        $meta->add_required_methods(@{$info->{requires}});
        foreach my $modifier (@{$info->{modifiers}}) {
          my ($type, @args) = @$modifier;
          my $code = pop @args;
          $meta->${\"add_${type}_method_modifier"}($_, $code) for @args;
        }
      }
      elsif ($am_class) {
        foreach my $attr (@attrs) {
          foreach my $method (@{$attr->associated_methods}) {
            $method->{body} = $name->can($method->name);
          }
        }
        bless(
          $meta->find_method_by_name('new'),
          'Moo::HandleMoose::FakeConstructor',
        );
        my $meta_meth;
        if (
          $meta_meth = $meta->find_method_by_name('meta')
          and $meta_meth->body == \&Moo::Object::meta
        ) {
          bless($meta_meth, 'Moo::HandleMoose::FakeMeta');
        }
        # a combination of Moo and Moose may bypass a Moo constructor but still
        # use a Moo DEMOLISHALL.  We need to make sure this is loaded before
        # global destruction.
        require Method::Generate::DemolishAll;
      }
      $meta->add_role(Class::MOP::class_of($_))
        for grep !/\|/ && $_ ne $name, # reject Foo|Bar and same-role-as-self
          keys %{$Moo::Role::APPLIED_TO{$name}}
    }
    $DID_INJECT{$name} = 1;
    $meta;
  }
  
  1;
MOO_HANDLEMOOSE

$fatpacked{"Moo/HandleMoose/FakeMetaClass.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'MOO_HANDLEMOOSE_FAKEMETACLASS';
  package Moo::HandleMoose::FakeMetaClass;
  use Moo::_strictures;
  use Carp ();
  BEGIN { our @CARP_NOT = qw(Moo::HandleMoose) }
  
  sub DESTROY { }
  
  sub AUTOLOAD {
    my ($meth) = (our $AUTOLOAD =~ /([^:]+)$/);
    my $self = shift;
    Carp::croak "Can't call $meth without object instance"
      if !ref $self;
    Carp::croak "Can't inflate Moose metaclass with Moo::sification disabled"
      if $Moo::sification::disabled;
    require Moo::HandleMoose;
    Moo::HandleMoose::inject_real_metaclass_for($self->{name})->$meth(@_)
  }
  sub can {
    my $self = shift;
    return $self->SUPER::can(@_)
      if !ref $self or $Moo::sification::disabled;
    require Moo::HandleMoose;
    Moo::HandleMoose::inject_real_metaclass_for($self->{name})->can(@_)
  }
  sub isa {
    my $self = shift;
    return $self->SUPER::isa(@_)
      if !ref $self or $Moo::sification::disabled;
    require Moo::HandleMoose;
    Moo::HandleMoose::inject_real_metaclass_for($self->{name})->isa(@_)
  }
  sub make_immutable { $_[0] }
  
  1;
MOO_HANDLEMOOSE_FAKEMETACLASS

$fatpacked{"Moo/HandleMoose/_TypeMap.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'MOO_HANDLEMOOSE__TYPEMAP';
  package Moo::HandleMoose::_TypeMap;
  use Moo::_strictures;
  
  package
    Moo::HandleMoose;
  our %TYPE_MAP;
  
  package Moo::HandleMoose::_TypeMap;
  
  use Scalar::Util ();
  use Config;
  
  our %WEAK_TYPES;
  
  sub _str_to_ref {
    my $in = shift;
    return $in
      if ref $in;
  
    if ($in =~ /(?:^|=)([A-Z]+)\(0x([0-9a-zA-Z]+)\)$/) {
      my $type = $1;
      my $id = do { no warnings 'portable'; hex "$2" };
      require B;
      my $sv = bless \$id, 'B::SV';
      my $ref = eval { $sv->object_2svref };
      if (!defined $ref or Scalar::Util::reftype($ref) ne $type) {
        die <<'END_ERROR';
  Moo initialization encountered types defined in a parent thread - ensure that
  Moo is require()d before any further thread spawns following a type definition.
  END_ERROR
      }
      return $ref;
    }
    return $in;
  }
  
  sub TIEHASH  { bless {}, $_[0] }
  
  sub STORE {
    my ($self, $key, $value) = @_;
    my $type = _str_to_ref($key);
    $WEAK_TYPES{$type} = $type;
    Scalar::Util::weaken($WEAK_TYPES{$type})
      if ref $type;
    $self->{$key} = $value;
  }
  
  sub FETCH    { $_[0]->{$_[1]} }
  sub FIRSTKEY { my $a = scalar keys %{$_[0]}; each %{$_[0]} }
  sub NEXTKEY  { each %{$_[0]} }
  sub EXISTS   { exists $_[0]->{$_[1]} }
  sub DELETE   { delete $_[0]->{$_[1]} }
  sub CLEAR    { %{$_[0]} = () }
  sub SCALAR   { scalar %{$_[0]} }
  
  sub CLONE {
    my @types = map {
      defined $WEAK_TYPES{$_} ? ($WEAK_TYPES{$_} => $TYPE_MAP{$_}) : ()
    } keys %TYPE_MAP;
    %WEAK_TYPES = ();
    %TYPE_MAP = @types;
  }
  
  sub DESTROY {
    my %types = %{$_[0]};
    untie %TYPE_MAP;
    %TYPE_MAP = %types;
  }
  
  if ($Config{useithreads}) {
    my @types = %TYPE_MAP;
    tie %TYPE_MAP, __PACKAGE__;
    %TYPE_MAP = @types;
  }
  
  1;
MOO_HANDLEMOOSE__TYPEMAP

$fatpacked{"Moo/Object.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'MOO_OBJECT';
  package Moo::Object;
  
  use Moo::_strictures;
  use Carp ();
  
  our %NO_BUILD;
  our %NO_DEMOLISH;
  our $BUILD_MAKER;
  our $DEMOLISH_MAKER;
  
  sub new {
    my $class = shift;
    unless (exists $NO_DEMOLISH{$class}) {
      unless ($NO_DEMOLISH{$class} = !$class->can('DEMOLISH')) {
        ($DEMOLISH_MAKER ||= do {
          require Method::Generate::DemolishAll;
          Method::Generate::DemolishAll->new
        })->generate_method($class);
      }
    }
    my $proto = $class->BUILDARGS(@_);
    $NO_BUILD{$class} and
      return bless({}, $class);
    $NO_BUILD{$class} = !$class->can('BUILD') unless exists $NO_BUILD{$class};
    $NO_BUILD{$class}
      ? bless({}, $class)
      : bless({}, $class)->BUILDALL($proto);
  }
  
  # Inlined into Method::Generate::Constructor::_generate_args() - keep in sync
  sub BUILDARGS {
    my $class = shift;
    scalar @_ == 1
      ? ref $_[0] eq 'HASH'
        ? { %{ $_[0] } }
        : Carp::croak("Single parameters to new() must be a HASH ref"
            . " data => ". $_[0])
      : @_ % 2
        ? Carp::croak("The new() method for $class expects a hash reference or a"
            . " key/value list. You passed an odd number of arguments")
        : {@_}
    ;
  }
  
  sub BUILDALL {
    my $self = shift;
    $self->${\(($BUILD_MAKER ||= do {
      require Method::Generate::BuildAll;
      Method::Generate::BuildAll->new
    })->generate_method(ref($self)))}(@_);
  }
  
  sub DEMOLISHALL {
    my $self = shift;
    $self->${\(($DEMOLISH_MAKER ||= do {
      require Method::Generate::DemolishAll;
      Method::Generate::DemolishAll->new
    })->generate_method(ref($self)))}(@_);
  }
  
  sub does {
    return !!0
      unless ($INC{'Moose/Role.pm'} || $INC{'Role/Tiny.pm'});
    require Moo::Role;
    my $does = Moo::Role->can("does_role");
    { no warnings 'redefine'; *does = $does }
    goto &$does;
  }
  
  # duplicated in Moo::Role
  sub meta {
    require Moo::HandleMoose::FakeMetaClass;
    my $class = ref($_[0])||$_[0];
    bless({ name => $class }, 'Moo::HandleMoose::FakeMetaClass');
  }
  
  1;
MOO_OBJECT

$fatpacked{"Moo/Role.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'MOO_ROLE';
  package Moo::Role;
  
  use Moo::_strictures;
  use Moo::_Utils qw(
    _getglob
    _getstash
    _install_coderef
    _install_modifier
    _load_module
    _name_coderef
    _set_loaded
    _unimport_coderefs
  );
  use Carp qw(croak);
  use Role::Tiny ();
  BEGIN { our @ISA = qw(Role::Tiny) }
  BEGIN {
    our @CARP_NOT = qw(
      Method::Generate::Accessor
      Method::Generate::Constructor
      Moo::sification
      Moo::_Utils
    );
  }
  
  our $VERSION = '2.003004';
  $VERSION =~ tr/_//d;
  
  require Moo::sification;
  Moo::sification->import;
  
  BEGIN {
      *INFO = \%Role::Tiny::INFO;
      *APPLIED_TO = \%Role::Tiny::APPLIED_TO;
      *COMPOSED = \%Role::Tiny::COMPOSED;
      *ON_ROLE_CREATE = \@Role::Tiny::ON_ROLE_CREATE;
  }
  
  our %INFO;
  our %APPLIED_TO;
  our %APPLY_DEFAULTS;
  our %COMPOSED;
  our @ON_ROLE_CREATE;
  
  sub _install_tracked {
    my ($target, $name, $code) = @_;
    $INFO{$target}{exports}{$name} = $code;
    _install_coderef "${target}::${name}" => "Moo::Role::${name}" => $code;
  }
  
  sub import {
    my $target = caller;
    if ($Moo::MAKERS{$target} and $Moo::MAKERS{$target}{is_class}) {
      croak "Cannot import Moo::Role into a Moo class";
    }
    _set_loaded(caller);
    goto &Role::Tiny::import;
  }
  
  sub _install_subs {
    my ($me, $target) = @_;
    _install_tracked $target => has => sub {
      my $name_proto = shift;
      my @name_proto = ref $name_proto eq 'ARRAY' ? @$name_proto : $name_proto;
      if (@_ % 2 != 0) {
        croak("Invalid options for " . join(', ', map "'$_'", @name_proto)
          . " attribute(s): even number of arguments expected, got " . scalar @_)
      }
      my %spec = @_;
      foreach my $name (@name_proto) {
        my $spec_ref = @name_proto > 1 ? +{%spec} : \%spec;
        ($INFO{$target}{accessor_maker} ||= do {
          require Method::Generate::Accessor;
          Method::Generate::Accessor->new
        })->generate_method($target, $name, $spec_ref);
        push @{$INFO{$target}{attributes}||=[]}, $name, $spec_ref;
        $me->_maybe_reset_handlemoose($target);
      }
    };
    # install before/after/around subs
    foreach my $type (qw(before after around)) {
      _install_tracked $target => $type => sub {
        push @{$INFO{$target}{modifiers}||=[]}, [ $type => @_ ];
        $me->_maybe_reset_handlemoose($target);
      };
    }
    _install_tracked $target => requires => sub {
      push @{$INFO{$target}{requires}||=[]}, @_;
      $me->_maybe_reset_handlemoose($target);
    };
    _install_tracked $target => with => sub {
      $me->apply_roles_to_package($target, @_);
      $me->_maybe_reset_handlemoose($target);
    };
    *{_getglob("${target}::meta")} = $me->can('meta');
  }
  
  push @ON_ROLE_CREATE, sub {
    my $target = shift;
    if ($INC{'Moo/HandleMoose.pm'} && !$Moo::sification::disabled) {
      Moo::HandleMoose::inject_fake_metaclass_for($target);
    }
  };
  
  # duplicate from Moo::Object
  sub meta {
    require Moo::HandleMoose::FakeMetaClass;
    my $class = ref($_[0])||$_[0];
    bless({ name => $class }, 'Moo::HandleMoose::FakeMetaClass');
  }
  
  sub unimport {
    my $target = caller;
    _unimport_coderefs($target, $INFO{$target});
  }
  
  sub _maybe_reset_handlemoose {
    my ($class, $target) = @_;
    if ($INC{'Moo/HandleMoose.pm'} && !$Moo::sification::disabled) {
      Moo::HandleMoose::maybe_reinject_fake_metaclass_for($target);
    }
  }
  
  sub methods_provided_by {
    my ($self, $role) = @_;
    _load_module($role);
    $self->_inhale_if_moose($role);
    croak "${role} is not a Moo::Role" unless $self->is_role($role);
    return $self->SUPER::methods_provided_by($role);
  }
  
  sub is_role {
    my ($self, $role) = @_;
    $self->_inhale_if_moose($role);
    $self->SUPER::is_role($role);
  }
  
  sub _inhale_if_moose {
    my ($self, $role) = @_;
    my $meta;
    if (!$self->SUPER::is_role($role)
        and (
          $INC{"Moose.pm"}
          and $meta = Class::MOP::class_of($role)
          and ref $meta ne 'Moo::HandleMoose::FakeMetaClass'
          and $meta->isa('Moose::Meta::Role')
        )
        or (
          Mouse::Util->can('find_meta')
          and $meta = Mouse::Util::find_meta($role)
          and $meta->isa('Mouse::Meta::Role')
       )
    ) {
      my $is_mouse = $meta->isa('Mouse::Meta::Role');
      $INFO{$role}{methods} = {
        map +($_ => $role->can($_)),
          grep $role->can($_),
          grep !($is_mouse && $_ eq 'meta'),
          grep !$meta->get_method($_)->isa('Class::MOP::Method::Meta'),
            $meta->get_method_list
      };
      $APPLIED_TO{$role} = {
        map +($_->name => 1), $meta->calculate_all_roles
      };
      $INFO{$role}{requires} = [ $meta->get_required_method_list ];
      $INFO{$role}{attributes} = [
        map +($_ => do {
          my $attr = $meta->get_attribute($_);
          my $spec = { %{ $is_mouse ? $attr : $attr->original_options } };
  
          if ($spec->{isa}) {
            require Sub::Quote;
  
            my $get_constraint = do {
              my $pkg = $is_mouse
                          ? 'Mouse::Util::TypeConstraints'
                          : 'Moose::Util::TypeConstraints';
              _load_module($pkg);
              $pkg->can('find_or_create_isa_type_constraint');
            };
  
            my $tc = $get_constraint->($spec->{isa});
            my $check = $tc->_compiled_type_constraint;
            my $tc_var = '$_check_for_'.Sub::Quote::sanitize_identifier($tc->name);
  
            $spec->{isa} = Sub::Quote::quote_sub(
              qq{
                &${tc_var} or Carp::croak "Type constraint failed for \$_[0]"
              },
              { $tc_var => \$check },
              {
                package => $role,
              },
            );
  
            if ($spec->{coerce}) {
  
               # Mouse has _compiled_type_coercion straight on the TC object
               $spec->{coerce} = $tc->${\(
                 $tc->can('coercion')||sub { $_[0] }
               )}->_compiled_type_coercion;
            }
          }
          $spec;
        }), $meta->get_attribute_list
      ];
      my $mods = $INFO{$role}{modifiers} = [];
      foreach my $type (qw(before after around)) {
        # Mouse pokes its own internals so we have to fall back to doing
        # the same thing in the absence of the Moose API method
        my $map = $meta->${\(
          $meta->can("get_${type}_method_modifiers_map")
          or sub { shift->{"${type}_method_modifiers"} }
        )};
        foreach my $method (keys %$map) {
          foreach my $mod (@{$map->{$method}}) {
            push @$mods, [ $type => $method => $mod ];
          }
        }
      }
      $INFO{$role}{inhaled_from_moose} = 1;
      $INFO{$role}{is_role} = 1;
    }
  }
  
  sub _maybe_make_accessors {
    my ($self, $target, $role) = @_;
    my $m;
    if ($INFO{$role} && $INFO{$role}{inhaled_from_moose}
        or $INC{"Moo.pm"}
        and $m = Moo->_accessor_maker_for($target)
        and ref($m) ne 'Method::Generate::Accessor') {
      $self->_make_accessors($target, $role);
    }
  }
  
  sub _make_accessors_if_moose {
    my ($self, $target, $role) = @_;
    if ($INFO{$role} && $INFO{$role}{inhaled_from_moose}) {
      $self->_make_accessors($target, $role);
    }
  }
  
  sub _make_accessors {
    my ($self, $target, $role) = @_;
    my $acc_gen = ($Moo::MAKERS{$target}{accessor} ||= do {
      require Method::Generate::Accessor;
      Method::Generate::Accessor->new
    });
    my $con_gen = $Moo::MAKERS{$target}{constructor};
    my @attrs = @{$INFO{$role}{attributes}||[]};
    while (my ($name, $spec) = splice @attrs, 0, 2) {
      # needed to ensure we got an index for an arrayref based generator
      if ($con_gen) {
        $spec = $con_gen->all_attribute_specs->{$name};
      }
      $acc_gen->generate_method($target, $name, $spec);
    }
  }
  
  sub _undefer_subs {
    my ($self, $target, $role) = @_;
    if ($INC{'Sub/Defer.pm'}) {
      Sub::Defer::undefer_package($role);
    }
  }
  
  sub role_application_steps {
    qw(_handle_constructor _undefer_subs _maybe_make_accessors),
      $_[0]->SUPER::role_application_steps;
  }
  
  sub apply_roles_to_package {
    my ($me, $to, @roles) = @_;
    foreach my $role (@roles) {
      _load_module($role);
      $me->_inhale_if_moose($role);
      croak "${role} is not a Moo::Role" unless $me->is_role($role);
    }
    $me->SUPER::apply_roles_to_package($to, @roles);
  }
  
  sub apply_single_role_to_package {
    my ($me, $to, $role) = @_;
    _load_module($role);
    $me->_inhale_if_moose($role);
    croak "${role} is not a Moo::Role" unless $me->is_role($role);
    $me->SUPER::apply_single_role_to_package($to, $role);
  }
  
  sub create_class_with_roles {
    my ($me, $superclass, @roles) = @_;
  
    my ($new_name, $compose_name) = $me->_composite_name($superclass, @roles);
  
    return $new_name if $COMPOSED{class}{$new_name};
  
    foreach my $role (@roles) {
      _load_module($role);
      $me->_inhale_if_moose($role);
      croak "${role} is not a Moo::Role" unless $me->is_role($role);
    }
  
    my $m;
    if ($INC{"Moo.pm"}
        and $m = Moo->_accessor_maker_for($superclass)
        and ref($m) ne 'Method::Generate::Accessor') {
      # old fashioned way time.
      @{*{_getglob("${new_name}::ISA")}{ARRAY}} = ($superclass);
      $Moo::MAKERS{$new_name} = {is_class => 1};
      $me->apply_roles_to_package($new_name, @roles);
    }
    else {
      $me->SUPER::create_class_with_roles($superclass, @roles);
      $Moo::MAKERS{$new_name} = {is_class => 1};
      $me->_handle_constructor($new_name, $_) for @roles;
    }
  
    if ($INC{'Moo/HandleMoose.pm'} && !$Moo::sification::disabled) {
      Moo::HandleMoose::inject_fake_metaclass_for($new_name);
    }
    $COMPOSED{class}{$new_name} = 1;
    _set_loaded($new_name, (caller)[1]);
    return $new_name;
  }
  
  sub apply_roles_to_object {
    my ($me, $object, @roles) = @_;
    my $new = $me->SUPER::apply_roles_to_object($object, @roles);
    my $class = ref $new;
    _set_loaded($class, (caller)[1]);
  
    my $apply_defaults = exists $APPLY_DEFAULTS{$class} ? $APPLY_DEFAULTS{$class}
      : $APPLY_DEFAULTS{$class} = do {
      my %attrs = map { @{$INFO{$_}{attributes}||[]} } @roles;
  
      if ($INC{'Moo.pm'}
          and keys %attrs
          and my $con_gen = Moo->_constructor_maker_for($class)
          and my $m = Moo->_accessor_maker_for($class)) {
  
        my $specs = $con_gen->all_attribute_specs;
  
        my %captures;
        my $code = join('',
          ( map {
            my $name = $_;
            my $spec = $specs->{$name};
            if ($m->has_eager_default($name, $spec)) {
              my ($has, $has_cap)
                = $m->generate_simple_has('$_[0]', $name, $spec);
              my ($set, $pop_cap)
                = $m->generate_use_default('$_[0]', $name, $spec, $has);
  
              @captures{keys %$has_cap, keys %$pop_cap}
                = (values %$has_cap, values %$pop_cap);
              "($set),";
            }
            else {
              ();
            }
          } sort keys %attrs ),
        );
        if ($code) {
          require Sub::Quote;
          Sub::Quote::quote_sub(
            "${class}::_apply_defaults",
            "no warnings 'void';\n$code",
            \%captures,
            {
              package => $class,
              no_install => 1,
            }
          );
        }
        else {
          0;
        }
      }
      else {
        0;
      }
    };
    if ($apply_defaults) {
      local $Carp::Internal{+__PACKAGE__} = 1;
      local $Carp::Internal{$class} = 1;
      $new->$apply_defaults;
    }
    return $new;
  }
  
  sub _composable_package_for {
    my ($self, $role) = @_;
    my $composed_name = 'Role::Tiny::_COMPOSABLE::'.$role;
    return $composed_name if $COMPOSED{role}{$composed_name};
    $self->_make_accessors_if_moose($composed_name, $role);
    $self->SUPER::_composable_package_for($role);
  }
  
  sub _install_single_modifier {
    my ($me, @args) = @_;
    _install_modifier(@args);
  }
  
  sub _install_does {
      my ($me, $to) = @_;
  
      # If Role::Tiny actually installed the DOES, give it a name
      my $new = $me->SUPER::_install_does($to) or return;
      return _name_coderef("${to}::DOES", $new);
  }
  
  sub does_role {
    my ($proto, $role) = @_;
    return 1
      if Role::Tiny::does_role($proto, $role);
    my $meta;
    if ($INC{'Moose.pm'}
        and $meta = Class::MOP::class_of($proto)
        and ref $meta ne 'Moo::HandleMoose::FakeMetaClass'
        and $meta->can('does_role')
    ) {
      return $meta->does_role($role);
    }
    return 0;
  }
  
  sub _handle_constructor {
    my ($me, $to, $role) = @_;
    my $attr_info = $INFO{$role} && $INFO{$role}{attributes};
    return unless $attr_info && @$attr_info;
    my $info = $INFO{$to};
    my $con = $INC{"Moo.pm"} && Moo->_constructor_maker_for($to);
    my %existing
      = $info ? @{$info->{attributes} || []}
      : $con  ? %{$con->all_attribute_specs || {}}
      : ();
  
    my @attr_info =
      map { @{$attr_info}[$_, $_+1] }
      grep { ! $existing{$attr_info->[$_]} }
      map { 2 * $_ } 0..@$attr_info/2-1;
  
    if ($info) {
      push @{$info->{attributes}||=[]}, @attr_info;
    }
    elsif ($con) {
      # shallow copy of the specs since the constructor will assign an index
      $con->register_attribute_specs(map ref() ? { %$_ } : $_, @attr_info);
    }
  }
  
  1;
  __END__
  
  =head1 NAME
  
  Moo::Role - Minimal Object Orientation support for Roles
  
  =head1 SYNOPSIS
  
    package My::Role;
  
    use Moo::Role;
    use strictures 2;
  
    sub foo { ... }
  
    sub bar { ... }
  
    has baz => (
      is => 'ro',
    );
  
    1;
  
  And elsewhere:
  
    package Some::Class;
  
    use Moo;
    use strictures 2;
  
    # bar gets imported, but not foo
    with('My::Role');
  
    sub foo { ... }
  
    1;
  
  =head1 DESCRIPTION
  
  C<Moo::Role> builds upon L<Role::Tiny>, so look there for most of the
  documentation on how this works.  The main addition here is extra bits to make
  the roles more "Moosey;" which is to say, it adds L</has>.
  
  =head1 IMPORTED SUBROUTINES
  
  See L<Role::Tiny/IMPORTED SUBROUTINES> for all the other subroutines that are
  imported by this module.
  
  =head2 has
  
    has attr => (
      is => 'ro',
    );
  
  Declares an attribute for the class to be composed into.  See
  L<Moo/has> for all options.
  
  =head1 CLEANING UP IMPORTS
  
  L<Moo::Role> cleans up its own imported methods and any imports
  declared before the C<use Moo::Role> statement automatically.
  Anything imported after C<use Moo::Role> will be composed into
  consuming packages.  A package that consumes this role:
  
    package My::Role::ID;
  
    use Digest::MD5 qw(md5_hex);
    use Moo::Role;
    use Digest::SHA qw(sha1_hex);
  
    requires 'name';
  
    sub as_md5  { my ($self) = @_; return md5_hex($self->name);  }
    sub as_sha1 { my ($self) = @_; return sha1_hex($self->name); }
  
    1;
  
  ..will now have a C<< $self->sha1_hex() >> method available to it
  that probably does not do what you expect.  On the other hand, a call
  to C<< $self->md5_hex() >> will die with the helpful error message:
  C<Can't locate object method "md5_hex">.
  
  See L<Moo/"CLEANING UP IMPORTS"> for more details.
  
  =head1 SUPPORT
  
  See L<Moo> for support and contact information.
  
  =head1 AUTHORS
  
  See L<Moo> for authors.
  
  =head1 COPYRIGHT AND LICENSE
  
  See L<Moo> for the copyright and license.
  
  =cut
MOO_ROLE

$fatpacked{"Moo/_Utils.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'MOO__UTILS';
  package Moo::_Utils;
  use Moo::_strictures;
  
  {
    no strict 'refs';
    sub _getglob { \*{$_[0]} }
    sub _getstash { \%{"$_[0]::"} }
  }
  
  BEGIN {
    my ($su, $sn);
    $su = $INC{'Sub/Util.pm'} && defined &Sub::Util::set_subname
      or $sn = $INC{'Sub/Name.pm'}
      or $su = eval { require Sub::Util; } && defined &Sub::Util::set_subname
      or $sn = eval { require Sub::Name; };
  
    *_subname = $su ? \&Sub::Util::set_subname
              : $sn ? \&Sub::Name::subname
              : sub { $_[1] };
    *_CAN_SUBNAME = ($su || $sn) ? sub(){1} : sub(){0};
  }
  
  use Module::Runtime qw(use_package_optimistically module_notional_filename);
  
  use Devel::GlobalDestruction ();
  use Exporter qw(import);
  use Config;
  use Carp qw(croak);
  
  our @EXPORT = qw(
      _getglob _install_modifier _load_module _maybe_load_module
      _getstash _install_coderef _name_coderef
      _unimport_coderefs _set_loaded
  );
  
  sub _install_modifier {
    my ($into, $type, $name, $code) = @_;
  
    if ($INC{'Sub/Defer.pm'} and my $to_modify = $into->can($name)) { # CMM will throw for us if not
      Sub::Defer::undefer_sub($to_modify);
    }
  
    require Class::Method::Modifiers;
    Class::Method::Modifiers::install_modifier(@_);
  }
  
  sub _load_module {
    my $module = $_[0];
    my $file = eval { module_notional_filename($module) } or croak $@;
    use_package_optimistically($module);
    return 1
      if $INC{$file};
    my $error = $@ || "Can't locate $file";
  
    # can't just ->can('can') because a sub-package Foo::Bar::Baz
    # creates a 'Baz::' key in Foo::Bar's symbol table
    my $stash = _getstash($module)||{};
    return 1 if grep +(ref($_) || *$_{CODE}), values %$stash;
    return 1
      if $INC{"Moose.pm"} && Class::MOP::class_of($module)
      or Mouse::Util->can('find_meta') && Mouse::Util::find_meta($module);
    croak $error;
  }
  
  our %MAYBE_LOADED;
  sub _maybe_load_module {
    my $module = $_[0];
    return $MAYBE_LOADED{$module}
      if exists $MAYBE_LOADED{$module};
    if(! eval { use_package_optimistically($module) }) {
      warn "$module exists but failed to load with error: $@";
    }
    elsif ( $INC{module_notional_filename($module)} ) {
      return $MAYBE_LOADED{$module} = 1;
    }
    return $MAYBE_LOADED{$module} = 0;
  }
  
  sub _set_loaded {
    $INC{Module::Runtime::module_notional_filename($_[0])} ||= $_[1];
  }
  
  sub _install_coderef {
    my ($glob, $code) = (_getglob($_[0]), _name_coderef(@_));
    no warnings 'redefine';
    if (*{$glob}{CODE}) {
      *{$glob} = $code;
    }
    # perl will sometimes warn about mismatched prototypes coming from the
    # inheritance cache, so disable them if we aren't redefining a sub
    else {
      no warnings 'prototype';
      *{$glob} = $code;
    }
  }
  
  sub _name_coderef {
    shift if @_ > 2; # three args is (target, name, sub)
    _CAN_SUBNAME ? _subname(@_) : $_[1];
  }
  
  sub _unimport_coderefs {
    my ($target, $info) = @_;
    return unless $info and my $exports = $info->{exports};
    my %rev = reverse %$exports;
    my $stash = _getstash($target);
    foreach my $name (keys %$exports) {
      if ($stash->{$name} and defined(&{$stash->{$name}})) {
        if ($rev{$target->can($name)}) {
          my $old = delete $stash->{$name};
          my $full_name = join('::',$target,$name);
          # Copy everything except the code slot back into place (e.g. $has)
          foreach my $type (qw(SCALAR HASH ARRAY IO)) {
            next unless defined(*{$old}{$type});
            no strict 'refs';
            *$full_name = *{$old}{$type};
          }
        }
      }
    }
  }
  
  if ($Config{useithreads}) {
    require Moo::HandleMoose::_TypeMap;
  }
  
  1;
MOO__UTILS

$fatpacked{"Moo/_mro.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'MOO__MRO';
  package Moo::_mro;
  use Moo::_strictures;
  
  if ("$]" >= 5.010_000) {
    require mro;
  } else {
    require MRO::Compat;
  }
  
  1;
MOO__MRO

$fatpacked{"Moo/_strictures.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'MOO__STRICTURES';
  package Moo::_strictures;
  use strict;
  use warnings;
  
  sub import {
    if ($ENV{MOO_FATAL_WARNINGS}) {
      require strictures;
      strictures->VERSION(2);
      @_ = ('strictures');
      goto &strictures::import;
    }
    else {
      strict->import;
      warnings->import;
      warnings->unimport('once');
    }
  }
  
  1;
MOO__STRICTURES

$fatpacked{"Moo/sification.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'MOO_SIFICATION';
  package Moo::sification;
  
  use Moo::_strictures;
  no warnings 'once';
  use Devel::GlobalDestruction qw(in_global_destruction);
  use Carp qw(croak);
  BEGIN { our @CARP_NOT = qw(Moo::HandleMoose) }
  
  sub unimport {
    croak "Can't disable Moo::sification after inflation has been done"
      if $Moo::HandleMoose::SETUP_DONE;
    our $disabled = 1;
  }
  
  sub Moo::HandleMoose::AuthorityHack::DESTROY {
    unless (our $disabled or in_global_destruction) {
      require Moo::HandleMoose;
      Moo::HandleMoose->import;
    }
  }
  
  sub import {
    return
      if our $setup_done;
    if ($INC{"Moose.pm"}) {
      require Moo::HandleMoose;
      Moo::HandleMoose->import;
    } else {
      $Moose::AUTHORITY = bless({}, 'Moo::HandleMoose::AuthorityHack');
    }
    $setup_done = 1;
  }
  
  1;
MOO_SIFICATION

$fatpacked{"Sub/Defer.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'SUB_DEFER';
  package Sub::Defer;
  use strict;
  use warnings;
  use Exporter qw(import);
  use Scalar::Util qw(weaken);
  use Carp qw(croak);
  
  our $VERSION = '2.006003';
  $VERSION = eval $VERSION;
  
  our @EXPORT = qw(defer_sub undefer_sub undefer_all);
  our @EXPORT_OK = qw(undefer_package defer_info);
  
  sub _getglob { no strict 'refs'; \*{$_[0]} }
  
  BEGIN {
    my $no_subname;
    *_subname
      = defined &Sub::Util::set_subname ? \&Sub::Util::set_subname
      : defined &Sub::Name::subname     ? \&Sub::Name::subname
      : (eval { require Sub::Util } && defined &Sub::Util::set_subname) ? \&Sub::Util::set_subname
      : (eval { require Sub::Name } && defined &Sub::Name::subname    ) ? \&Sub::Name::subname
      : ($no_subname = 1, sub { $_[1] });
    *_CAN_SUBNAME = $no_subname ? sub(){0} : sub(){1};
  }
  
  sub _name_coderef {
    shift if @_ > 2; # three args is (target, name, sub)
    _CAN_SUBNAME ? _subname(@_) : $_[1];
  }
  
  sub _install_coderef {
    my ($glob, $code) = (_getglob($_[0]), _name_coderef(@_));
    no warnings 'redefine';
    if (*{$glob}{CODE}) {
      *{$glob} = $code;
    }
    # perl will sometimes warn about mismatched prototypes coming from the
    # inheritance cache, so disable them if we aren't redefining a sub
    else {
      no warnings 'prototype';
      *{$glob} = $code;
    }
  }
  
  # We are dealing with three subs.  The first is the generator sub.  It is
  # provided by the user, so we cannot modify it.  When called, it generates the
  # undeferred sub.  This is also created, so it also cannot be modified.  These
  # are wrapped in a third sub.  The deferred sub is generated by us, and when
  # called it uses the generator sub to create the undeferred sub.  If it is a
  # named sub, it is installed in the symbol table, usually overwriting the
  # deferred sub.  From then on, the deferred sub will goto the undeferred sub
  # if it is called.
  #
  # In %DEFERRED we store array refs with information about these subs.  The key
  # is the stringified subref.  We have a CLONE method to fix this up in the
  # case of threading to deal with changing refaddrs.  The arrayrefs contain:
  #
  # 0. fully qualified sub name (or undef)
  # 1. generator sub
  # 2. options (attributes)
  # 3. scalar ref to undeferred sub (inner reference weakened)
  # 4. deferred sub (deferred only)
  # 5. info arrayref for undeferred sub (deferred only, after undefer)
  #
  # The deferred sub contains a strong reference to its info arrayref, and the
  # undeferred.
  
  our %DEFERRED;
  
  sub undefer_sub {
    my ($deferred) = @_;
    my $info = $DEFERRED{$deferred} or return $deferred;
    my ($target, $maker, $options, $undeferred_ref, $deferred_sub) = @$info;
  
    if (!(
      $deferred_sub && $deferred eq $deferred_sub
      || ${$undeferred_ref} && $deferred eq ${$undeferred_ref}
    )) {
      return $deferred;
    }
  
    return ${$undeferred_ref}
      if ${$undeferred_ref};
    ${$undeferred_ref} = my $made = $maker->();
  
    # make sure the method slot has not changed since deferral time
    if (defined($target) && $deferred eq *{_getglob($target)}{CODE}||'') {
      no warnings 'redefine';
  
      # I believe $maker already evals with the right package/name, so that
      # _install_coderef calls are not necessary --ribasushi
      *{_getglob($target)} = $made;
    }
    my $undefer_info = [ $target, $maker, $options, $undeferred_ref ];
    $info->[5] = $DEFERRED{$made} = $undefer_info;
    weaken ${$undefer_info->[3]};
  
    return $made;
  }
  
  sub undefer_all {
    undefer_sub($_) for keys %DEFERRED;
    return;
  }
  
  sub undefer_package {
    my $package = shift;
    undefer_sub($_)
      for grep {
        my $name = $DEFERRED{$_} && $DEFERRED{$_}[0];
        $name && $name =~ /^${package}::[^:]+$/
      } keys %DEFERRED;
    return;
  }
  
  sub defer_info {
    my ($deferred) = @_;
    my $info = $DEFERRED{$deferred||''} or return undef;
  
    my ($target, $maker, $options, $undeferred_ref, $deferred_sub) = @$info;
    if (!(
      $deferred_sub && $deferred eq $deferred_sub
      || ${$undeferred_ref} && $deferred eq ${$undeferred_ref}
    )) {
      delete $DEFERRED{$deferred};
      return undef;
    }
    [
      $target, $maker, $options,
      ( $undeferred_ref && $$undeferred_ref ? $$undeferred_ref : ()),
    ];
  }
  
  sub defer_sub {
    my ($target, $maker, $options) = @_;
    my $package;
    my $subname;
    ($package, $subname) = $target =~ /^(.*)::([^:]+)$/
      or croak "$target is not a fully qualified sub name!"
      if $target;
    $package ||= $options && $options->{package} || caller;
    my @attributes = @{$options && $options->{attributes} || []};
    if (@attributes) {
      /\A\w+(?:\(.*\))?\z/s || croak "invalid attribute $_"
        for @attributes;
    }
    my $deferred;
    my $undeferred;
    my $deferred_info = [ $target, $maker, $options, \$undeferred ];
    if (@attributes || $target && !_CAN_SUBNAME) {
      my $code
        =  q[#line ].(__LINE__+2).q[ "].__FILE__.qq["\n]
        . qq[package $package;\n]
        . ($target ? "sub $subname" : '+sub') . join('', map " :$_", @attributes)
        . q[ {
          package Sub::Defer;
          # uncoverable subroutine
          # uncoverable statement
          $undeferred ||= undefer_sub($deferred_info->[4]);
          goto &$undeferred; # uncoverable statement
          $undeferred; # fake lvalue return
        }]."\n"
        . ($target ? "\\&$subname" : '');
      my $e;
      $deferred = do {
        no warnings qw(redefine closure);
        local $@;
        eval $code or $e = $@; # uncoverable branch true
      };
      die $e if defined $e; # uncoverable branch true
    }
    else {
      # duplicated from above
      $deferred = sub {
        $undeferred ||= undefer_sub($deferred_info->[4]);
        goto &$undeferred;
      };
      _install_coderef($target, $deferred)
        if $target;
    }
    weaken($deferred_info->[4] = $deferred);
    weaken($DEFERRED{$deferred} = $deferred_info);
    return $deferred;
  }
  
  sub CLONE {
    %DEFERRED = map {
      defined $_ ? (
          $_->[4] ? ($_->[4] => $_)
        : ($_->[3] && ${$_->[3]}) ? (${$_->[3]} => $_)
        : ()
      ) : ()
    } values %DEFERRED;
  }
  
  1;
  __END__
  
  =head1 NAME
  
  Sub::Defer - Defer generation of subroutines until they are first called
  
  =head1 SYNOPSIS
  
   use Sub::Defer;
  
   my $deferred = defer_sub 'Logger::time_since_first_log' => sub {
      my $t = time;
      sub { time - $t };
   };
  
    Logger->time_since_first_log; # returns 0 and replaces itself
    Logger->time_since_first_log; # returns time - $t
  
  =head1 DESCRIPTION
  
  These subroutines provide the user with a convenient way to defer creation of
  subroutines and methods until they are first called.
  
  =head1 SUBROUTINES
  
  =head2 defer_sub
  
   my $coderef = defer_sub $name => sub { ... }, \%options;
  
  This subroutine returns a coderef that encapsulates the provided sub - when
  it is first called, the provided sub is called and is -itself- expected to
  return a subroutine which will be goto'ed to on subsequent calls.
  
  If a name is provided, this also installs the sub as that name - and when
  the subroutine is undeferred will re-install the final version for speed.
  
  Exported by default.
  
  =head3 Options
  
  A hashref of options can optionally be specified.
  
  =over 4
  
  =item package
  
  The package to generate the sub in.  Will be overridden by a fully qualified
  C<$name> option.  If not specified, will default to the caller's package.
  
  =item attributes
  
  The L<perlsub/Subroutine Attributes> to apply to the sub generated.  Should be
  specified as an array reference.
  
  =back
  
  =head2 undefer_sub
  
   my $coderef = undefer_sub \&Foo::name;
  
  If the passed coderef has been L<deferred|/defer_sub> this will "undefer" it.
  If the passed coderef has not been deferred, this will just return it.
  
  If this is confusing, take a look at the example in the L</SYNOPSIS>.
  
  Exported by default.
  
  =head2 defer_info
  
   my $data = defer_info $sub;
   my ($name, $generator, $options, $undeferred_sub) = @$data;
  
  Returns original arguments to defer_sub, plus the undeferred version if this
  sub has already been undeferred.
  
  Note that $sub can be either the original deferred version or the undeferred
  version for convenience.
  
  Not exported by default.
  
  =head2 undefer_all
  
   undefer_all();
  
  This will undefer all deferred subs in one go.  This can be very useful in a
  forking environment where child processes would each have to undefer the same
  subs.  By calling this just before you start forking children you can undefer
  all currently deferred subs in the parent so that the children do not have to
  do it.  Note this may bake the behavior of some subs that were intended to
  calculate their behavior later, so it shouldn't be used midway through a
  module load or class definition.
  
  Exported by default.
  
  =head2 undefer_package
  
    undefer_package($package);
  
  This undefers all deferred subs in a package.
  
  Not exported by default.
  
  =head1 SUPPORT
  
  See L<Sub::Quote> for support and contact information.
  
  =head1 AUTHORS
  
  See L<Sub::Quote> for authors.
  
  =head1 COPYRIGHT AND LICENSE
  
  See L<Sub::Quote> for the copyright and license.
  
  =cut
SUB_DEFER

$fatpacked{"Sub/Exporter/Progressive.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'SUB_EXPORTER_PROGRESSIVE';
  package Sub::Exporter::Progressive;
  $Sub::Exporter::Progressive::VERSION = '0.001013';
  use strict;
  use warnings;
  
  # ABSTRACT: Only use Sub::Exporter if you need it
  
  sub _croak {
    require Carp;
    &Carp::croak;
  }
  
  sub import {
     my ($self, @args) = @_;
  
     my $inner_target = caller;
     my $export_data = sub_export_options($inner_target, @args);
  
     my $full_exporter;
     no strict 'refs';
     no warnings 'once';
     @{"${inner_target}::EXPORT_OK"} = @{$export_data->{exports}};
     @{"${inner_target}::EXPORT"} = @{$export_data->{defaults}};
     %{"${inner_target}::EXPORT_TAGS"} = %{$export_data->{tags}};
     *{"${inner_target}::import"} = sub {
        use strict;
        my ($self, @args) = @_;
  
        if ( grep {
           length ref $_
              or
           $_ !~ / \A [:-]? \w+ \z /xm
        } @args ) {
           _croak 'your usage of Sub::Exporter::Progressive requires Sub::Exporter to be installed'
              unless eval { require Sub::Exporter };
           $full_exporter ||= Sub::Exporter::build_exporter($export_data->{original});
  
           goto $full_exporter;
        } elsif ( defined( (my ($num) = grep { m/^\d/ } @args)[0] ) ) {
           _croak "cannot export symbols with a leading digit: '$num'";
        } else {
           require Exporter;
           s/ \A - /:/xm for @args;
           @_ = ($self, @args);
           goto \&Exporter::import;
        }
     };
     return;
  }
  
  my $too_complicated = <<'DEATH';
  You are using Sub::Exporter::Progressive, but the features your program uses from
  Sub::Exporter cannot be implemented without Sub::Exporter, so you might as well
  just use vanilla Sub::Exporter
  DEATH
  
  sub sub_export_options {
     my ($inner_target, $setup, $options) = @_;
  
     my @exports;
     my @defaults;
     my %tags;
  
     if ( ($setup||'') eq '-setup') {
        my %options = %$options;
  
        OPTIONS:
        for my $opt (keys %options) {
           if ($opt eq 'exports') {
  
              _croak $too_complicated if ref $options{exports} ne 'ARRAY';
              @exports = @{$options{exports}};
              _croak $too_complicated if grep { length ref $_ } @exports;
  
           } elsif ($opt eq 'groups') {
              %tags = %{$options{groups}};
              for my $tagset (values %tags) {
                 _croak $too_complicated if grep {
                    length ref $_
                       or
                    $_ =~ / \A - (?! all \b ) /x
                 } @{$tagset};
              }
              @defaults = @{$tags{default} || [] };
           } else {
              _croak $too_complicated;
           }
        }
        @{$_} = map { / \A  [:-] all \z /x ? @exports : $_ } @{$_} for \@defaults, values %tags;
        $tags{all} ||= [ @exports ];
        my %exports = map { $_ => 1 } @exports;
        my @errors = grep { not $exports{$_} } @defaults;
        _croak join(', ', @errors) . " is not exported by the $inner_target module\n" if @errors;
     }
  
     return {
        exports => \@exports,
        defaults => \@defaults,
        original => $options,
        tags => \%tags,
     };
  }
  
  1;
  
  __END__
  
  =pod
  
  =encoding UTF-8
  
  =head1 NAME
  
  Sub::Exporter::Progressive - Only use Sub::Exporter if you need it
  
  =head1 VERSION
  
  version 0.001013
  
  =head1 SYNOPSIS
  
   package Syntax::Keyword::Gather;
  
   use Sub::Exporter::Progressive -setup => {
     exports => [qw( break gather gathered take )],
     groups => {
       default => [qw( break gather gathered take )],
     },
   };
  
   # elsewhere
  
   # uses Exporter for speed
   use Syntax::Keyword::Gather;
  
   # somewhere else
  
   # uses Sub::Exporter for features
   use Syntax::Keyword::Gather 'gather', take => { -as => 'grab' };
  
  =head1 DESCRIPTION
  
  L<Sub::Exporter> is an incredibly powerful module, but with that power comes
  great responsibility, er- as well as some runtime penalties.  This module
  is a C<Sub::Exporter> wrapper that will let your users just use L<Exporter>
  if all they are doing is picking exports, but use C<Sub::Exporter> if your
  users try to use C<Sub::Exporter>'s more advanced features, like
  renaming exports, if they try to use them.
  
  Note that this module will export C<@EXPORT>, C<@EXPORT_OK> and
  C<%EXPORT_TAGS> package variables for C<Exporter> to work.  Additionally, if
  your package uses advanced C<Sub::Exporter> features like currying, this module
  will only ever use C<Sub::Exporter>, so you might as well use it directly.
  
  =head1 CONTRIBUTORS
  
  ilmari - Dagfinn Ilmari Mannsåker (cpan:ILMARI) <ilmari@ilmari.org>
  
  mst - Matt S. Trout (cpan:MSTROUT) <mst@shadowcat.co.uk>
  
  leont - Leon Timmermans (cpan:LEONT) <leont@cpan.org>
  
  =head1 AUTHOR
  
  Arthur Axel "fREW" Schmidt <Sub-Exporter-Progressive@afoolishmanifesto.com>
  
  =head1 COPYRIGHT AND LICENSE
  
  This software is copyright (c) 2016 by Arthur Axel "fREW" Schmidt.
  
  This is free software; you can redistribute it and/or modify it under
  the same terms as the Perl 5 programming language system itself.
  
  =cut
SUB_EXPORTER_PROGRESSIVE

$fatpacked{"Sub/Quote.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'SUB_QUOTE';
  package Sub::Quote;
  
  sub _clean_eval { eval $_[0] }
  
  use strict;
  use warnings;
  
  use Sub::Defer qw(defer_sub);
  use Scalar::Util qw(weaken);
  use Exporter qw(import);
  use Carp qw(croak);
  BEGIN { our @CARP_NOT = qw(Sub::Defer) }
  use B ();
  BEGIN {
    *_HAVE_IS_UTF8 = defined &utf8::is_utf8 ? sub(){1} : sub(){0};
    *_HAVE_PERLSTRING = defined &B::perlstring ? sub(){1} : sub(){0};
    *_BAD_BACKSLASH_ESCAPE = _HAVE_PERLSTRING() && "$]" == 5.010_000 ? sub(){1} : sub(){0};
  }
  
  our $VERSION = '2.006003';
  $VERSION = eval $VERSION;
  
  our @EXPORT = qw(quote_sub unquote_sub quoted_from_sub qsub);
  our @EXPORT_OK = qw(quotify capture_unroll inlinify sanitize_identifier);
  
  our %QUOTED;
  
  my %escape;
  if (_BAD_BACKSLASH_ESCAPE) {
    %escape = (
      (map +(chr($_) => sprintf '\x%02x', $_), 0 .. 0x31, 0x7f),
      "\t" => "\\t",
      "\n" => "\\n",
      "\r" => "\\r",
      "\f" => "\\f",
      "\b" => "\\b",
      "\a" => "\\a",
      "\e" => "\\e",
      (map +($_ => "\\$_"), qw(" \ $ @)),
    );
  }
  
  sub quotify {
    my $value = $_[0];
    no warnings 'numeric';
    ! defined $value     ? 'undef()'
    # numeric detection
    : (!(_HAVE_IS_UTF8 && utf8::is_utf8($value))
      && length( (my $dummy = '') & $value )
      && 0 + $value eq $value
    ) ? (
      $value != $value ? (
        $value eq -CORE::sin(9**9**9)
          ? '(-CORE::sin(9**9**9))' # -nan
          : 'CORE::sin(9**9**9)'    # nan
      )
      : $value == 9**9**9 ? '(9**9**9)'      # inf
      : $value == -9**9**9 ? '(-9**9**9)'    # -inf
      : int($value) == $value ? $value       # integer
      : do {
        my $float = sprintf('%.20f', $value);
        $float =~ s/(\.[0-9]+?)0+\z/$1/;
        $float;
      }
    )
    : !length($value) && eval { use warnings 'FATAL' => 'numeric'; $value == 0 } ? '(!1)' # false
    : _BAD_BACKSLASH_ESCAPE && _HAVE_IS_UTF8 && utf8::is_utf8($value) ? do {
      $value =~ s/(["\$\@\\[:cntrl:]]|[^\x00-\x7f])/
        $escape{$1} || sprintf('\x{%x}', ord($1))
      /ge;
      qq["$value"];
    }
    : _HAVE_PERLSTRING ? B::perlstring($value)
    : qq["\Q$value\E"];
  }
  
  sub sanitize_identifier {
    my $name = shift;
    $name =~ s/([_\W])/sprintf('_%x', ord($1))/ge;
    $name;
  }
  
  sub capture_unroll {
    my ($from, $captures, $indent) = @_;
    join(
      '',
      map {
        /^([\@\%\$])/
          or croak "capture key should start with \@, \% or \$: $_";
        (' ' x $indent).qq{my ${_} = ${1}{${from}->{${\quotify $_}}};\n};
      } keys %$captures
    );
  }
  
  sub inlinify {
    my ($code, $args, $extra, $local) = @_;
    $args = '()'
      if !defined $args;
    my $do = 'do { '.($extra||'');
    if ($code =~ s/^(\s*package\s+([a-zA-Z0-9:]+);)//) {
      $do .= $1;
    }
    if ($code =~ s{
      \A((?:\#\ BEGIN\ quote_sub\ PRELUDE\n.*?\#\ END\ quote_sub\ PRELUDE\n)?\s*)
      (^\s*) my \s* \(([^)]+)\) \s* = \s* \@_;
    }{}xms) {
      my ($pre, $indent, $code_args) = ($1, $2, $3);
      $do .= $pre;
      if ($code_args ne $args) {
        $do .= $indent . 'my ('.$code_args.') = ('.$args.'); ';
      }
    }
    elsif ($local || $args ne '@_') {
      $do .= ($local ? 'local ' : '').'@_ = ('.$args.'); ';
    }
    $do.$code.' }';
  }
  
  sub quote_sub {
    # HOLY DWIMMERY, BATMAN!
    # $name => $code => \%captures => \%options
    # $name => $code => \%captures
    # $name => $code
    # $code => \%captures => \%options
    # $code
    my $options =
      (ref($_[-1]) eq 'HASH' and ref($_[-2]) eq 'HASH')
        ? pop
        : {};
    my $captures = ref($_[-1]) eq 'HASH' ? pop : undef;
    undef($captures) if $captures && !keys %$captures;
    my $code = pop;
    my $name = $_[0];
    if ($name) {
      my $subname = $name;
      my $package = $subname =~ s/(.*)::// ? $1 : caller;
      $name = join '::', $package, $subname;
      croak qq{package name "$package" too long!}
        if length $package > 252;
      croak qq{package name "$package" is not valid!}
        unless $package =~ /^[^\d\W]\w*(?:::\w+)*$/;
      croak qq{sub name "$subname" too long!}
        if length $subname > 252;
      croak qq{sub name "$subname" is not valid!}
        unless $subname =~ /^[^\d\W]\w*$/;
    }
    my @caller = caller(0);
    my ($attributes, $file, $line) = @{$options}{qw(attributes file line)};
    if ($attributes) {
      /\A\w+(?:\(.*\))?\z/s || croak "invalid attribute $_"
        for @$attributes;
    }
    my $quoted_info = {
      name     => $name,
      code     => $code,
      captures => $captures,
      package      => (exists $options->{package}      ? $options->{package}      : $caller[0]),
      hints        => (exists $options->{hints}        ? $options->{hints}        : $caller[8]),
      warning_bits => (exists $options->{warning_bits} ? $options->{warning_bits} : $caller[9]),
      hintshash    => (exists $options->{hintshash}    ? $options->{hintshash}    : $caller[10]),
      ($attributes ? (attributes => $attributes) : ()),
      ($file       ? (file => $file) : ()),
      ($line       ? (line => $line) : ()),
    };
    my $unquoted;
    weaken($quoted_info->{unquoted} = \$unquoted);
    if ($options->{no_defer}) {
      my $fake = \my $var;
      local $QUOTED{$fake} = $quoted_info;
      my $sub = unquote_sub($fake);
      Sub::Defer::_install_coderef($name, $sub) if $name && !$options->{no_install};
      return $sub;
    }
    else {
      my $deferred = defer_sub(
        ($options->{no_install} ? undef : $name),
        sub {
          $unquoted if 0;
          unquote_sub($quoted_info->{deferred});
        },
        {
          ($attributes ? ( attributes => $attributes ) : ()),
          ($name ? () : ( package => $quoted_info->{package} )),
        },
      );
      weaken($quoted_info->{deferred} = $deferred);
      weaken($QUOTED{$deferred} = $quoted_info);
      return $deferred;
    }
  }
  
  sub _context {
    my $info = shift;
    $info->{context} ||= do {
      my ($package, $hints, $warning_bits, $hintshash, $file, $line)
        = @{$info}{qw(package hints warning_bits hintshash file line)};
  
      $line ||= 1
        if $file;
  
      my $line_mark = '';
      if ($line) {
        $line_mark = "#line ".($line-1);
        if ($file) {
          $line_mark .= qq{ "$file"};
        }
        $line_mark .= "\n";
      }
  
      $info->{context}
        ="# BEGIN quote_sub PRELUDE\n"
        ."package $package;\n"
        ."BEGIN {\n"
        ."  \$^H = ".quotify($hints).";\n"
        ."  \${^WARNING_BITS} = ".quotify($warning_bits).";\n"
        ."  \%^H = (\n"
        . join('', map
        "    ".quotify($_)." => ".quotify($hintshash->{$_}).",\n",
          keys %$hintshash)
        ."  );\n"
        ."}\n"
        .$line_mark
        ."# END quote_sub PRELUDE\n";
    };
  }
  
  sub quoted_from_sub {
    my ($sub) = @_;
    my $quoted_info = $QUOTED{$sub||''} or return undef;
    my ($name, $code, $captures, $unquoted, $deferred)
      = @{$quoted_info}{qw(name code captures unquoted deferred)};
    $code = _context($quoted_info) . $code;
    $unquoted &&= $$unquoted;
    if (($deferred && $deferred eq $sub)
        || ($unquoted && $unquoted eq $sub)) {
      return [ $name, $code, $captures, $unquoted, $deferred ];
    }
    return undef;
  }
  
  sub unquote_sub {
    my ($sub) = @_;
    my $quoted_info = $QUOTED{$sub} or return undef;
    my $unquoted = $quoted_info->{unquoted};
    unless ($unquoted && $$unquoted) {
      my ($name, $code, $captures, $package, $attributes)
        = @{$quoted_info}{qw(name code captures package attributes)};
  
      ($package, $name) = $name =~ /(.*)::(.*)/
        if $name;
  
      my %captures = $captures ? %$captures : ();
      $captures{'$_UNQUOTED'} = \$unquoted;
      $captures{'$_QUOTED'} = \$quoted_info;
  
      my $make_sub
        = "{\n"
        . capture_unroll("\$_[1]", \%captures, 2)
        . "  package ${package};\n"
        . (
          $name
            # disable the 'variable $x will not stay shared' warning since
            # we're not letting it escape from this scope anyway so there's
            # nothing trying to share it
            ? "  no warnings 'closure';\n  sub ${name} "
            : "  \$\$_UNQUOTED = sub "
        )
        . ($attributes ? join('', map ":$_ ", @$attributes) : '') . "{\n"
        . "  (\$_QUOTED,\$_UNQUOTED) if 0;\n"
        . _context($quoted_info)
        . $code
        . "  }".($name ? "\n  \$\$_UNQUOTED = \\&${name}" : '') . ";\n"
        . "}\n"
        . "1;\n";
      if (my $debug = $ENV{SUB_QUOTE_DEBUG}) {
        if ($debug =~ m{^([^\W\d]\w*(?:::\w+)*(?:::)?)$}) {
          my $filter = $1;
          my $match
            = $filter =~ /::$/ ? $package.'::'
            : $filter =~ /::/  ? $package.'::'.($name||'__ANON__')
            : ($name||'__ANON__');
          warn $make_sub
            if $match eq $filter;
        }
        elsif ($debug =~ m{\A/(.*)/\z}s) {
          my $filter = $1;
          warn $make_sub
            if $code =~ $filter;
        }
        else {
          warn $make_sub;
        }
      }
      {
        no strict 'refs';
        local *{"${package}::${name}"} if $name;
        my ($success, $e);
        {
          local $@;
          $success = _clean_eval($make_sub, \%captures);
          $e = $@;
        }
        unless ($success) {
          my $space = length($make_sub =~ tr/\n//);
          my $line = 0;
          $make_sub =~ s/^/sprintf "%${space}d: ", ++$line/emg;
          croak "Eval went very, very wrong:\n\n${make_sub}\n\n$e";
        }
        weaken($QUOTED{$$unquoted} = $quoted_info);
      }
    }
    $$unquoted;
  }
  
  sub qsub ($) {
    goto &quote_sub;
  }
  
  sub CLONE {
    my @quoted = map { defined $_ ? (
      $_->{unquoted} && ${$_->{unquoted}} ? (${ $_->{unquoted} } => $_) : (),
      $_->{deferred} ? ($_->{deferred} => $_) : (),
    ) : () } values %QUOTED;
    %QUOTED = @quoted;
    weaken($_) for values %QUOTED;
  }
  
  1;
  __END__
  
  =encoding utf-8
  
  =head1 NAME
  
  Sub::Quote - Efficient generation of subroutines via string eval
  
  =head1 SYNOPSIS
  
   package Silly;
  
   use Sub::Quote qw(quote_sub unquote_sub quoted_from_sub);
  
   quote_sub 'Silly::kitty', q{ print "meow" };
  
   quote_sub 'Silly::doggy', q{ print "woof" };
  
   my $sound = 0;
  
   quote_sub 'Silly::dagron',
     q{ print ++$sound % 2 ? 'burninate' : 'roar' },
     { '$sound' => \$sound };
  
  And elsewhere:
  
   Silly->kitty;  # meow
   Silly->doggy;  # woof
   Silly->dagron; # burninate
   Silly->dagron; # roar
   Silly->dagron; # burninate
  
  =head1 DESCRIPTION
  
  This package provides performant ways to generate subroutines from strings.
  
  =head1 SUBROUTINES
  
  =head2 quote_sub
  
   my $coderef = quote_sub 'Foo::bar', q{ print $x++ . "\n" }, { '$x' => \0 };
  
  Arguments: ?$name, $code, ?\%captures, ?\%options
  
  C<$name> is the subroutine where the coderef will be installed.
  
  C<$code> is a string that will be turned into code.
  
  C<\%captures> is a hashref of variables that will be made available to the
  code.  The keys should be the full name of the variable to be made available,
  including the sigil.  The values should be references to the values.  The
  variables will contain copies of the values.  See the L</SYNOPSIS>'s
  C<Silly::dagron> for an example using captures.
  
  Exported by default.
  
  =head3 options
  
  =over 2
  
  =item C<no_install>
  
  B<Boolean>.  Set this option to not install the generated coderef into the
  passed subroutine name on undefer.
  
  =item C<no_defer>
  
  B<Boolean>.  Prevents a Sub::Defer wrapper from being generated for the quoted
  sub.  If the sub will most likely be called at some point, setting this is a
  good idea.  For a sub that will most likely be inlined, it is not recommended.
  
  =item C<package>
  
  The package that the quoted sub will be evaluated in.  If not specified, the
  package from sub calling C<quote_sub> will be used.
  
  =item C<hints>
  
  The value of L<< C<$^H> | perlvar/$^H >> to use for the code being evaluated.
  This captures the settings of the L<strict> pragma.  If not specified, the value
  from the calling code will be used.
  
  =item C<warning_bits>
  
  The value of L<< C<${^WARNING_BITS}> | perlvar/${^WARNING_BITS} >> to use for
  the code being evaluated.  This captures the L<warnings> set.  If not specified,
  the warnings from the calling code will be used.
  
  =item C<%^H>
  
  The value of L<< C<%^H> | perlvar/%^H >> to use for the code being evaluated.
  This captures additional pragma settings.  If not specified, the value from the
  calling code will be used if possible (on perl 5.10+).
  
  =item C<attributes>
  
  The L<perlsub/Subroutine Attributes> to apply to the sub generated.  Should be
  specified as an array reference.  The attributes will be applied to both the
  generated sub and the deferred wrapper, if one is used.
  
  =item C<file>
  
  The apparent filename to use for the code being evaluated.
  
  =item C<line>
  
  The apparent line number
  to use for the code being evaluated.
  
  =back
  
  =head2 unquote_sub
  
   my $coderef = unquote_sub $sub;
  
  Forcibly replace subroutine with actual code.
  
  If $sub is not a quoted sub, this is a no-op.
  
  Exported by default.
  
  =head2 quoted_from_sub
  
   my $data = quoted_from_sub $sub;
  
   my ($name, $code, $captures, $compiled_sub) = @$data;
  
  Returns original arguments to quote_sub, plus the compiled version if this
  sub has already been unquoted.
  
  Note that $sub can be either the original quoted version or the compiled
  version for convenience.
  
  Exported by default.
  
  =head2 inlinify
  
   my $prelude = capture_unroll '$captures', {
     '$x' => 1,
     '$y' => 2,
   }, 4;
  
   my $inlined_code = inlinify q{
     my ($x, $y) = @_;
  
     print $x + $y . "\n";
   }, '$x, $y', $prelude;
  
  Takes a string of code, a string of arguments, a string of code which acts as a
  "prelude", and a B<Boolean> representing whether or not to localize the
  arguments.
  
  =head2 quotify
  
   my $quoted_value = quotify $value;
  
  Quotes a single (non-reference) scalar value for use in a code string.  Numbers
  aren't treated specially and will be quoted as strings, but undef will quoted as
  C<undef()>.
  
  =head2 capture_unroll
  
   my $prelude = capture_unroll '$captures', {
     '$x' => 1,
     '$y' => 2,
   }, 4;
  
  Arguments: $from, \%captures, $indent
  
  Generates a snippet of code which is suitable to be used as a prelude for
  L</inlinify>.  C<$from> is a string will be used as a hashref in the resulting
  code.  The keys of C<%captures> are the names of the variables and the values
  are ignored.  C<$indent> is the number of spaces to indent the result by.
  
  =head2 qsub
  
   my $hash = {
    coderef => qsub q{ print "hello"; },
    other   => 5,
   };
  
  Arguments: $code
  
  Works exactly like L</quote_sub>, but includes a prototype to only accept a
  single parameter.  This makes it easier to include in hash structures or lists.
  
  Exported by default.
  
  =head2 sanitize_identifier
  
   my $var_name = '$variable_for_' . sanitize_identifier('@name');
   quote_sub qq{ print \$${var_name} }, { $var_name => \$value };
  
  Arguments: $identifier
  
  Sanitizes a value so that it can be used in an identifier.
  
  =head1 ENVIRONMENT
  
  =head2 SUB_QUOTE_DEBUG
  
  Causes code to be output to C<STDERR> before being evaled.  Several forms are
  supported:
  
  =over 4
  
  =item C<1>
  
  All subs will be output.
  
  =item C</foo/>
  
  Subs will be output if their code matches the given regular expression.
  
  =item C<simple_identifier>
  
  Any sub with the given name will be output.
  
  =item C<Full::identifier>
  
  A sub matching the full name will be output.
  
  =item C<Package::Name::>
  
  Any sub in the given package (including anonymous subs) will be output.
  
  =back
  
  =head1 CAVEATS
  
  Much of this is just string-based code-generation, and as a result, a few
  caveats apply.
  
  =head2 return
  
  Calling C<return> from a quote_sub'ed sub will not likely do what you intend.
  Instead of returning from the code you defined in C<quote_sub>, it will return
  from the overall function it is composited into.
  
  So when you pass in:
  
     quote_sub q{  return 1 if $condition; $morecode }
  
  It might turn up in the intended context as follows:
  
    sub foo {
  
      <important code a>
      do {
        return 1 if $condition;
        $morecode
      };
      <important code b>
  
    }
  
  Which will obviously return from foo, when all you meant to do was return from
  the code context in quote_sub and proceed with running important code b.
  
  =head2 pragmas
  
  C<Sub::Quote> preserves the environment of the code creating the
  quoted subs.  This includes the package, strict, warnings, and any
  other lexical pragmas.  This is done by prefixing the code with a
  block that sets up a matching environment.  When inlining C<Sub::Quote>
  subs, care should be taken that user pragmas won't effect the rest
  of the code.
  
  =head1 SUPPORT
  
  Users' IRC: #moose on irc.perl.org
  
  =for :html
  L<(click for instant chatroom login)|http://chat.mibbit.com/#moose@irc.perl.org>
  
  Development and contribution IRC: #web-simple on irc.perl.org
  
  =for :html
  L<(click for instant chatroom login)|http://chat.mibbit.com/#web-simple@irc.perl.org>
  
  Bugtracker: L<https://rt.cpan.org/Public/Dist/Display.html?Name=Sub-Quote>
  
  Git repository: L<git://github.com/moose/Sub-Quote.git>
  
  Git browser: L<https://github.com/moose/Sub-Quote>
  
  =head1 AUTHOR
  
  mst - Matt S. Trout (cpan:MSTROUT) <mst@shadowcat.co.uk>
  
  =head1 CONTRIBUTORS
  
  frew - Arthur Axel "fREW" Schmidt (cpan:FREW) <frioux@gmail.com>
  
  ribasushi - Peter Rabbitson (cpan:RIBASUSHI) <ribasushi@cpan.org>
  
  Mithaldu - Christian Walde (cpan:MITHALDU) <walde.christian@googlemail.com>
  
  tobyink - Toby Inkster (cpan:TOBYINK) <tobyink@cpan.org>
  
  haarg - Graham Knop (cpan:HAARG) <haarg@cpan.org>
  
  bluefeet - Aran Deltac (cpan:BLUEFEET) <bluefeet@gmail.com>
  
  ether - Karen Etheridge (cpan:ETHER) <ether@cpan.org>
  
  dolmen - Olivier Mengué (cpan:DOLMEN) <dolmen@cpan.org>
  
  alexbio - Alessandro Ghedini (cpan:ALEXBIO) <alexbio@cpan.org>
  
  getty - Torsten Raudssus (cpan:GETTY) <torsten@raudss.us>
  
  arcanez - Justin Hunter (cpan:ARCANEZ) <justin.d.hunter@gmail.com>
  
  kanashiro - Lucas Kanashiro (cpan:KANASHIRO) <kanashiro.duarte@gmail.com>
  
  djerius - Diab Jerius (cpan:DJERIUS) <djerius@cfa.harvard.edu>
  
  =head1 COPYRIGHT
  
  Copyright (c) 2010-2016 the Sub::Quote L</AUTHOR> and L</CONTRIBUTORS>
  as listed above.
  
  =head1 LICENSE
  
  This library is free software and may be distributed under the same terms
  as perl itself. See L<http://dev.perl.org/licenses/>.
  
  =cut
SUB_QUOTE

$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.022'; # 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 $writer = delete $args{writer};
      my $header = delete $args{header};
      my $footer = delete $args{footer};
      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,
          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,
      );
      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);
  }
  
  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::Scalar;
  
  use overload
      '+' => \&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} }
  
  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<http://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>
  
  =item schema
  
  Default: C<['Core']>
  
  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!
  
  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 indent
  
  Default: 2
  
  Use that many spaces for indenting
  
  =item header
  
  Default: 1
  
  Print document heaader C<--->
  
  =item footer
  
  Default: 0
  
  Print document footer C<...>
  
  =item yaml_version
  
  Since version 0.020
  
  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
  
  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
  
  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 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
  
      my $yp = YAML::PP->new( preserve => PRESERVE_ORDER | PRESERVE_SCALAR_STYLE );
      my ($hash, $styles) = $yp->load_file($file);
  
  Then dumping it will return the same output.
  Only folded block scalars '>' cannot preserve the style yet.
  
  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.
  
  =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 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 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<http://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>
  
  =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.022'; # 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
  /;
  
  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   => 'any',
      YAML_BLOCK_SEQUENCE_STYLE => 'block',
      YAML_FLOW_SEQUENCE_STYLE  => 'flow',
  
      YAML_ANY_MAPPING_STYLE   => 'any',
      YAML_BLOCK_MAPPING_STYLE => 'block',
      YAML_FLOW_MAPPING_STYLE  => 'flow',
  
      PRESERVE_ALL          => 1,
      PRESERVE_ORDER        => 2,
      PRESERVE_SCALAR_STYLE => 4,
  };
  
  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 FUNCTONS
  
  =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.022'; # VERSION
  
  use YAML::PP;
  use YAML::PP::Common qw/ PRESERVE_ALL PRESERVE_ORDER PRESERVE_SCALAR_STYLE /;
  use Scalar::Util qw/ reftype /;
  
  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 $preserve = delete $args{preserve} || 0;
      if ($preserve == PRESERVE_ALL) {
          $preserve = PRESERVE_ORDER | PRESERVE_SCALAR_STYLE;
      }
      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,
      }, $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 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;
  
      if ($self->preserve_order and not tied(%$data)) {
          tie %$data, 'YAML::PP::Preserve::Hash';
      }
  
      push @$stack, $ref;
      if (defined(my $anchor = $event->{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) = @_;
          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);
              }
              $$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;
  
      push @$stack, $ref;
      if (defined(my $anchor = $event->{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})) {
          $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);
      if (defined (my $name = $event->{anchor})) {
          $self->anchors->{ $name } = { data => $value, finished => 1 };
      }
      my $last = $self->stack->[-1];
      if ($self->preserve_scalar_style and not ref $value) {
          $value = YAML::PP::Preserve::Scalar->new(
              value => $value,
              style => $event->{style},
              tag => $event->{tag},
          );
      }
      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";
                  }
                  if ($cyclic_refs eq 'warn') {
                      $anchor = { data => undef };
                      warn "Found cyclic ref";
                  }
                  elsif ($cyclic_refs eq 'ignore') {
                      $anchor = { data => undef };
                  }
              }
          }
          $value = $anchor->{data};
      }
      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);
      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.022'; # 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) {
                  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) = @$item;
      if ($type eq 'alias') {
          $self->emitter->alias_event({ value => $node->{value} });
          return;
      }
      if ($type eq 'mapping') {
          my $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 = 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,
  );
  
  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 (++$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.022'; # 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;
  
  sub new {
      my ($class, %args) = @_;
      my $self = bless {
          indent => $args{indent} || 2,
          writer => $args{writer},
      }, $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 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->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 $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 $column = $last->{column};
      my $yaml = '';
      my $newline = 0;
      if ($last->{type} eq 'DOC') {
          if ($props) {
              $newline = 1;
              $yaml .= $last->{column} ? ' ' : $indent;
              $yaml .= "$props";
          }
          if ($last->{newline}) {
                  $newline = 1;
          }
          else {
              if ($props) {
                  $newline = 1;
              }
          }
      }
      else {
          $new_indent .= ' ' x $self->indent;
          if ($last->{newline}) {
              $yaml .= "\n";
              $last->{column} = 0;
              $last->{newline} = 0;
          }
          if ($props) {
              $newline = 1;
          }
          if ($last->{type} eq 'MAPVALUE') {
              $newline = 1;
          }
          else {
              $yaml .= $last->{column} ? ' ' : $indent;
              $last->{newline} = 0;
              if ($last->{type} eq 'SEQ') {
                  $yaml .= '-';
              }
              elsif ($last->{type} eq 'MAP') {
                  $yaml .= "?";
                  $last->{type} = 'COMPLEX';
              }
              elsif ($last->{type} eq 'COMPLEX') {
                  $yaml .= ":";
                  $last->{type} = 'COMPLEXVALUE';
              }
              elsif ($last->{type} eq 'COMPLEXVALUE') {
                  $yaml .= ":";
                  $last->{type} = 'MAP';
              }
              else {
                  die "Unexpected";
              }
          }
          if ($props) {
              $yaml .= " $props";
              $newline = 1;
          }
      }
      if (length $yaml) {
          $column = substr($yaml, -1) eq "\n" ? 0 : 1;
      }
      $self->writer->write($yaml);
      my $new_info = {
          index => 0, indent => $new_indent, info => $info,
          newline => $newline,
          column => $column,
      };
      if (($info->{style} || '') eq YAML_FLOW_MAPPING_STYLE) {
  #        $new_info->{type} = 'FLOWMAP';
          $new_info->{type} = 'MAP';
      }
      else {
          $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 };
      my $column = $last->{column};
      if ($last->{index} == 0) {
          my $indent = $last->{indent};
          my $zero_indent = $last->{zero_indent};
          if ($last->{zero_indent}) {
              $indent .= ' ' x $self->indent;
          }
          if ($last->{column}) {
              $self->writer->write(" {}\n");
          }
          else {
              $self->writer->write("$indent\{}\n");
          }
          $column = 0;
      }
      $last = $stack->[-1];
      $last->{column} = $column;
      if ($last->{type} eq 'SEQ') {
      }
      elsif ($last->{type} eq 'MAP') {
      }
      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 $writer = $self->writer;
      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 $newline = 0;
      my $zero_indent = 0;
      if ($last->{type} eq 'DOC') {
          $newline = $last->{newline};
      }
      else {
          if ($last->{newline}) {
              $yaml .= "\n";
              $last->{column} = 0;
              $last->{newline} = 0;
          }
          if ($last->{type} eq 'MAPVALUE') {
              $zero_indent = 1;
              $newline = 1;
          }
          else {
              $yaml .= $last->{column} ? ' ' : $indent;
              if ($last->{type} eq 'SEQ') {
                  $new_indent .= ' ' x $self->indent;
                  $yaml .= "-";
              }
              elsif ($last->{type} eq 'MAP') {
                  $new_indent .= ' ' x $self->indent;
                  $yaml .= "?";
                  $last->{type} = 'COMPLEX';
                  $zero_indent = 1;
              }
              elsif ($last->{type} eq 'COMPLEXVALUE') {
                  $new_indent .= ' ' x $self->indent;
                  $yaml .= ":";
                  $zero_indent = 1;
              }
              $last->{column} = 1;
          }
      }
      if ($props) {
          $newline = 1;
          $yaml .= $last->{column} ? ' ' : $indent;
          $yaml .= $props;
      }
      $self->writer->write($yaml);
      $last->{index}++;
      my $column = $last->{column};
      if (length $yaml) {
          $column = substr($yaml, -1) eq "\n" ? 0 : 1;
      }
      my $new_info = {
          index => 0,
          indent => $new_indent,
          info => $info,
          zero_indent => $zero_indent,
          newline => $newline,
          column => $column,
      };
      if (($info->{style} || '') eq YAML_FLOW_SEQUENCE_STYLE) {
          $new_info->{type} = 'FLOWSEQ';
      }
      else {
          $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 };
      my $column = $last->{column};;
      if ($last->{index} == 0) {
          my $indent = $last->{indent};
          my $zero_indent = $last->{zero_indent};
          if ($last->{zero_indent}) {
              $indent .= ' ' x $self->indent;
          }
          my $yaml .= $last->{column} ? ' ' : $indent;
          $yaml .= "[]\n";
          $self->writer->write("$yaml");
          $column = 0;
      }
      $last = $stack->[-1];
      $last->{column} = $column;
      if ($last->{type} eq 'SEQ') {
      }
      elsif ($last->{type} eq 'MAP') {
      }
      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 $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;
      if (not $style and $value eq '') {
          $style = YAML_SINGLE_QUOTED_SCALAR_STYLE;
      }
      $style ||= YAML_PLAIN_SCALAR_STYLE;
  
      my $first = substr($value, 0, 1);
      # no control characters anywhere
      if ($style ne YAML_DOUBLE_QUOTED_SCALAR_STYLE and $value =~ m/[$control_re]/) {
          $style = YAML_DOUBLE_QUOTED_SCALAR_STYLE;
      }
      elsif ($style eq 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 eq YAML_LITERAL_SCALAR_STYLE or $style eq YAML_FOLDED_SCALAR_STYLE) {
      }
      elsif ($style eq YAML_PLAIN_SCALAR_STYLE) {
          if ($value =~ m/[$escape_re_without_lb]/) {
              $style = YAML_DOUBLE_QUOTED_SCALAR_STYLE;
          }
          elsif ($value eq "\n") {
              $style = YAML_DOUBLE_QUOTED_SCALAR_STYLE;
          }
          elsif ($value =~ m/\n/) {
              $style = YAML_LITERAL_SCALAR_STYLE;
          }
          elsif ($forbidden_first{ $first }) {
              $style = YAML_SINGLE_QUOTED_SCALAR_STYLE;
          }
          elsif (substr($value, 0, 3) =~ m/^(?:---|\.\.\.)/) {
              $style = YAML_SINGLE_QUOTED_SCALAR_STYLE;
          }
          elsif (substr($value, 0, 2) =~ 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}]/) {
              # TODO exclude ,[]{} in flow collections
              $style = YAML_SINGLE_QUOTED_SCALAR_STYLE;
          }
          else {
              $style = YAML_PLAIN_SCALAR_STYLE;
          }
      }
  
      my $open_ended = 0;
      if ($style eq YAML_PLAIN_SCALAR_STYLE) {
          if ($forbidden_first_plus_space{ $first }) {
              if (length ($value) == 1 or substr($value, 1, 1) =~ m/^\s/) {
                  $style = YAML_SINGLE_QUOTED_SCALAR_STYLE;
              }
          }
      }
  
      if (($style eq YAML_LITERAL_SCALAR_STYLE or $style eq YAML_FOLDED_SCALAR_STYLE) and $value eq '') {
          $style = YAML_DOUBLE_QUOTED_SCALAR_STYLE;
      }
      if ($style eq YAML_PLAIN_SCALAR_STYLE) {
          $value =~ s/\n/\n\n/g;
      }
      elsif ($style eq 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 eq YAML_LITERAL_SCALAR_STYLE) {
          DEBUG and warn __PACKAGE__.':'.__LINE__.$".Data::Dumper->Dump([\$value], ['value']);
          my $indicators = '';
          if ($value =~ m/\A\n* +/) {
              $indicators .= $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 eq 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;
          }
          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 eq YAML_LITERAL_SCALAR_STYLE or $style eq YAML_FOLDED_SCALAR_STYLE);
      my $newline = 0;
      my $column = $last->{column};
      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;
          }
      }
      if ($last->{type} eq 'MAP') {
  
          if ($props and not length $value) {
              $pvalue .= ' ';
          }
          my $new_event = 'MAPVALUE';
          $yaml .= $last->{column} ? ' ' : $indent;
          if ($multiline) {
              # oops, a complex key
              $yaml .= "? ";
              $new_event = 'COMPLEXVALUE';
          }
          if (not $multiline) {
              $pvalue .= ":";
          }
          $last->{type} = $new_event;
      }
      else {
          if ($last->{type} eq 'MAPVALUE') {
              $last->{type} = 'MAP';
          }
          elsif ($last->{type} eq 'DOC') {
          }
          else {
              $yaml .= $last->{column} ? ' ' : $indent;
              if ($last->{type} eq 'COMPLEXVALUE') {
                  $last->{type} = 'MAP';
                  $yaml .= ":";
              }
              elsif ($last->{type} eq 'COMPLEX') {
                  $yaml .= ": ";
              }
              elsif ($last->{type} eq 'SEQ') {
                  $yaml .= "-";
              }
              else {
                  die "Unexpected";
              }
              $last->{column} = 1;
          }
  
          if (length $pvalue) {
              if ($last->{column}) {
                  $pvalue = " $pvalue";
              }
          }
          if (not $multiline) {
              $pvalue .= "\n";
          }
      }
      $yaml .= $pvalue;
  
      $column = $last->{column};
      $last->{index}++;
      $last->{newline} = $newline;
      if (length $yaml) {
          $column = substr($yaml, -1) eq "\n" ? 0 : 1;
      }
      $last->{column} = $column;
      $self->writer->write($yaml);
      $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 $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 ($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->writer->write("$yaml");
      $last->{index}++;
      my $column = $last->{column};
      if (length $yaml) {
          $column = substr($yaml, -1) eq "\n" ? 0 : 1;
      }
      $last->{column} = $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 $column = 0;
      my $implicit = $info->{implicit};
      if ($info->{version_directive}) {
          if ($self->{open_ended}) {
              $self->writer->write("...\n");
          }
          $self->writer->write("%YAML $info->{version_directive}->{major}.$info->{version_directive}->{minor}\n");
          $self->{open_ended} = 0;
          $implicit = 0; # we need ---
      }
      unless ($implicit) {
          $newline = 1;
          $self->writer->write("---");
          $column = 1;
      }
      $self->set_event_stack([
          {
          type => 'DOC', index => 0, indent => '', info => $info,
          newline => $newline, column => $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->writer->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;
  }
  
  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 yorself.
  
  =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.022'; # 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.022'; # 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.022'; # 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 /],
  );
  
  sub ansicolored {
      my ($class, $tokens) = @_;
      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;
      }
  
      $ansi .= "$highlighted\n";
      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',
  );
  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) {
              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.022'; # 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.022'; # 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 $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,
      );
      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.022'; # 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) = @_;
  
      if ($self->lexer->flowcontext) {
          die "Unexpected end of flow context";
      }
      if ($self->new_node) {
          $self->scalar_event({ style => YAML_PLAIN_SCALAR_STYLE, value => '' });
      }
      $self->remove_nodes(-1);
  
      my $event_types = $self->events;
      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.022'; # 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.022'; # 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.022'; # 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.022'; # 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_ALL PRESERVE_ORDER PRESERVE_SCALAR_STYLE
  /;
  use B;
  
  sub new {
      my ($class, %args) = @_;
      my $preserve = delete $args{preserve} || 0;
      if ($preserve == PRESERVE_ALL) {
          $preserve = PRESERVE_ORDER | PRESERVE_SCALAR_STYLE;
      }
      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 represent_node {
      my ($self, $node) = @_;
  
      if ($self->preserve_scalar_style) {
          if (ref $node->{value} eq 'YAML::PP::Preserve::Scalar') {
              my $value = $node->{value}->value;
              if ($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 (ref $node->{value}) {
          $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 };
              }
          }
          return [ mapping => $node ];
      }
      elsif ($node->{reftype} eq 'ARRAY') {
          unless (defined $node->{items}) {
              @{ $node->{items} } = @{ $node->{data} };
          }
          return [ sequence => $node ];
      }
      elsif ($node->{reftype}) {
          die "Reftype $node->{reftype} not implemented";
      }
      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);
      }
      $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.022'; # 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,
          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 (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.022'; # 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.022'; # 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 Schwma:
  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.022'; # 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.022'; # 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.022'; # 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 Schwma: 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.022'; # 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.
  
  =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.022'; # 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};
          $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 = '';
          }
      }
  
      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;
      }
  
      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;
  
      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;
  
      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(
          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});
              }
              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_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);
  }
  
  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.
  
  Typeglobs are not implemented yet. 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 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.022'; # 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.022'; # 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.022'; # 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.022'; # 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.022'; # 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{"oo.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'OO';
  package oo;
  
  use Moo::_strictures;
  use Moo::_Utils qw(_load_module);
  
  sub moo {
    print <<'EOMOO';
   ______
  < Moo! >
   ------
          \   ^__^
           \  (oo)\_______
              (__)\       )\/\
                  ||----w |
                  ||     ||
  EOMOO
    exit 0;
  }
  
  BEGIN {
      my $package;
      sub import {
          moo() if $0 eq '-';
          $package = $_[1] || 'Class';
          if ($package =~ /^\+/) {
              $package =~ s/^\+//;
              _load_module($package);
          }
      }
      use Filter::Simple sub { s/^/package $package;\nuse Moo;\n/; }
  }
  
  1;
  __END__
  
  =head1 NAME
  
  oo - syntactic sugar for Moo oneliners
  
  =head1 SYNOPSIS
  
    perl -Moo=Foo -e 'has bar => ( is => q[ro], default => q[baz] ); print Foo->new->bar'
  
    # loads an existing class and re-"opens" the package definition
    perl -Moo=+My::Class -e 'print __PACKAGE__->new->bar'
  
  =head1 DESCRIPTION
  
  oo.pm is a simple source filter that adds C<package $name; use Moo;> to the
  beginning of your script, intended for use on the command line via the -M
  option.
  
  =head1 SUPPORT
  
  See L<Moo> for support and contact information.
  
  =head1 AUTHORS
  
  See L<Moo> for authors.
  
  =head1 COPYRIGHT AND LICENSE
  
  See L<Moo> for the copyright and license.
  
  =cut
OO

$fatpacked{"x86_64-linux/Class/XSAccessor.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'X86_64-LINUX_CLASS_XSACCESSOR';
  package Class::XSAccessor;
  use 5.008;
  use strict;
  use warnings;
  use Carp qw/croak/;
  use Class::XSAccessor::Heavy;
  use XSLoader;
  
  our $VERSION = '1.19';
  
  XSLoader::load('Class::XSAccessor', $VERSION);
  
  sub _make_hash {
    my $ref = shift;
  
    if (ref ($ref)) {
      if (ref($ref) eq 'ARRAY') {
        $ref = { map { $_ => $_ } @$ref }
      } 
    } else {
      $ref = { $ref, $ref };
    }
  
    return $ref;
  }
  
  sub import {
    my $own_class = shift;
    my ($caller_pkg) = caller();
  
    # Support both { getters => ... } and plain getters => ...
    my %opts = ref($_[0]) eq 'HASH' ? %{$_[0]} : @_;
  
    $caller_pkg = $opts{class} if defined $opts{class};
  
    # TODO: Refactor. Move more duplicated code to ::Heavy
    my $read_subs      = _make_hash($opts{getters} || {});
    my $set_subs       = _make_hash($opts{setters} || {});
    my $acc_subs       = _make_hash($opts{accessors} || {});
    my $lvacc_subs     = _make_hash($opts{lvalue_accessors} || {});
    my $pred_subs      = _make_hash($opts{predicates} || {});
    my $ex_pred_subs   = _make_hash($opts{exists_predicates} || {});
    my $def_pred_subs  = _make_hash($opts{defined_predicates} || {});
    my $test_subs      = _make_hash($opts{__tests__} || {});
    my $construct_subs = $opts{constructors} || [defined($opts{constructor}) ? $opts{constructor} : ()];
    my $true_subs      = $opts{true} || [];
    my $false_subs     = $opts{false} || [];
  
    foreach my $subtype ( ["getter", $read_subs],
                          ["setter", $set_subs],
                          ["accessor", $acc_subs],
                          ["lvalue_accessor", $lvacc_subs],
                          ["test", $test_subs],
                          ["ex_predicate", $ex_pred_subs],
                          ["def_predicate", $def_pred_subs],
                          ["def_predicate", $pred_subs] )
    {
      my $subs = $subtype->[1];
      foreach my $subname (keys %$subs) {
        my $hashkey = $subs->{$subname};
        _generate_method($caller_pkg, $subname, $hashkey, \%opts, $subtype->[0]);
      }
    }
  
    foreach my $subtype ( ["constructor", $construct_subs],
                          ["true", $true_subs],
                          ["false", $false_subs] )
    {
      foreach my $subname (@{$subtype->[1]}) {
        _generate_method($caller_pkg, $subname, "", \%opts, $subtype->[0]);
      }
    }
  }
  
  sub _generate_method {
    my ($caller_pkg, $subname, $hashkey, $opts, $type) = @_;
  
    croak("Cannot use undef as a hash key for generating an XS $type accessor. (Sub: $subname)")
      if not defined $hashkey;
  
    $subname = "${caller_pkg}::$subname" if $subname !~ /::/;
  
    Class::XSAccessor::Heavy::check_sub_existence($subname) if not $opts->{replace};
    no warnings 'redefine'; # don't warn about an explicitly requested redefine
  
    if ($type eq 'getter') {
      newxs_getter($subname, $hashkey);
    }
    elsif ($type eq 'lvalue_accessor') {
      newxs_lvalue_accessor($subname, $hashkey);
    }
    elsif ($type eq 'setter') {
      newxs_setter($subname, $hashkey, $opts->{chained}||0);
    }
    elsif ($type eq 'def_predicate') {
      newxs_defined_predicate($subname, $hashkey);
    }
    elsif ($type eq 'ex_predicate') {
      newxs_exists_predicate($subname, $hashkey);
    }
    elsif ($type eq 'constructor') {
      newxs_constructor($subname);
    }
    elsif ($type eq 'true') {
      newxs_boolean($subname, 1);
    }
    elsif ($type eq 'false') {
      newxs_boolean($subname, 0);
    }
    elsif ($type eq 'test') {
      newxs_test($subname, $hashkey);
    }
    else {
      newxs_accessor($subname, $hashkey, $opts->{chained}||0);
    }
  }
  
  1;
  
  __END__
  
  =head1 NAME
  
  Class::XSAccessor - Generate fast XS accessors without runtime compilation
  
  =head1 SYNOPSIS
  
    package MyClass;
    use Class::XSAccessor
      replace     => 1,   # Replace existing methods (if any)
      constructor => 'new',
      getters     => {
        get_foo => 'foo', # 'foo' is the hash key to access
        get_bar => 'bar',
      },
      setters => {
        set_foo => 'foo',
        set_bar => 'bar',
      },
      accessors => {
        foo => 'foo',
        bar => 'bar',
      },
      # "predicates" is an alias for "defined_predicates"
      defined_predicates => {
        defined_foo => 'foo',
        defined_bar => 'bar',
      },
      exists_predicates => {
        has_foo => 'foo',
        has_bar => 'bar',
      },
      lvalue_accessors => { # see below
        baz => 'baz', # ...
      },
      true  => [ 'is_token', 'is_whitespace' ],
      false => [ 'significant' ];
    
    # The imported methods are implemented in fast XS.
    
    # normal class code here.
  
  As of version 1.05, some alternative syntax forms are available:
  
    package MyClass;
    
    # Options can be passed as a HASH reference, if preferred,
    # which can also help Perl::Tidy to format the statement correctly.
    use Class::XSAccessor {
       # If the name => key values are always identical,
       # the following shorthand can be used.
       accessors => [ 'foo', 'bar' ],
    };
  
  =head1 DESCRIPTION
  
  Class::XSAccessor implements fast read, write and read/write accessors in XS.
  Additionally, it can provide predicates such as C<has_foo()> for testing
  whether the attribute C<foo> exists in the object (which is different from
  "is defined within the object").
  It only works with objects that are implemented as ordinary hashes.
  L<Class::XSAccessor::Array> implements the same interface for objects
  that use arrays for their internal representation.
  
  Since version 0.10, the module can also generate simple constructors
  (implemented in XS). Simply supply the
  C<constructor =E<gt> 'constructor_name'> option or the
  C<constructors =E<gt> ['new', 'create', 'spawn']> option.
  These constructors do the equivalent of the following Perl code:
  
    sub new {
      my $class = shift;
      return bless { @_ }, ref($class)||$class;
    }
  
  That means they can be called on objects and classes but will not
  clone objects entirely. Parameters to C<new()> are added to the
  object.
  
  The XS accessor methods are between 3 and 4 times faster than typical
  pure-Perl accessors in some simple benchmarking.
  The lower factor applies to the potentially slightly obscure
  C<sub set_foo_pp {$_[0]-E<gt>{foo} = $_[1]}>, so if you usually
  write clear code, a factor of 3.5 speed-up is a good estimate.
  If in doubt, do your own benchmarking!
  
  The method names may be fully qualified. The example in the synopsis could
  have been written as C<MyClass::get_foo> instead
  of C<get_foo>. This way, methods can be installed in classes other
  than the current class. See also: the C<class> option below.
  
  By default, the setters return the new value that was set,
  and the accessors (mutators) do the same. This behaviour can be changed
  with the C<chained> option - see below. The predicates return a boolean.
  
  Since version 1.01, C<Class::XSAccessor> can generate extremely simple methods which
  just return true or false (and always do so). If that seems like a
  really superfluous thing to you, then consider a large class hierarchy
  with interfaces such as L<PPI>. These methods are provided by the C<true>
  and C<false> options - see the synopsis.
  
  C<defined_predicates> check whether a given object attribute is defined.
  C<predicates> is an alias for C<defined_predicates> for compatibility with
  older versions of C<Class::XSAccessor>. C<exists_predicates> checks
  whether the given attribute exists in the object using C<exists>.
  
  =head1 OPTIONS
  
  In addition to specifying the types and names of accessors, additional options
  can be supplied which modify behaviour. The options are specified as key/value pairs
  in the same manner as the accessor declaration. For example:
  
    use Class::XSAccessor
      getters => {
        get_foo => 'foo',
      },
      replace => 1;
  
  The list of available options is:
  
  =head2 replace
  
  Set this to a true value to prevent C<Class::XSAccessor> from
  complaining about replacing existing subroutines.
  
  =head2 chained
  
  Set this to a true value to change the return value of setters
  and mutators (when called with an argument).
  If C<chained> is enabled, the setters and accessors/mutators will
  return the object. Mutators called without an argument still
  return the value of the associated attribute.
  
  As with the other options, C<chained> affects all methods generated
  in the same C<use Class::XSAccessor ...> statement.
  
  =head2 class
  
  By default, the accessors are generated in the calling class. The
  the C<class> option allows the target class to be specified.
  
  =head1 LVALUES
  
  Support for lvalue accessors via the keyword C<lvalue_accessors>
  was added in version 1.08. At this point, B<THEY ARE CONSIDERED HIGHLY
  EXPERIMENTAL>. Furthermore, their performance hasn't been benchmarked
  yet.
  
  The following example demonstrates an lvalue accessor:
  
    package Address;
    use Class::XSAccessor
      constructor => 'new',
      lvalue_accessors => { zip_code => 'zip' };
    
    package main;
    my $address = Address->new(zip => 2);
    print $address->zip_code, "\n"; # prints 2
    $address->zip_code = 76135; # <--- This is it!
    print $address->zip_code, "\n"; # prints 76135
  
  =head1 CAVEATS
  
  Probably won't work for objects based on I<tied> hashes. But that's a strange thing to do anyway.
  
  Scary code exploiting strange XS features.
  
  If you think writing an accessor in XS should be a laughably simple exercise, then
  please contemplate how you could instantiate a new XS accessor for a new hash key
  that's only known at run-time. Note that compiling C code at run-time a la L<Inline::C|Inline::C>
  is a no go.
  
  Threading. With version 1.00, a memory leak has been B<fixed>. Previously, a small amount of
  memory would leak if C<Class::XSAccessor>-based classes were loaded in a subthread without having
  been loaded in the "main" thread. If the subthread then terminated, a hash key and an int per
  associated method used to be lost. Note that this mattered only if classes were B<only> loaded
  in a sort of throw-away thread.
  
  In the new implementation, as of 1.00, the memory will still not be released, in the same situation,
  but it will be recycled when the same class, or a similar class, is loaded again in B<any> thread.
  
  =head1 SEE ALSO
  
  =over
  
  =item * L<Class::XSAccessor::Array>
  
  =item * L<AutoXS>
  
  =back
  
  =head1 AUTHOR
  
  Steffen Mueller E<lt>smueller@cpan.orgE<gt>
  
  chocolateboy E<lt>chocolate@cpan.orgE<gt>
  
  =head1 COPYRIGHT AND LICENSE
  
  Copyright (C) 2008, 2009, 2010, 2011, 2012, 2013 by Steffen Mueller
  
  This library is free software; you can redistribute it and/or modify
  it under the same terms as Perl itself, either Perl version 5.8 or,
  at your option, any later version of Perl 5 you may have available.
  
  =cut
X86_64-LINUX_CLASS_XSACCESSOR

$fatpacked{"x86_64-linux/Class/XSAccessor/Array.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'X86_64-LINUX_CLASS_XSACCESSOR_ARRAY';
  package Class::XSAccessor::Array;
  use 5.008;
  use strict;
  use warnings;
  use Carp qw/croak/;
  use Class::XSAccessor;
  use Class::XSAccessor::Heavy;
  
  our $VERSION = '1.19';
  
  sub import {
    my $own_class = shift;
    my ($caller_pkg) = caller();
  
    # Support both { getters => ... } and plain getters => ...
    my %opts = ref($_[0]) eq 'HASH' ? %{$_[0]} : @_;
  
    $caller_pkg = $opts{class} if defined $opts{class};
  
    my $read_subs      = $opts{getters} || {};
    my $set_subs       = $opts{setters} || {};
    my $acc_subs       = $opts{accessors} || {};
    my $lvacc_subs     = $opts{lvalue_accessors} || {};
    my $pred_subs      = $opts{predicates} || {};
    my $construct_subs = $opts{constructors} || [defined($opts{constructor}) ? $opts{constructor} : ()];  
    my $true_subs      = $opts{true} || [];
    my $false_subs     = $opts{false} || [];
  
  
    foreach my $subtype ( ["getter", $read_subs],
                          ["setter", $set_subs],
                          ["accessor", $acc_subs],
                          ["lvalue_accessor", $lvacc_subs],
                          ["pred_subs", $pred_subs] )
    {
      my $subs = $subtype->[1];
      foreach my $subname (keys %$subs) {
        my $array_index = $subs->{$subname};
        _generate_method($caller_pkg, $subname, $array_index, \%opts, $subtype->[0]);
      }
    }
     
    foreach my $subtype ( ["constructor", $construct_subs],
                          ["true", $true_subs],
                          ["false", $false_subs] )
    {
      foreach my $subname (@{$subtype->[1]}) {
        _generate_method($caller_pkg, $subname, "", \%opts, $subtype->[0]);
      }
    }
  }
  
  sub _generate_method {
    my ($caller_pkg, $subname, $array_index, $opts, $type) = @_;
  
    croak("Cannot use undef as a array index for generating an XS $type accessor. (Sub: $subname)")
      if not defined $array_index;
  
    $subname = "${caller_pkg}::$subname" if $subname !~ /::/;
  
    Class::XSAccessor::Heavy::check_sub_existence($subname) if not $opts->{replace};
    no warnings 'redefine'; # don't warn about an explicitly requested redefine
  
    if ($type eq 'getter') {
      newxs_getter($subname, $array_index);
    }
    if ($type eq 'lvalue_accessor') {
      newxs_lvalue_accessor($subname, $array_index);
    }
    elsif ($type eq 'setter') {
      newxs_setter($subname, $array_index, $opts->{chained}||0);
    }
    elsif ($type eq 'predicate') {
      newxs_predicate($subname, $array_index);
    }
    elsif ($type eq 'constructor') {
      newxs_constructor($subname);
    }
    elsif ($type eq 'true') {
      Class::XSAccessor::newxs_boolean($subname, 1);
    }
    elsif ($type eq 'false') {
      Class::XSAccessor::newxs_boolean($subname, 0);
    }
    else {
      newxs_accessor($subname, $array_index, $opts->{chained}||0);
    }
  }
  
  1;
  
  __END__
  
  =head1 NAME
  
  Class::XSAccessor::Array - Generate fast XS accessors without runtime compilation
  
  =head1 SYNOPSIS
    
    package MyClassUsingArraysAsInternalStorage;
    use Class::XSAccessor::Array
      constructor => 'new',
      getters => {
        get_foo => 0, # 0 is the array index to access
        get_bar => 1,
      },
      setters => {
        set_foo => 0,
        set_bar => 1,
      },
      accessors => { # a mutator
        buz => 2,
      },
      predicates => { # test for definedness
        has_buz => 2,
      },
      lvalue_accessors => { # see below
        baz => 3,
      },
      true => [ 'is_token', 'is_whitespace' ],
      false => [ 'significant' ];
    
    # The imported methods are implemented in fast XS.
    
    # normal class code here.
  
  As of version 1.05, some alternative syntax forms are available:
  
    package MyClass;
    
    # Options can be passed as a HASH reference if you prefer it,
    # which can also help PerlTidy to flow the statement correctly.
    use Class::XSAccessor {
      getters => {
        get_foo => 0,
        get_bar => 1,
      },
    };
  
  =head1 DESCRIPTION
  
  The module implements fast XS accessors both for getting at and
  setting an object attribute. Additionally, the module supports
  mutators and simple predicates (C<has_foo()> like tests for definedness
  of an attributes).
  The module works only with objects
  that are implemented as B<arrays>. Using it on hash-based objects is
  bound to make your life miserable. Refer to L<Class::XSAccessor> for
  an implementation that works with hash-based objects.
  
  A simple benchmark showed a significant performance
  advantage over writing accessors in Perl.
  
  Since version 0.10, the module can also generate simple constructors
  (implemented in XS) for you. Simply supply the
  C<constructor =E<gt> 'constructor_name'> option or the
  C<constructors =E<gt> ['new', 'create', 'spawn']> option.
  These constructors do the equivalent of the following Perl code:
  
    sub new {
      my $class = shift;
      return bless [], ref($class)||$class;
    }
  
  That means they can be called on objects and classes but will not
  clone objects entirely. Note that any parameters to new() will be
  discarded! If there is a better idiom for array-based objects, let
  me know.
  
  While generally more obscure than hash-based objects,
  objects using blessed arrays as internal representation
  are a bit faster as its somewhat faster to access arrays than hashes.
  Accordingly, this module is slightly faster (~10-15%) than
  L<Class::XSAccessor>, which works on hash-based objects.
  
  The method names may be fully qualified. In the example of the
  synopsis, you could have written C<MyClass::get_foo> instead
  of C<get_foo>. This way, you can install methods in classes other
  than the current class. See also: The C<class> option below.
  
  Since version 1.01, you can generate extremely simple methods which
  just return true or false (and always do so). If that seems like a
  really superfluous thing to you, then think of a large class hierarchy
  with interfaces such as PPI. This is implemented as the C<true>
  and C<false> options, see synopsis.
  
  =head1 OPTIONS
  
  In addition to specifying the types and names of accessors, you can add options
  which modify behaviour. The options are specified as key/value pairs just as the
  accessor declaration. Example:
  
    use Class::XSAccessor::Array
      getters => {
        get_foo => 0,
      },
      replace => 1;
  
  The list of available options is:
  
  =head2 replace
  
  Set this to a true value to prevent C<Class::XSAccessor::Array> from
  complaining about replacing existing subroutines.
  
  =head2 chained
  
  Set this to a true value to change the return value of setters
  and mutators (when called with an argument).
  If C<chained> is enabled, the setters and accessors/mutators will
  return the object. Mutators called without an argument still
  return the value of the associated attribute.
  
  As with the other options, C<chained> affects all methods generated
  in the same C<use Class::XSAccessor::Array ...> statement.
  
  =head2 class
  
  By default, the accessors are generated in the calling class. Using
  the C<class> option, you can explicitly specify where the methods
  are to be generated.
  
  =head1 LVALUES
  
  Support for lvalue accessors via the keyword C<lvalue_accessors>
  was added in version 1.08. At this point, B<THEY ARE CONSIDERED HIGHLY
  EXPERIMENTAL>. Furthermore, their performance hasn't been benchmarked
  yet.
  
  The following example demonstrates an lvalue accessor:
  
    package Address;
    use Class::XSAccessor
      constructor => 'new',
      lvalue_accessors => { zip_code => 0 };
    
    package main;
    my $address = Address->new(2);
    print $address->zip_code, "\n"; # prints 2
    $address->zip_code = 76135; # <--- This is it!
    print $address->zip_code, "\n"; # prints 76135
  
  =head1 CAVEATS
  
  Probably wouldn't work if your objects are I<tied>. But that's a strange thing to do anyway.
  
  Scary code exploiting strange XS features.
  
  If you think writing an accessor in XS should be a laughably simple exercise, then
  please contemplate how you could instantiate a new XS accessor for a new hash key
  or array index that's only known at run-time. Note that compiling C code at run-time
  a la Inline::C is a no go.
  
  Threading. With version 1.00, a memory leak has been B<fixed> that would leak a small amount of
  memory if you loaded C<Class::XSAccessor>-based classes in a subthread that hadn't been loaded
  in the "main" thread before. If the subthread then terminated, a hash key and an int per
  associated method used to be lost. Note that this mattered only if classes were B<only> loaded
  in a sort of throw-away thread.
  
  In the new implementation as of 1.00, the memory will not be released again either in the above
  situation. But it will be recycled when the same class or a similar class is loaded
  again in B<any> thread.
  
  =head1 SEE ALSO
  
  L<Class::XSAccessor>
  
  L<AutoXS>
  
  =head1 AUTHOR
  
  Steffen Mueller E<lt>smueller@cpan.orgE<gt>
  
  chocolateboy E<lt>chocolate@cpan.orgE<gt>
  
  =head1 COPYRIGHT AND LICENSE
  
  Copyright (C) 2008, 2009, 2010, 2011, 2012, 2013 by Steffen Mueller
  
  This library is free software; you can redistribute it and/or modify
  it under the same terms as Perl itself, either Perl version 5.8 or,
  at your option, any later version of Perl 5 you may have available.
  
  =cut
X86_64-LINUX_CLASS_XSACCESSOR_ARRAY

$fatpacked{"x86_64-linux/Class/XSAccessor/Heavy.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'X86_64-LINUX_CLASS_XSACCESSOR_HEAVY';
  package # hide from PAUSE
      Class::XSAccessor::Heavy;
  
  use 5.008;
  use strict;
  use warnings;
  use Carp;
  
  our $VERSION  = '1.19';
  our @CARP_NOT = qw(
          Class::XSAccessor
          Class::XSAccessor::Array
  );
  
  # TODO Move more duplicated code from XSA and XSA::Array here
  
  
  sub check_sub_existence {
    my $subname = shift;
  
    my $sub_package = $subname;
    $sub_package =~ s/([^:]+)$// or die;
    my $bare_subname = $1;
      
    my $sym;
    {
      no strict 'refs';
      $sym = \%{"$sub_package"};
    }
    no warnings;
    local *s = $sym->{$bare_subname};
    my $coderef = *s{CODE};
    if ($coderef) {
      $sub_package =~ s/::$//;
      Carp::croak("Cannot replace existing subroutine '$bare_subname' in package '$sub_package' with an XS implementation. If you wish to force a replacement, add the 'replace => 1' parameter to the arguments of 'use ".(caller())[0]."'.");
    }
  }
  
  1;
  
  __END__
  
  =head1 NAME
  
  Class::XSAccessor::Heavy - Guts you don't care about
  
  =head1 SYNOPSIS
    
    use Class::XSAccessor!
  
  =head1 DESCRIPTION
  
  Common guts for Class::XSAccessor and Class::XSAccessor::Array.
  No user-serviceable parts inside!
  
  =head1 SEE ALSO
  
  L<Class::XSAccessor>
  L<Class::XSAccessor::Array>
  
  =head1 AUTHOR
  
  Steffen Mueller, E<lt>smueller@cpan.orgE<gt>
  
  chocolateboy, E<lt>chocolate@cpan.orgE<gt>
  
  =head1 COPYRIGHT AND LICENSE
  
  Copyright (C) 2008, 2009, 2010, 2011, 2012, 2013 by Steffen Mueller
  
  This library is free software; you can redistribute it and/or modify
  it under the same terms as Perl itself, either Perl version 5.8 or,
  at your option, any later version of Perl 5 you may have available.
  
  =cut
  
X86_64-LINUX_CLASS_XSACCESSOR_HEAVY

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);

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

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

if ( @ARGV ) {
    $app->process_block( $app->resolve_block( [ @ARGV ] ) );
} 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

