#!/usr/bin/perl
# -*- mode: 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{"Applify.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'APPLIFY';
  package Applify;
  use strict;
  use warnings;
  use Carp           ();
  use File::Basename ();
  
  use constant SUB_NAME_IS_AVAILABLE => $INC{'App/FatPacker/Trace.pm'}
    ? 0    # this will be true when running under "fatpack"
    : eval 'use Sub::Name; 1' ? 1 : 0;
  
  our $VERSION = '0.14';
  our $PERLDOC       = 'perldoc';
  our $SUBCMD_PREFIX = "command";
  my $ANON = 1;
  
  sub app {
    my $self   = shift;
    my $code   = $self->{app} ||= shift;
    my $parser = $self->_option_parser;
    my (%options, @options_spec, $application_class, $app);
  
    # has to be run before calculating option spec.
    # cannot do ->can() as application_class isn't created yet.
    if ($self->_subcommand_activate($ARGV[0])) { shift @ARGV; }
    for my $option (@{$self->{options}}) {
      my $switch = $self->_attr_to_option($option->{name});
      push @options_spec, $self->_calculate_option_spec($option);
      $options{$switch} = $option->{default}     if exists $option->{default};
      $options{$switch} = [@{$options{$switch}}] if ref($options{$switch}) eq 'ARRAY';
    }
  
    unless ($parser->getoptions(\%options, @options_spec, $self->_default_options)) {
      $self->_exit(1);
    }
  
    if ($options{help}) {
      $self->print_help;
      $self->_exit('help');
    }
    elsif ($options{man}) {
      system $PERLDOC => $self->documentation;
      $self->_exit($? >> 8);
    }
    elsif ($options{version}) {
      $self->print_version;
      $self->_exit('version');
    }
  
    $application_class = $self->{application_class} ||= $self->_generate_application_class($code);
    $app = $application_class->new(
      {map { my $k = $self->_option_to_attr($_); $k => $self->_upgrade($k, $options{$_}) } keys %options});
  
    return $app if defined wantarray;    # $app = do $script_file;
    $self->_exit($app->run(@ARGV));
  }
  
  sub documentation {
    return $_[0]->{documentation} if @_ == 1;
    $_[0]->{documentation} = $_[1] or die 'Usage: documentation $file|$module_name;';
    return $_[0];
  }
  
  sub extends {
    my $self = shift;
    $self->{extends} = [@_];
    return $self;
  }
  
  sub import {
    my ($class, %args) = @_;
    my @caller = caller;
    my $self   = $class->new({caller => \@caller});
    my $ns     = $caller[0] . '::';
    my %export;
  
    strict->import;
    warnings->import;
  
    $self->{skip_subs} = {app => 1, option => 1, version => 1, documentation => 1, extends => 1, subcommand => 1};
  
    no strict 'refs';
    for my $name (keys %$ns) {
      $self->{'skip_subs'}{$name} = 1;
    }
  
    for my $k (qw(app extends option version documentation subcommand)) {
      my $name = $args{$k} // $k;
      next unless $name;
      $export{$k} = $name =~ /::/ ? $name : "$caller[0]\::$name";
    }
  
    no warnings 'redefine';    # need to allow redefine when loading a new app
    *{$export{app}}           = sub (&) { $self->app(@_) };
    *{$export{option}}        = sub     { $self->option(@_) };
    *{$export{version}}       = sub     { $self->version(@_) };
    *{$export{documentation}} = sub     { $self->documentation(@_) };
    *{$export{extends}}       = sub     { $self->extends(@_) };
    *{$export{subcommand}}    = sub     { $self->subcommand(@_) };
  }
  
  sub new {
    my ($class, $args) = @_;
    my $self = bless $args, $class;
  
    $self->{options} ||= [];
    $self->{caller} or die 'Usage: $self->new({ caller => [...], ... })';
  
    return $self;
  }
  
  sub option {
    my $self          = shift;
    my $type          = shift or die 'Usage: option $type => ...';
    my $name          = shift or die 'Usage: option $type => $name => ...';
    my $documentation = shift or die 'Usage: option $type => $name => $documentation, ...';
    my ($default, %args);
  
    if (@_ % 2) {
      $default = shift;
      %args    = @_;
    }
    else {
      %args = @_;
    }
  
    if ($args{alias} and !ref $args{alias}) {
      $args{alias} = [$args{alias}];
    }
  
    push @{$self->{options}}, {default => $default, %args, type => $type, name => $name, documentation => $documentation};
  
    return $self;
  }
  
  sub options { $_[0]->{options} }
  
  sub print_help {
    my $self    = shift;
    my @options = @{$self->{options}};
    my $width   = 0;
  
    push @options, {name => ''};
    push @options, {name => 'help', documentation => 'Print this help text'};
    push @options, {name => 'man', documentation => 'Display manual for this application'} if $self->documentation;
    push @options, {name => 'version', documentation => 'Print application name and version'} if $self->version;
    push @options, {name => ''};
  
    $self->_print_synopsis;
  
  OPTION:
    for my $option (@options) {
      my $length = length $option->{name};
      $width = $length if $width < $length;
    }
  
    print "Usage:\n";
  
    if (%{$self->{subcommands} || {}}) {
      my $subcmds = [sort { $a->{name} cmp $b->{name} } values %{$self->{subcommands}}];
      my ($width) = sort { $b <=> $a } map { length($_->{name}) } @$subcmds;
      print "\n    ", File::Basename::basename($0), " [command] [options]\n";
      print "\ncommands:\n";
      printf("    %-${width}s  %s\n", @{$_}{'name', 'desc'}) for @$subcmds;
      print "\noptions:\n";
    }
  
  OPTION:
    for my $option (@options) {
      my $name = $self->_attr_to_option($option->{name}) or do { print "\n"; next OPTION };
  
      printf(
        " %s %2s%-${width}s  %s\n",
        $option->{required} ? '*'  : ' ',
        length($name) > 1   ? '--' : '-',
        $name, $option->{documentation},
      );
    }
  
    return $self;
  }
  
  sub print_version {
    my $self = shift;
    my $version = $self->version or die 'Cannot print version without version()';
  
    unless ($version =~ m!^\d!) {
      eval "require $version; 1" or die "Could not load $version: $@";
      $version = $version->VERSION;
    }
  
    printf "%s version %s\n", File::Basename::basename($0), $version;
  }
  
  sub subcommand {
    my ($self, $name) = (shift, shift);
    return $self->{subcommand} unless @_;
    $self->{subcommands}{$name} = {name => $name, desc => $_[0], adaptation => $_[1]};
    return $self;
  }
  
  sub version {
    return $_[0]->{version} if @_ == 1;
    $_[0]->{version} = $_[1] or die 'Usage: version $module_name|$num;';
    return $_[0];
  }
  
  sub _attr_to_option {
    local $_ = $_[1] or return;
    s!_!-!g;
    $_;
  }
  
  sub _calculate_option_spec {
    my ($self, $option) = @_;
    my $spec = $self->_attr_to_option($option->{name});
  
    if (ref $option->{alias} eq 'ARRAY') {
      $spec .= join '|', '', @{$option->{alias}};
    }
  
    if    ($option->{type} =~ /^(?:bool|flag)/i) { $spec .= '!' }
    elsif ($option->{type} =~ /^inc/)            { $spec .= '+' }
    elsif ($option->{type} =~ /^str/)            { $spec .= '=s' }
    elsif ($option->{type} =~ /^int/i)           { $spec .= '=i' }
    elsif ($option->{type} =~ /^num/i)           { $spec .= '=f' }
    elsif ($option->{type} =~ /^file/)           { $spec .= '=s' }    # TODO
    elsif ($option->{type} =~ /^dir/)            { $spec .= '=s' }    # TODO
    else                                         { die 'Usage: option {bool|flag|inc|str|int|num|file|dir} ...' }
  
    if (my $n_of = $option->{n_of}) {
      $spec .= $n_of eq '@' ? $n_of : "{$n_of}";
      $option->{default}
        and ref $option->{default} ne 'ARRAY'
        and die 'Usage option ... default => [Need to be an array ref]';
      $option->{default} ||= [];
    }
  
    return $spec;
  }
  
  sub _default_options {
    my $self = shift;
    my @default;
  
    push @default, 'help';
    push @default, 'man' if $self->documentation;
    push @default, 'version' if $self->version;
  
    return @default;
  }
  
  sub _exit {
    my ($self, $reason) = @_;
    exit 0 unless ($reason =~ /^\d+$/);    # may change without warning...
    exit $reason;
  }
  
  sub _generate_application_class {
    my ($self, $code) = @_;
    my $application_class = $self->{caller}[1];
    my $extends = $self->{extends} || [];
    my ($meta, @required);
  
    $application_class =~ s!\W!_!g;
    $application_class = join '::', ref($self), "__ANON__${ANON}__", $application_class;
    $ANON++;
  
    eval qq[
      package $application_class;
      use base qw(@$extends);
      1;
    ] or die "Failed to generate application class: $@";
  
    {
      no strict 'refs';
      _sub("$application_class\::new" => sub { my $class = shift; bless shift, $class })
        unless grep { $_->can('new') } @$extends;
      _sub("$application_class\::_script" => sub {$self});
      _sub(
        "$application_class\::run" => sub {
          my ($app, @extra) = @_;
  
          if (@required = grep { not defined $app->{$_} } @required) {
            my $required = join ', ', map { '--' . $self->_attr_to_option($_) } @required;
            $app->_script->print_help;
            die "Required attribute missing: $required\n";
          }
  
          # get subcommand code - which should have a registered subroutine
          # or fallback to app {} block.
          $code = $app->_script->_subcommand_code($app) || $code;
          return $app->$code(@extra);
        }
      );
  
      for ('app', $self->{caller}[0]) {
        my $ns = \%{"$_\::"};
  
        for my $name (keys %$ns) {
          $self->{skip_subs}{$name} and next;
          my $code = eval { ref $ns->{$name} eq 'CODE' ? $ns->{$name} : *{$ns->{$name}}{CODE} } or next;
          my $fqn = join '::', $application_class, $name;
          _sub($fqn => $code);
          delete $ns->{$name};    # may be a bit too destructive?
        }
      }
  
      $meta = $application_class->meta if $application_class->isa('Moose::Object') and $application_class->can('meta');
  
      for my $option (@{$self->{options}}) {
        my $name = $option->{name};
        my $fqn = join '::', $application_class, $name;
        if ($meta) {
          $meta->add_attribute($name => {is => 'rw', default => $option->{default}});
        }
        else {
          _sub($fqn => sub { @_ == 2 and $_[0]->{$name} = $_[1]; $_[0]->{$name} });
        }
        push @required, $name if $option->{required};
      }
    }
  
    return $application_class;
  }
  
  sub _load_class {
    my $class = shift or return undef;
    return $class if $class->can('new');
    return eval "require $class; 1" ? $class : "";
  }
  
  sub _option_parser {
    $_[0]->{_option_parser} ||= do {
      require Getopt::Long;
      Getopt::Long::Parser->new(config => [qw(no_auto_help no_auto_version pass_through)]);
    };
  }
  
  sub _option_to_attr {
    local $_ = $_[1] or return;
    s!-!_!g;
    $_;
  }
  
  sub _print_synopsis {
    my $self = shift;
    my $documentation = $self->documentation or return;
    my $print;
  
    unless (-e $documentation) {
      eval "use $documentation; 1" or die "Could not load $documentation: $@";
      $documentation =~ s!::!/!g;
      $documentation = $INC{"$documentation.pm"};
    }
  
    open my $FH, '<', $documentation or die "Failed to read synopsis from $documentation: $@";
  
    while (<$FH>) {
      last if $print and /^=(?:cut|head1)/;
      print if $print;
      $print = 1 if /^=head1 SYNOPSIS/;
    }
  }
  
  sub _sub {
    my ($fqn, $code) = @_;
    no strict 'refs';
    return if *$fqn{CODE};
    *$fqn = SUB_NAME_IS_AVAILABLE ? Sub::Name::subname($fqn, $code) : $code;
  }
  
  sub _subcommand_activate {
    my ($self, $name) = @_;
    return undef unless $name and $name =~ /^\w+/;
    return undef unless $self->{subcommands}{$name};
    $self->{subcommand} = $name;
    {
      no warnings 'redefine';
      local *Applify::app = sub {
        Carp::confess(
          "Looks like you have a typo in your script! Cannot have app{} inside a subcommand options block.");
      };
      $self->{subcommands}{$name}{adaptation}->($self);
    }
    return 1;
  }
  
  sub _subcommand_code {
    my ($self, $app, $name) = (shift, shift);
    return undef unless $name = $self->subcommand;
    return $app->can("${SUBCMD_PREFIX}_${name}");
  }
  
  sub _upgrade {
    my ($self, $name, $input) = @_;
    return $input unless defined $input;
  
    my ($option) = grep { $_->{name} eq $name } @{$self->{options}};
    return $input unless my $class = _load_class($option->{isa});
    return ref $input eq 'ARRAY' ? [map { $class->new($_) } @$input] : $class->new($input);
  }
  
  1;
  
  =encoding utf8
  
  =head1 NAME
  
  Applify - Write object oriented scripts with ease
  
  =head1 VERSION
  
  0.14
  
  =head1 DESCRIPTION
  
  This module should keep all the noise away and let you write scripts
  very easily. These scripts can even be unittested even though they
  are define directly in the script file and not in a module.
  
  =head1 SYNOPSIS
  
    #!/usr/bin/perl
    use Applify;
  
    option file => input_file => 'File to read from';
    option dir => output_dir => 'Directory to write files to';
    option flag => dry_run => 'Use --no-dry-run to actually do something', 1;
  
    documentation __FILE__;
    version 1.23;
  
    sub generate_exit_value {
      return int rand 100;
    }
  
    app {
      my($self, @extra) = @_;
      my $exit_value = 0;
  
      print "Extra arguments: @extra\n" if(@extra);
      print "Will read from: ", $self->input_file, "\n";
      print "Will write files to: ", $self->output_dir, "\n";
  
      if($self->dry_run) {
        die 'Will not run script';
      }
  
      return $self->generate_exit_value;
    };
  
  =head1 APPLICATION CLASS
  
  This module will generate an application class, which C<$self> inside the
  L</app> block refere to. This class will have:
  
  =over 4
  
  =item * new()
  
  An object constructor. This method will not be auto generated if any of
  the classes given to L</extends> has the method C<new()>.
  
  =item * run()
  
  This method is basically the code block given to L</app>.
  
  =item * Other methods
  
  Other methods defined in the script file will be accesible from C<$self>
  inside C<app{}>.
  
  =item * _script()
  
  This is an accessor which return the L<Applify> object which
  is refered to as C<$self> in this documentation.
  
  NOTE: This accessor starts with an underscore to prevent conflicts
  with L</options>.
  
  =item * Other accessors
  
  Any L</option> (application switch) will be available as an accessor on the
  application object.
  
  =back
  
  =head1 EXPORTED FUNCTIONS
  
  =head2 option
  
    option $type => $name => $documentation;
    option $type => $name => $documentation, $default;
    option $type => $name => $documentation, $default, @args;
    option $type => $name => $documentation, @args;
  
  This function is used to define options which can be given to this
  application. See L</SYNOPSIS> for example code. This function can also be
  called as a method on C<$self>.
  
  =over 4
  
  =item * $type
  
  Used to define value types for this input.
  
  =over 4
  
  =item bool, flag
  
  =item inc
  
  =item str
  
  =item int
  
  =item num
  
  =item file (TODO)
  
  =item dir (TODO)
  
  =back
  
  =item * $name
  
  The name of an application switch. This name will also be used as
  accessor name inside the application. Example:
  
    # define an application switch:
    option file => some_file => '...';
  
    # call the application from command line:
    > myapp.pl --some-file /foo/bar
  
    # run the application code:
    app {
      my $self = shift;
      print $self->some_file # prints "/foo/bar"
      return 0;
    };
  
  =item * C<$documentation>
  
  Used as description text when printing the usage text.
  
  =item * C<@args>
  
  =over 4
  
  =item * C<required>
  
  The script will not start if a required field is omitted.
  
  =item * C<n_of>
  
  Allow the option to hold a list of values. Examples: "@", "4", "1,3".
  See L<Getopt::Long/Options-with-multiple-values> for details.
  
  =item * C<isa>
  
  Specify the class an option should be instantiated as. Example:
  
    option file => output => "output file", isa => "Mojo::File";
  
  The C<output()> attribute will then later return an object of L<Mojo::File>,
  instead of just a plain string.
  
  =item * Other
  
  Any other L<Moose> attribute argument may/will be supported in
  future release.
  
  =back
  
  =back
  
  =head2 documentation
  
    documentation __FILE__; # current file
    documentation '/path/to/file';
    documentation 'Some::Module';
  
  Specifies where to retrieve documentaion from when giving the C<--man>
  switch to your script.
  
  =head2 version
  
    version 'Some::Module';
    version $num;
  
  Specifies where to retrieve the version number from when giving the
  C<--version> switch to your script.
  
  =head2 extends
  
    extends @classes;
  
  Specify which classes this application should inherit from. These
  classes can be L<Moose> based.
  
  =head2 subcommand
  
    subcommand list => 'provide a listing objects' => sub {
      option flag => long => 'long listing';
      option flag => recursive => 'recursively list objects';
    };
  
    subcommand create => 'create a new object' => sub {
      option str => name => 'name of new object', required => 1;
      option str => description => 'description for the object', required => 1;
    };
  
    sub command_create {
      my ($self, @extra) = @_;
      ## do creating
      return 0;
    }
  
    sub command_list {
      my ($self, @extra) = @_;
      ## do listing
      return 0;
    }
  
    app {
      my ($self, @extra) = @_;
      ## fallback when no command given.
      $self->_script->print_help;
      return 0;
    };
  
  This function allows for creating multiple related sub commands within the same
  script in a similar fashion to C<git>. The L</option>, L</extends> and
  L</documentation> exported functions may sensibly be called within the
  subroutine. Calling the function with no arguments will return the running
  subcommand, i.e. a valid C<$ARGV[0]>. Non valid values for the subcommand given
  on the command line will result in the help being displayed.
  
  =head2 app
  
    app CODE;
  
  This function will define the code block which is called when the application
  is started. See L</SYNOPSIS> for example code. This function can also be
  called as a method on C<$self>.
  
  IMPORTANT: This function must be the last function called in the script file
  for unittests to work. Reason for this is that this function runs the
  application in void context (started from command line), but returns the
  application object in list/scalar context (from L<perlfunc/do>).
  
  =head1 ATTRIBUTES
  
  =head2 options
  
    $array_ref = $self->options;
  
  Holds the application options given to L</option>.
  
  =head1 METHODS
  
  =head2 new
  
    $self = $class->new({ options => $array_ref, ... });
  
  Object constructor. Creates a new object representing the script meta
  information.
  
  =head2 print_help
  
  Will print L</options> to selected filehandle (STDOUT by default) in
  a normalized matter. Example:
  
    Usage:
       --foo      Foo does this and that
     * --bar      Bar does something else
  
       --help     Print this help text
       --man      Display manual for this application
       --version  Print application name and version
  
  =head2 print_version
  
  Will print L</version> to selected filehandle (STDOUT by default) in
  a normalized matter. Example:
  
    some-script.pl version 1.23
  
  =head2 import
  
  Will export the functions listed under L</EXPORTED FUNCTIONS>. The functions
  will act on a L<Applify> object created by this method.
  
  =head1 COPYRIGHT & LICENSE
  
  This library is free software. You can redistribute it and/or modify
  it under the same terms as Perl itself.
  
  =head1 AUTHORS
  
  Jan Henning Thorsen - C<jhthorsen@cpan.org>
  
  Roy Storey - C<kiwiroy@cpan.org>
  
  =cut
APPLIFY

$fatpacked{"Devel/IPerl/Plugin/CpanMinus.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'DEVEL_IPERL_PLUGIN_CPANMINUS';
  package Devel::IPerl::Plugin::CpanMinus;
  
  use strict;
  use warnings;
  
  our $VERSION = '0.01';
  
  sub register {
    my ($class, $iperl) = @_;
  
    my $options = {
      cpanm             => [],
      cpanm_info        => [cmd => 'info'],
      cpanm_installdeps => [installdeps => 1],
    };
  
    $iperl->load_plugin('Perlbrew') unless $iperl->can('perlbrew');
  
    for my $name (qw{cpanm cpanm_info cpanm_installdeps}) {
      $iperl->helper($name => sub {
        my ($ip, $ret, %env) = (shift, -1);
        eval 'require App::cpanminus::fatscript; 1;';
        return $ret if $@;
        return $ret if 0 == @_; # nothing to do?
        my @filtered = @_;
        my $cpanm = App::cpanminus::script->new(
          @{$options->{$name}},
          argv => [@filtered]);
        $cpanm->parse_options();
        $cpanm->{interactive} = 0;
        delete $cpanm->{action}
          if exists $cpanm->{action} and $cpanm->{action} =~ m/upgrade/;
        return $cpanm->doit;
      });
    }
    return 1;
  }
  
  1;
  
  =pod
  
  =head1 NAME
  
  Devel::IPerl::Plugin::CpanMinus - cpanm client
  
  =head1 DESCRIPTION
  
  This plugin enables users to curate L<local::lib> as set up in
  L<Devel::IPerl::Plugin::Perlbrew>.
  
  Once users have access to L<Devel::IPerl::Plugin::Perlbrew> they wish to have
  the ability to curate the libraries they
  L<create|Devel::IPerl::Plugin::Perlbrew#perlbrew_lib_create>. While this is easy
  to achieve at the command line, the notebook is an excellent place to document
  this workflow as well.
  
  =head1 SYNOPSIS
  
    IPerl->load_plugin('CpanMinus') unless IPerl->can('cpanm');
    # create and use a library
    IPerl->perlbrew_lib_create('cpanm-test');
    IPerl->perlbrew('cpanm-test');
    # install dependencies for notebook
    IPerl->cpanm_installdeps('.');
    # install a specific module
    IPerl->cpanm('Test::Pod');
  
  =head1 IPerl Interface Method
  
  =head2 register
  
  Called by C<<< IPerl->load_plugin('CpanMinus') >>>.
  
  =head1 REGISTERED METHODS
  
  These all take as arguments any arguments that are accepted by the command line
  client L<cpanm>.
  
  =head2 cpanm
  
    # install a specific module
    IPerl->cpanm('Test::Pod');
  
  Use L<cpanm> to install the given module.
  
  =head2 cpanm_info
  
    IPerl->cpanm_info('Test::Pod');
  
  Displays the distribution information in "AUTHOR/Dist-Name-ver.tar.gz" format.
  
  =head2 cpanm_installdeps
  
    # install dependencies as listed in cpanfile in current directory
    IPerl->cpanm_installdeps('.');
    # install dependencies for a module
    IPerl->cpanm_installdeps('-n', '--quiet', 'Test::Pod');
  
  =cut
DEVEL_IPERL_PLUGIN_CPANMINUS

$fatpacked{"Devel/IPerl/Plugin/Perlbrew.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'DEVEL_IPERL_PLUGIN_PERLBREW';
  package Devel::IPerl::Plugin::Perlbrew;
  
  use strict;
  use warnings;
  use feature 'say';
  use Symbol 'delete_package';
  use constant DEBUG => $ENV{IPERL_PLUGIN_PERLBREW_DEBUG} ? 1 : 0;
  
  use constant PERLBREW_CLASS => $ENV{IPERL_PLUGIN_PERLBREW_CLASS}
    ? $ENV{IPERL_PLUGIN_PERLBREW_CLASS}
    : 'App::perlbrew';
  
  use constant PERLBREW_INSTALLED => eval 'use '. PERLBREW_CLASS.'; 1' ? 1 : 0;
  
  our $VERSION = '0.02';
  
  sub brew {
    my $self = shift;
    my %env  = %{$self->env || {}};
    my %save = ();
    for my $var(_filtered_env_keys(\%env)) {
      say STDERR "@$self{name} ", join " = ", $var, $env{$var} if DEBUG;
      $save{$var} = $ENV{$var} if exists $ENV{$var};
      $ENV{$var} = $env{$var};
    }
    if ($env{PERL5LIB}) {
      say STDERR join " = ", 'PERL5LIB', $env{'PERL5LIB'} if DEBUG;
      eval "use lib split ':', q[$env{PERL5LIB}];";
      warn $@ if $@; ## uncoverable branch true
    }
    return $self->saved(\%save);
  }
  
  sub env { return $_[0]{env}  if @_ == 1; $_[0]{env}  = $_[1]; $_[0]; }
  
  sub new {
    my $class = shift;
    bless @_ ? @_ > 1 ? {@_} : {%{$_[0]}} : {}, ref $class || $class;
  }
  
  sub name { return $_[0]{name} if @_ == 1; $_[0]{name} = $_[1]; $_[0]; }
  
  sub register {
    my ($class, $iperl) = @_;
  
    my $domain = sub {
      my $instance = $_[0]->instance;
      return $instance->{'perlbrew_domain'} if @_ == 1;
      $instance->{'perlbrew_domain'} = $_[1];
      $instance;
    };
  
    $domain->($iperl, $ENV{'PERLBREW_HOME'});
  
    for my $name (qw{perlbrew}) {
      my $current = $class->new->name('@@@'); ## impossible name
  
      $iperl->helper($name => sub {
        my ($ip, $lib, $unload, $ret) = (shift, shift, shift || 0, -1);
        return $ret if not defined $lib;
        return $ret if 0 == PERLBREW_INSTALLED;
  
        my $new = $class->new->name($class->_make_name($lib));
        if ($current->unload($unload)->name ne $new->name) {
          my $pb = PERLBREW_CLASS->new();
          $pb->home($domain->($ip));
          $new->env({ $pb->perlbrew_env($new->name) });
          ## ensure the timing of the DESTROY, spoil
          undef($current = $current->spoil);
          $current = $new->brew;
        }
        return $new->success;
      });
    }
  
    for my $name (qw{list list_modules}) {
      $iperl->helper("perlbrew_$name" => sub {
        my ($ip, $ret) = (shift, -1);
        return $ret if 0 == PERLBREW_INSTALLED;
        my $pb = PERLBREW_CLASS->new();
        $pb->home($domain->($ip));
        local $App::perlbrew::PERLBREW_HOME = $pb->home
          if ($name eq 'list_modules');
        return $pb->run_command($name, @_);
      });
    }
  
    for my $name (qw{lib_create}) {
      $iperl->helper("perlbrew_$name" => sub {
        my ($ip, $lib, $ret) = (shift, shift, -1);
        return $ret if not defined $lib;
        return $ret if 0 == PERLBREW_INSTALLED;
        my $pb = PERLBREW_CLASS->new();
        $pb->home($domain->($ip));
        eval { $pb->run_command_lib_create($class->_make_name($lib)); };
        return $@ ? 0 : 1;
      });
    }
  
    $iperl->helper('perlbrew_domain' => sub {
      my ($ip, $dir) = (shift, shift);
      return $domain->($ip) unless $dir && -d $dir;
      return $domain->($ip, $dir)->{'perlbrew_domain'};
    });
  
    return 1;
  }
  
  sub saved { return $_[0]{saved}  if @_ == 1; $_[0]{saved}  = $_[1]; $_[0]; }
  
  sub spoil {
    my $self = shift;
    my %env  = %{$self->env || {}};
    my %save = %{$self->saved || {}};
    for my $var(_filtered_env_keys(\%env)) {
      if (exists $save{$var}) {
        say STDERR "revert ", join " = ", $var, $save{$var} if DEBUG;
        $ENV{$var} = $save{$var};
      } else {
        say STDERR "unset ", $var if DEBUG;
        delete $ENV{$var};
      }
    }
    if ($env{PERL5LIB}) {
      say STDERR join " = ", 'PERL5LIB', $env{'PERL5LIB'} if DEBUG;
      eval "no lib split ':', q[$env{PERL5LIB}];";
      warn $@ if $@; ## uncoverable branch true
      if ($self->unload) {
        my $path_re = qr{\Q$env{PERL5LIB}\E};
        for my $module_path(keys %INC) {
          ## autosplit modules
          next if $module_path =~ m{\.(al|ix)$} && delete $INC{$module_path};
          ## global destruction ?
          next if not defined $INC{$module_path};
          ## FatPacked ?
          next if ref($INC{$module_path});
          ## Not part of this PERL5LIB
          next if $INC{$module_path} !~ m{^$path_re};
          ## translate to class_path
          (my $class = $module_path) =~ s{/}{::}g;
          $class =~ s/\.pm//;
          ## notify and unload
          say "unloading $class ($module_path) from $INC{$module_path}";
          _teardown( $class );
          delete $INC{$module_path};
        }
      }
    }
    # no need to revert again.
    return $self->env({})->saved({});
  }
  
  sub success { scalar(keys %{$_[0]->{env}}) ? 1 : 0; }
  
  sub unload { return $_[0]{unload} if @_ == 1; $_[0]{unload} = $_[1]; $_[0]; }
  
  sub _filtered_env_keys {
    return (sort grep { m/^PERL/i && $_ ne "PERL5LIB" } keys %{+pop});
  }
  
  sub _from_binary_path {
    say STDERR $^X if DEBUG;
    if ($^X =~ m{/perls/([^/]+)/bin/perl}) { return $1; }
    (my $v = $^V->normal) =~ s/v/perl-/;
    return $v;
  }
  
  sub _make_name {
    my ($class, $name, $current) =
      (shift, shift, $ENV{PERLBREW_PERL} || _from_binary_path());
    my ($perl, $lib) =
      split /\@/, ($name =~ m/\@/ || $name eq $current ? $name : "\@$name");
    $perl = $current;
    return $perl unless $lib;
    return join '@', $perl, $lib;
  }
  
  ## from Mojo::Util
  sub _teardown {
    return unless my $class = shift;
    # @ISA has to be cleared first because of circular references
    no strict 'refs';
    @{"${class}::ISA"} = ();
    delete_package $class;
  }
  
  sub DESTROY {
    my $self = shift;
    say STDERR "DESTROY $self @$self{name}" if DEBUG;
    $self->spoil;
    return ;
  }
  
  1;
  
  =pod
  
  =head1 NAME
  
  Devel::IPerl::Plugin::Perlbrew - interact with L<perlbrew> in L<Jupyter|https://jupyter.org> IPerl kernel
  
  =begin html
  
  <!--- Travis --->
  <a href="https://travis-ci.org/kiwiroy/Devel-IPerl-Plugin-Perlbrew">
    <img src="https://travis-ci.org/kiwiroy/Devel-IPerl-Plugin-Perlbrew.svg?branch=master"
         alt="Build Status" />
  </a>
  
  <!-- Coveralls -->
  <a href='https://coveralls.io/github/kiwiroy/Devel-IPerl-Plugin-Perlbrew?branch=master'>
    <img src='https://coveralls.io/repos/github/kiwiroy/Devel-IPerl-Plugin-Perlbrew/badge.svg?branch=master'
         alt='Coverage Status' />
  </a>
  
  <!-- Kritika -->
  <a href="https://kritika.io/users/kiwiroy/repos/6870682787977901/heads/master/">
    <img src="https://kritika.io/users/kiwiroy/repos/6870682787977901/heads/master/status.svg"
         alt="Kritika Analysis Status"/>
  </a>
  
  =end html
  
  =head1 DESCRIPTION
  
  In a shared server environment the Perl module needs of multiple users can be
  met most easily with access to L<perlbrew> and the ability to install perl
  modules under their own libraries. A user can generate a L<cpanfile> to
  facilitate the creation of these libraries in a reproducible manner. At the
  command line a typical workflow in such an environment might appear thus:
  
    perlbrew lib create perl-5.26.0@reproducible
    perlbrew use perl-5.26.0@reproducible
    ## assuming a cpanfile
    cpanm --installdeps .
  
  During the analysis that utilises such codebases using a JupyterHub on the same
  environment a user will wish to access these installed modules in a way that is
  as simple as the command line and within the framework of a Jupyter notebook.
  
  This plugin is designed to easily transition between command line and Jupyter
  with similar syntax and little overhead.
  
  =begin html
  
  <p>There are some Jupyter notebooks in the <a href="./examples/">examples directory</a></p>
  
  =end html
  
  =head1 SYNOPSIS
  
    IPerl->load_plugin('Perlbrew') unless IPerl->can('perlbrew');
    IPerl->perlbrew_list();
    IPerl->perlbrew_list_modules();
  
    IPerl->perlbrew('perl-5.26.0@reproducible');
  
  =head1 INSTALLATION AND REQUISITES
  
    ## install dependencies
    cpanm --installdeps --quiet .
    ## install
    cpanm .
  
  If there are some issues with L<Devel::IPerl> installing refer to their
  L<README.md|https://github.com/EntropyOrg/p5-Devel-IPerl>. The C<.travis.yml> in
  this repository might provide sources of help.
  
  L<App::perlbrew> is a requirement and it is B<suggested> that L<Devel::IPerl> is
  deployed into a L<perlbrew> installed L<perl|perlbrew#COMMAND:-INSTALL> and call
  the L</"perlbrew"> function to use each L<library|perlbrew#COMMAND:-LIB>.
  
  =over 4
  
  =item installing perlbrew
  
  For a single user use case the recommended install proceedure at
  L<https://perlbrew.pl> should be used. If installing for a shared environment
  and JupyterHub, the following may act as a template.
  
    version=0.82
    mkdir -p /sw/perlbrew-$version
    export PERLBREW_ROOT=!$
    curl -L https://install.perlbrew.pl | bash
  
  =item installing iperl
  
  The kernel specification needs to be installed so that Jupyter can find it. This
  is achieved thus:
  
    iperl --version
  
  =item perlbrew-ise the kernel
  
  The kernel specification should be updated to make the environment variables,
  that L<App::perlbrew> relies on, available. Included in this dist is the command
  C<perlbrewise-spec>.
  
    perlbrewise-spec
  
  =back
  
  =head1 IPerl Interface Method
  
  =head2 register
  
  Called by C<<< IPerl->load_plugin('Perlbrew') >>>.
  
  =head1 REGISTERED METHODS
  
  =head2 perlbrew
  
    # 1 - success
    IPerl->perlbrew('perl-5.26.0@reproducible');
    # 0 - it is already loaded
    IPerl->perlbrew('perl-5.26.0@reproducible');
    # -1 - no library specified
    IPerl->perlbrew();
    # 1 - success switching off reproducible and reverting to perl-5.26.0
    IPerl->perlbrew($ENV{'PERLBREW_PERL'});
  
  This is identical to C<<< perlbrew use perl-5.26.0@reproducible >>> and will
  switch any from any previous call. Returns C<1>, C<0> or C<-1> for I<success>,
  I<no change> and I<error> respectively. A name for the library is required. To
  revert to the I<"system"> or non-library version pass the value of
  C<$ENV{PERLBREW_PERL}>.
  
    IPerl->perlbrew('perl-5.26.0@tutorial', 1);
  
  The function takes a Boolean as an optional second argument. A I<true> value will
  result in all the modules that were loaded during the activity of the previous
  library to be unloaded using L<delete_package|Symbol>. The default value is
  I<false> as setting is to true might expose the L<unexpected|Symbol#BUGS>
  behaviour.
  
  When using multiple L<perlbrew> libraries it may be possible to use modules from
  both, although this is not a recommended use.
  
    IPerl->perlbrew('perl-5.26.0@tutorial');
    use Jupyter::Tutorial::Simple;
    ## run some code
  
    ## load @reproducible, but do not unload Jupyter::Tutorial::Simple
    IPerl->perlbrew('perl-5.26.0@reproducible', 0);
    use Bio::Taxonomy;
    ## ... more code, possibly using Jupyter::Tutorial::Simple
  
  =head2 perlbrew_domain
  
  B<This is experimental>.
  
    # /home/username/.perlbrew
    IPerl->perlbrew_domain;
    # /work/username/perlbrew-libs
    IPerl->perlbrew_domain('/work/username/perlbrew-libs');
  
  Users often generate a large number of libraries which can quickly result in a
  long list generated in the output of L</"perlbrew_list">. This experimental
  feature allows for switching between I<domains> to reduce the size of these
  lists. Thus, a collection of libraries are organised under domains. These are
  only directories, must exist before use and are synonymous with
  C<$ENV{PERLBREW_HOME}>. Indeed, this is a convenient alternative to
  C<$App::perlbrew::PERLBREW_HOME>.
  
  =head2 perlbrew_lib_create
  
    # 1 - success
    IPerl->perlbrew_lib_create('reproducible');
    # 0 - already exists
    IPerl->perlbrew_lib_create('reproducible');
    # -1 - no library name given
    IPerl->perlbrew_lib_create();
  
  This is identical to C<<< perlbrew lib create >>>. Returns C<1>, C<0> or C<-1>
  for I<success>, I<already exists> and I<error> respectively.
  
  =head2 perlbrew_list
  
    IPerl->perlbrew_list;
  
  This is identical to C<<< perlbrew list >>> and will output the same information.
  
  =head2 perlbrew_list_modules
  
    IPerl->perlbrew_list_modules;
  
  This is identical to C<<< perlbrew list_modules >>> and will output the same
  information.
  
  =head1 ENVIRONMENT VARIABLES
  
  The following environment variables alter the behaviour of the plugin.
  
  =over 4
  
  =item IPERL_PLUGIN_PERLBREW_DEBUG
  
  A logical to control how verbose the plugin is during its activities.
  
  =item IPERL_PLUGIN_PERLBREW_CLASS
  
  This defaults to L<App::prelbrew>
  
  =back
  
  =head1 INTERNAL INTERFACES
  
  These are part of the internal interface and not designed for end user
  consumption.
  
  =head2 brew
  
    $plugin->brew;
  
  Use the perlbrew library specified in L</"name">.
  
  =head2 env
  
    $plugin->env({PERLBREW_ROOT => '/sw/perlbrew', ...});
    # {PERLBREW_ROOT => '/sw/perlbrew', ...}
    $plugin->env;
  
  An accessor that stores the environment from L<App::perlbrew> for a subsequent
  call to L</"brew">.
  
  =head2 new
  
    my $plugin = Devel::IPerl::Plugin::Perlbrew->new();
  
  Instantiate an object.
  
  =head2 name
  
    $plugin->name('perl-5.26.0@reproducible');
    # perl-5.26.0@reproducible
    $plugin->name;
  
  An accessor for the name of the perlbrew library.
  
  =head2 saved
  
    $plugin->saved;
  
  An accessor for the previous environment variables so they may be restored as
  the L</"brew"> L</"spoil">s.
  
  =head2 spoil
  
    $plugin->spoil;
  
  When a L</"brew"> is finished with. This is called automatically during object
  destruction.
  
  =head2 success
  
    # boolean where 1 == success, 0 == not success
    $plugin->success;
  
  Was everything a success?
  
  =head2 unload
  
    $plugin->unload(1);
    # 1
    $plugin->unload;
  
  A flag to determine whether to unload all the modules that were used as part of
  this library during cleanup.
  
  =cut
DEVEL_IPERL_PLUGIN_PERLBREW

$fatpacked{"JSON/MaybeXS.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'JSON_MAYBEXS';
  package JSON::MaybeXS;
  
  use strict;
  use warnings FATAL => 'all';
  use base qw(Exporter);
  
  our $VERSION = '1.003010';
  $VERSION = eval $VERSION;
  
  sub _choose_json_module {
      return 'Cpanel::JSON::XS' if $INC{'Cpanel/JSON/XS.pm'};
      return 'JSON::XS'         if $INC{'JSON/XS.pm'};
  
      my @err;
  
      return 'Cpanel::JSON::XS' if eval { require Cpanel::JSON::XS; 1; };
      push @err, "Error loading Cpanel::JSON::XS: $@";
  
      return 'JSON::XS' if eval { require JSON::XS; 1; };
      push @err, "Error loading JSON::XS: $@";
  
      return 'JSON::PP' if eval { require JSON::PP; 1 };
      push @err, "Error loading JSON::PP: $@";
  
      die join( "\n", "Couldn't load a JSON module:", @err );
  
  }
  
  BEGIN {
      our $JSON_Class = _choose_json_module();
      $JSON_Class->import(qw(encode_json decode_json));
  }
  
  our @EXPORT = qw(encode_json decode_json JSON);
  my @EXPORT_ALL = qw(is_bool);
  our @EXPORT_OK = qw(is_bool to_json from_json);
  our %EXPORT_TAGS = ( all => [ @EXPORT, @EXPORT_ALL ],
                       legacy => [ @EXPORT, @EXPORT_OK ],
                     );
  
  sub JSON () { our $JSON_Class }
  
  sub new {
    shift;
    my %args = @_ == 1 ? %{$_[0]} : @_;
    my $new = (our $JSON_Class)->new;
    $new->$_($args{$_}) for keys %args;
    return $new;
  }
  
  use Scalar::Util ();
  
  sub is_bool {
    die 'is_bool is not a method' if $_[1];
  
    Scalar::Util::blessed($_[0])
      and ($_[0]->isa('JSON::XS::Boolean')
        or $_[0]->isa('Cpanel::JSON::XS::Boolean')
        or $_[0]->isa('JSON::PP::Boolean'));
  }
  
  # (mostly) CopyPasta from JSON.pm version 2.90
  use Carp ();
  
  sub from_json ($@) {
      if ( ref($_[0]) =~ /^JSON/ or $_[0] =~ /^JSON/ ) {
          Carp::croak "from_json should not be called as a method.";
      }
      my $json = JSON()->new;
  
      if (@_ == 2 and ref $_[1] eq 'HASH') {
          my $opt  = $_[1];
          for my $method (keys %$opt) {
              $json->$method( $opt->{$method} );
          }
      }
  
      return $json->decode( $_[0] );
  }
  
  sub to_json ($@) {
      if (
          ref($_[0]) =~ /^JSON/
          or (@_ > 2 and $_[0] =~ /^JSON/)
            ) {
                 Carp::croak "to_json should not be called as a method.";
      }
      my $json = JSON()->new;
  
      if (@_ == 2 and ref $_[1] eq 'HASH') {
          my $opt  = $_[1];
          for my $method (keys %$opt) {
              $json->$method( $opt->{$method} );
          }
      }
  
      $json->encode($_[0]);
  }
  
  1;
  
  =head1 NAME
  
  JSON::MaybeXS - Use L<Cpanel::JSON::XS> with a fallback to L<JSON::XS> and L<JSON::PP>
  
  =head1 SYNOPSIS
  
    use JSON::MaybeXS;
  
    my $data_structure = decode_json($json_input);
  
    my $json_output = encode_json($data_structure);
  
    my $json = JSON()->new;
  
    my $json_with_args = JSON::MaybeXS->new(utf8 => 1); # or { utf8 => 1 }
  
  =head1 DESCRIPTION
  
  This module first checks to see if either L<Cpanel::JSON::XS> or
  L<JSON::XS> is already loaded, in which case it uses that module. Otherwise
  it tries to load L<Cpanel::JSON::XS>, then L<JSON::XS>, then L<JSON::PP>
  in order, and either uses the first module it finds or throws an error.
  
  It then exports the C<encode_json> and C<decode_json> functions from the
  loaded module, along with a C<JSON> constant that returns the class name
  for calling C<new> on.
  
  If you're writing fresh code rather than replacing L<JSON.pm|JSON> usage, you might
  want to pass options as constructor args rather than calling mutators, so
  we provide our own C<new> method that supports that.
  
  =head1 EXPORTS
  
  C<encode_json>, C<decode_json> and C<JSON> are exported by default; C<is_bool>
  is exported on request.
  
  To import only some symbols, specify them on the C<use> line:
  
    use JSON::MaybeXS qw(encode_json decode_json is_bool); # functions only
  
    use JSON::MaybeXS qw(JSON); # JSON constant only
  
  To import all available sensible symbols (C<encode_json>, C<decode_json>, and
  C<is_bool>), use C<:all>:
  
    use JSON::MaybeXS ':all';
  
  To import all symbols including those needed by legacy apps that use L<JSON::PP>:
  
    use JSON::MaybeXS ':legacy';
  
  This imports the C<to_json> and C<from_json> symbols as well as everything in
  C<:all>.  NOTE: This is to support legacy code that makes extensive
  use of C<to_json> and C<from_json> which you are not yet in a position to
  refactor.  DO NOT use this import tag in new code, in order to avoid
  the crawling horrors of getting UTF-8 support subtly wrong.  See the
  documentation for L<JSON> for further details.
  
  =head2 encode_json
  
  This is the C<encode_json> function provided by the selected implementation
  module, and takes a perl data structure which is serialised to JSON text.
  
    my $json_text = encode_json($data_structure);
  
  =head2 decode_json
  
  This is the C<decode_json> function provided by the selected implementation
  module, and takes a string of JSON text to deserialise to a perl data structure.
  
    my $data_structure = decode_json($json_text);
  
  =head2 to_json, from_json
  
  See L<JSON> for details.  These are included to support legacy code
  B<only>.
  
  =head2 JSON
  
  The C<JSON> constant returns the selected implementation module's name for
  use as a class name - so:
  
    my $json_obj = JSON()->new; # returns a Cpanel::JSON::XS or JSON::PP object
  
  and that object can then be used normally:
  
    my $data_structure = $json_obj->decode($json_text); # etc.
  
  The use of parentheses here is optional, and only used as a hint to the reader
  that this use of C<JSON> is a I<subroutine> call, I<not> a class name.
  
  =head2 is_bool
  
    $is_boolean = is_bool($scalar)
  
  Returns true if the passed scalar represents either C<true> or
  C<false>, two constants that act like C<1> and C<0>, respectively
  and are used to represent JSON C<true> and C<false> values in Perl.
  
  Since this is a bare sub in the various backend classes, it cannot be called as
  a class method like the other interfaces; it must be called as a function, with
  no invocant.  It supports the representation used in all JSON backends.
  
  =head1 CONSTRUCTOR
  
  =head2 new
  
  With L<JSON::PP>, L<JSON::XS> and L<Cpanel::JSON::XS> you are required to call
  mutators to set options, such as:
  
    my $json = $class->new->utf8(1)->pretty(1);
  
  Since this is a trifle irritating and noticeably un-perlish, we also offer:
  
    my $json = JSON::MaybeXS->new(utf8 => 1, pretty => 1);
  
  which works equivalently to the above (and in the usual tradition will accept
  a hashref instead of a hash, should you so desire).
  
  The resulting object is blessed into the underlying backend, which offers (at
  least) the methods C<encode> and C<decode>.
  
  =head1 BOOLEANS
  
  To include JSON-aware booleans (C<true>, C<false>) in your data, just do:
  
      use JSON::MaybeXS;
      my $true = JSON()->true;
      my $false = JSON()->false;
  
  =head1 CONVERTING FROM JSON::Any
  
  L<JSON::Any> used to be the favoured compatibility layer above the various
  JSON backends, but over time has grown a lot of extra code to deal with legacy
  backends (e.g. L<JSON::Syck>) that are no longer needed.  This is a rough guide of translating such code:
  
  Change code from:
  
      use JSON::Any;
      my $json = JSON::Any->new->objToJson($data);    # or to_json($data), or Dump($data)
  
  to:
  
      use JSON::MaybeXS;
      my $json = encode_json($data);
  
  
  Change code from:
  
      use JSON::Any;
      my $data = JSON::Any->new->jsonToObj($json);    # or from_json($json), or Load($json)
  
  to:
  
      use JSON::MaybeXS;
      my $json = decode_json($data);
  
  =head1 CAVEATS
  
  The C<new()> method in this module is technically a factory, not a
  constructor, because the objects it returns will I<NOT> be blessed into the
  C<JSON::MaybeXS> class.
  
  If you are using an object returned by this module as a Moo(se) attribute,
  this type constraint code:
  
      is 'json' => ( isa => 'JSON::MaybeXS' );
  
  will I<NOT> do what you expect. Instead, either rely on the C<JSON> class
  constant described above, as so:
  
      is 'json' => ( isa => JSON::MaybeXS::JSON() );
  
  Alternatively, you can use duck typing:
  
      use Moose::Util::TypeConstraints 'duck_type';
      is 'json' => ( isa => Object , duck_type([qw/ encode decode /]));
  
  =head1 INSTALLATION
  
  At installation time, F<Makefile.PL> will attempt to determine if you have a
  working compiler available, and therefore whether you are able to run XS code.
  If so, L<Cpanel::JSON::XS> will be added to the prerequisite list, unless
  L<JSON::XS> is already installed at a high enough version. L<JSON::XS> may
  also be upgraded to fix any incompatibility issues.
  
  Because running XS code is not mandatory and L<JSON::PP> (which is in perl
  core) is used as a fallback backend, this module is safe to be used in a suite
  of code that is fatpacked or installed into a restricted-resource environment.
  
  You can also prevent any XS dependencies from being installed by setting
  C<PUREPERL_ONLY=1> in F<Makefile.PL> options (or in the C<PERL_MM_OPT>
  environment variable), or using the C<--pp> or C<--pureperl> flags with the
  L<cpanminus client|cpanm>.
  
  =head1 AUTHOR
  
  mst - Matt S. Trout (cpan:MSTROUT) <mst@shadowcat.co.uk>
  
  =head1 CONTRIBUTORS
  
  =over 4
  
  =item * Clinton Gormley <drtech@cpan.org>
  
  =item * Karen Etheridge <ether@cpan.org>
  
  =item * Kieren Diment <diment@gmail.com>
  
  =back
  
  =head1 COPYRIGHT
  
  Copyright (c) 2013 the C<JSON::MaybeXS> 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.
  
  =cut
JSON_MAYBEXS

$fatpacked{"Path/Class.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PATH_CLASS';
  use strict;
  
  package Path::Class;
  {
    $Path::Class::VERSION = '0.37';
  }
  
  {
    ## no critic
    no strict 'vars';
    @ISA = qw(Exporter);
    @EXPORT    = qw(file dir);
    @EXPORT_OK = qw(file dir foreign_file foreign_dir tempdir);
  }
  
  use Exporter;
  use Path::Class::File;
  use Path::Class::Dir;
  use File::Temp ();
  
  sub file { Path::Class::File->new(@_) }
  sub dir  { Path::Class::Dir ->new(@_) }
  sub foreign_file { Path::Class::File->new_foreign(@_) }
  sub foreign_dir  { Path::Class::Dir ->new_foreign(@_) }
  sub tempdir { Path::Class::Dir->new(File::Temp::tempdir(@_)) }
  
  
  1;
  __END__
  
  =head1 NAME
  
  Path::Class - Cross-platform path specification manipulation
  
  =head1 VERSION
  
  version 0.37
  
  =head1 SYNOPSIS
  
    use Path::Class;
    
    my $dir  = dir('foo', 'bar');       # Path::Class::Dir object
    my $file = file('bob', 'file.txt'); # Path::Class::File object
    
    # Stringifies to 'foo/bar' on Unix, 'foo\bar' on Windows, etc.
    print "dir: $dir\n";
    
    # Stringifies to 'bob/file.txt' on Unix, 'bob\file.txt' on Windows
    print "file: $file\n";
    
    my $subdir  = $dir->subdir('baz');  # foo/bar/baz
    my $parent  = $subdir->parent;      # foo/bar
    my $parent2 = $parent->parent;      # foo
    
    my $dir2 = $file->dir;              # bob
  
    # Work with foreign paths
    use Path::Class qw(foreign_file foreign_dir);
    my $file = foreign_file('Mac', ':foo:file.txt');
    print $file->dir;                   # :foo:
    print $file->as_foreign('Win32');   # foo\file.txt
    
    # Interact with the underlying filesystem:
    
    # $dir_handle is an IO::Dir object
    my $dir_handle = $dir->open or die "Can't read $dir: $!";
    
    # $file_handle is an IO::File object
    my $file_handle = $file->open($mode) or die "Can't read $file: $!";
  
  =head1 DESCRIPTION
  
  C<Path::Class> is a module for manipulation of file and directory
  specifications (strings describing their locations, like
  C<'/home/ken/foo.txt'> or C<'C:\Windows\Foo.txt'>) in a cross-platform
  manner.  It supports pretty much every platform Perl runs on,
  including Unix, Windows, Mac, VMS, Epoc, Cygwin, OS/2, and NetWare.
  
  The well-known module L<File::Spec> also provides this service, but
  it's sort of awkward to use well, so people sometimes avoid it, or use
  it in a way that won't actually work properly on platforms
  significantly different than the ones they've tested their code on.
  
  In fact, C<Path::Class> uses C<File::Spec> internally, wrapping all
  the unsightly details so you can concentrate on your application code.
  Whereas C<File::Spec> provides functions for some common path
  manipulations, C<Path::Class> provides an object-oriented model of the
  world of path specifications and their underlying semantics.
  C<File::Spec> doesn't create any objects, and its classes represent
  the different ways in which paths must be manipulated on various
  platforms (not a very intuitive concept).  C<Path::Class> creates
  objects representing files and directories, and provides methods that
  relate them to each other.  For instance, the following C<File::Spec>
  code:
  
   my $absolute = File::Spec->file_name_is_absolute(
                    File::Spec->catfile( @dirs, $file )
                  );
  
  can be written using C<Path::Class> as
  
   my $absolute = Path::Class::File->new( @dirs, $file )->is_absolute;
  
  or even as 
  
   my $absolute = file( @dirs, $file )->is_absolute;
  
  Similar readability improvements should happen all over the place when
  using C<Path::Class>.
  
  Using C<Path::Class> can help solve real problems in your code too -
  for instance, how many people actually take the "volume" (like C<C:>
  on Windows) into account when writing C<File::Spec>-using code?  I
  thought not.  But if you use C<Path::Class>, your file and directory objects
  will know what volumes they refer to and do the right thing.
  
  The guts of the C<Path::Class> code live in the L<Path::Class::File>
  and L<Path::Class::Dir> modules, so please see those
  modules' documentation for more details about how to use them.
  
  =head2 EXPORT
  
  The following functions are exported by default.
  
  =over 4
  
  =item file
  
  A synonym for C<< Path::Class::File->new >>.
  
  =item dir
  
  A synonym for C<< Path::Class::Dir->new >>.
  
  =back
  
  If you would like to prevent their export, you may explicitly pass an
  empty list to perl's C<use>, i.e. C<use Path::Class ()>.
  
  The following are exported only on demand.
  
  =over 4
  
  =item foreign_file
  
  A synonym for C<< Path::Class::File->new_foreign >>.
  
  =item foreign_dir
  
  A synonym for C<< Path::Class::Dir->new_foreign >>.
  
  =item tempdir
  
  Create a new Path::Class::Dir instance pointed to temporary directory.
  
    my $temp = Path::Class::tempdir(CLEANUP => 1);
  
  A synonym for C<< Path::Class::Dir->new(File::Temp::tempdir(@_)) >>.
  
  =back
  
  =head1 Notes on Cross-Platform Compatibility
  
  Although it is much easier to write cross-platform-friendly code with
  this module than with C<File::Spec>, there are still some issues to be
  aware of.
  
  =over 4
  
  =item *
  
  On some platforms, notably VMS and some older versions of DOS (I think),
  all filenames must have an extension.  Thus if you create a file
  called F<foo/bar> and then ask for a list of files in the directory
  F<foo>, you may find a file called F<bar.> instead of the F<bar> you
  were expecting.  Thus it might be a good idea to use an extension in
  the first place.
  
  =back
  
  =head1 AUTHOR
  
  Ken Williams, KWILLIAMS@cpan.org
  
  =head1 COPYRIGHT
  
  Copyright (c) Ken Williams.  All rights reserved.
  
  This library is free software; you can redistribute it and/or
  modify it under the same terms as Perl itself.
  
  
  =head1 SEE ALSO
  
  L<Path::Class::Dir>, L<Path::Class::File>, L<File::Spec>
  
  =cut
PATH_CLASS

$fatpacked{"Path/Class/Dir.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PATH_CLASS_DIR';
  use strict;
  
  package Path::Class::Dir;
  {
    $Path::Class::Dir::VERSION = '0.37';
  }
  
  use Path::Class::File;
  use Carp();
  use parent qw(Path::Class::Entity);
  
  use IO::Dir ();
  use File::Path ();
  use File::Temp ();
  use Scalar::Util ();
  
  # updir & curdir on the local machine, for screening them out in
  # children().  Note that they don't respect 'foreign' semantics.
  my $Updir  = __PACKAGE__->_spec->updir;
  my $Curdir = __PACKAGE__->_spec->curdir;
  
  sub new {
    my $self = shift->SUPER::new();
  
    # If the only arg is undef, it's probably a mistake.  Without this
    # special case here, we'd return the root directory, which is a
    # lousy thing to do to someone when they made a mistake.  Return
    # undef instead.
    return if @_==1 && !defined($_[0]);
  
    my $s = $self->_spec;
    
    my $first = (@_ == 0     ? $s->curdir :
  	       !ref($_[0]) && $_[0] eq '' ? (shift, $s->rootdir) :
  	       shift()
  	      );
    
    $self->{dirs} = [];
    if ( Scalar::Util::blessed($first) && $first->isa("Path::Class::Dir") ) {
      $self->{volume} = $first->{volume};
      push @{$self->{dirs}}, @{$first->{dirs}};
    }
    else {
      ($self->{volume}, my $dirs) = $s->splitpath( $s->canonpath("$first") , 1);
      push @{$self->{dirs}}, $dirs eq $s->rootdir ? "" : $s->splitdir($dirs);
    }
  
    push @{$self->{dirs}}, map {
      Scalar::Util::blessed($_) && $_->isa("Path::Class::Dir")
        ? @{$_->{dirs}}
        : $s->splitdir( $s->canonpath($_) )
    } @_;
  
  
    return $self;
  }
  
  sub file_class { "Path::Class::File" }
  
  sub is_dir { 1 }
  
  sub as_foreign {
    my ($self, $type) = @_;
  
    my $foreign = do {
      local $self->{file_spec_class} = $self->_spec_class($type);
      $self->SUPER::new;
    };
    
    # Clone internal structure
    $foreign->{volume} = $self->{volume};
    my ($u, $fu) = ($self->_spec->updir, $foreign->_spec->updir);
    $foreign->{dirs} = [ map {$_ eq $u ? $fu : $_} @{$self->{dirs}}];
    return $foreign;
  }
  
  sub stringify {
    my $self = shift;
    my $s = $self->_spec;
    return $s->catpath($self->{volume},
  		     $s->catdir(@{$self->{dirs}}),
  		     '');
  }
  
  sub volume { shift()->{volume} }
  
  sub file {
    local $Path::Class::Foreign = $_[0]->{file_spec_class} if $_[0]->{file_spec_class};
    return $_[0]->file_class->new(@_);
  }
  
  sub basename { shift()->{dirs}[-1] }
  
  sub dir_list {
    my $self = shift;
    my $d = $self->{dirs};
    return @$d unless @_;
    
    my $offset = shift;
    if ($offset < 0) { $offset = $#$d + $offset + 1 }
    
    return wantarray ? @$d[$offset .. $#$d] : $d->[$offset] unless @_;
    
    my $length = shift;
    if ($length < 0) { $length = $#$d + $length + 1 - $offset }
    return @$d[$offset .. $length + $offset - 1];
  }
  
  sub components {
    my $self = shift;
    return $self->dir_list(@_);
  }
  
  sub subdir {
    my $self = shift;
    return $self->new($self, @_);
  }
  
  sub parent {
    my $self = shift;
    my $dirs = $self->{dirs};
    my ($curdir, $updir) = ($self->_spec->curdir, $self->_spec->updir);
  
    if ($self->is_absolute) {
      my $parent = $self->new($self);
      pop @{$parent->{dirs}} if @$dirs > 1;
      return $parent;
  
    } elsif ($self eq $curdir) {
      return $self->new($updir);
  
    } elsif (!grep {$_ ne $updir} @$dirs) {  # All updirs
      return $self->new($self, $updir); # Add one more
  
    } elsif (@$dirs == 1) {
      return $self->new($curdir);
  
    } else {
      my $parent = $self->new($self);
      pop @{$parent->{dirs}};
      return $parent;
    }
  }
  
  sub relative {
    # File::Spec->abs2rel before version 3.13 returned the empty string
    # when the two paths were equal - work around it here.
    my $self = shift;
    my $rel = $self->_spec->abs2rel($self->stringify, @_);
    return $self->new( length $rel ? $rel : $self->_spec->curdir );
  }
  
  sub open  { IO::Dir->new(@_) }
  sub mkpath { File::Path::mkpath(shift()->stringify, @_) }
  sub rmtree { File::Path::rmtree(shift()->stringify, @_) }
  
  sub remove {
    rmdir( shift() );
  }
  
  sub traverse {
    my $self = shift;
    my ($callback, @args) = @_;
    my @children = $self->children;
    return $self->$callback(
      sub {
        my @inner_args = @_;
        return map { $_->traverse($callback, @inner_args) } @children;
      },
      @args
    );
  }
  
  sub traverse_if {
    my $self = shift;
    my ($callback, $condition, @args) = @_;
    my @children = grep { $condition->($_) } $self->children;
    return $self->$callback(
      sub {
        my @inner_args = @_;
        return map { $_->traverse_if($callback, $condition, @inner_args) } @children;
      },
      @args
    );
  }
  
  sub recurse {
    my $self = shift;
    my %opts = (preorder => 1, depthfirst => 0, @_);
    
    my $callback = $opts{callback}
      or Carp::croak( "Must provide a 'callback' parameter to recurse()" );
    
    my @queue = ($self);
    
    my $visit_entry;
    my $visit_dir = 
      $opts{depthfirst} && $opts{preorder}
      ? sub {
        my $dir = shift;
        my $ret = $callback->($dir);
        unless( ($ret||'') eq $self->PRUNE ) {
            unshift @queue, $dir->children;
        }
      }
      : $opts{preorder}
      ? sub {
        my $dir = shift;
        my $ret = $callback->($dir);
        unless( ($ret||'') eq $self->PRUNE ) {
            push @queue, $dir->children;
        }
      }
      : sub {
        my $dir = shift;
        $visit_entry->($_) foreach $dir->children;
        $callback->($dir);
      };
    
    $visit_entry = sub {
      my $entry = shift;
      if ($entry->is_dir) { $visit_dir->($entry) } # Will call $callback
      else { $callback->($entry) }
    };
    
    while (@queue) {
      $visit_entry->( shift @queue );
    }
  }
  
  sub children {
    my ($self, %opts) = @_;
    
    my $dh = $self->open or Carp::croak( "Can't open directory $self: $!" );
    
    my @out;
    while (defined(my $entry = $dh->read)) {
      next if !$opts{all} && $self->_is_local_dot_dir($entry);
      next if ($opts{no_hidden} && $entry =~ /^\./);
      push @out, $self->file($entry);
      $out[-1] = $self->subdir($entry) if -d $out[-1];
    }
    return @out;
  }
  
  sub _is_local_dot_dir {
    my $self = shift;
    my $dir  = shift;
  
    return ($dir eq $Updir or $dir eq $Curdir);
  }
  
  sub next {
    my $self = shift;
    unless ($self->{dh}) {
      $self->{dh} = $self->open or Carp::croak( "Can't open directory $self: $!" );
    }
    
    my $next = $self->{dh}->read;
    unless (defined $next) {
      delete $self->{dh};
      ## no critic
      return undef;
    }
    
    # Figure out whether it's a file or directory
    my $file = $self->file($next);
    $file = $self->subdir($next) if -d $file;
    return $file;
  }
  
  sub subsumes {
    Carp::croak "Too many arguments given to subsumes()" if $#_ > 2;
    my ($self, $other) = @_;
    Carp::croak( "No second entity given to subsumes()" ) unless defined $other;
  
    $other = $self->new($other) unless eval{$other->isa( "Path::Class::Entity")};
    $other = $other->dir unless $other->is_dir;
  
    if ($self->is_absolute) {
      $other = $other->absolute;
    } elsif ($other->is_absolute) {
      $self = $self->absolute;
    }
  
    $self = $self->cleanup;
    $other = $other->cleanup;
  
    if ($self->volume || $other->volume) {
      return 0 unless $other->volume eq $self->volume;
    }
  
    # The root dir subsumes everything (but ignore the volume because
    # we've already checked that)
    return 1 if "@{$self->{dirs}}" eq "@{$self->new('')->{dirs}}";
  
    # The current dir subsumes every relative path (unless starting with updir)
    if ($self eq $self->_spec->curdir) {
      return $other->{dirs}[0] ne $self->_spec->updir;
    }
  
    my $i = 0;
    while ($i <= $#{ $self->{dirs} }) {
      return 0 if $i > $#{ $other->{dirs} };
      return 0 if $self->{dirs}[$i] ne $other->{dirs}[$i];
      $i++;
    }
    return 1;
  }
  
  sub contains {
    Carp::croak "Too many arguments given to contains()" if $#_ > 2;
    my ($self, $other) = @_;
    Carp::croak "No second entity given to contains()" unless defined $other;
    return unless -d $self and (-e $other or -l $other);
  
    # We're going to resolve the path, and don't want side effects on the objects
    # so clone them.  This also handles strings passed as $other.
    $self= $self->new($self)->resolve;
    $other= $self->new($other)->resolve;
    
    return $self->subsumes($other);
  }
  
  sub tempfile {
    my $self = shift;
    return File::Temp::tempfile(@_, DIR => $self->stringify);
  }
  
  1;
  __END__
  
  =head1 NAME
  
  Path::Class::Dir - Objects representing directories
  
  =head1 VERSION
  
  version 0.37
  
  =head1 SYNOPSIS
  
    use Path::Class;  # Exports dir() by default
    
    my $dir = dir('foo', 'bar');       # Path::Class::Dir object
    my $dir = Path::Class::Dir->new('foo', 'bar');  # Same thing
    
    # Stringifies to 'foo/bar' on Unix, 'foo\bar' on Windows, etc.
    print "dir: $dir\n";
    
    if ($dir->is_absolute) { ... }
    if ($dir->is_relative) { ... }
    
    my $v = $dir->volume; # Could be 'C:' on Windows, empty string
                          # on Unix, 'Macintosh HD:' on Mac OS
    
    $dir->cleanup; # Perform logical cleanup of pathname
    $dir->resolve; # Perform physical cleanup of pathname
    
    my $file = $dir->file('file.txt'); # A file in this directory
    my $subdir = $dir->subdir('george'); # A subdirectory
    my $parent = $dir->parent; # The parent directory, 'foo'
    
    my $abs = $dir->absolute; # Transform to absolute path
    my $rel = $abs->relative; # Transform to relative path
    my $rel = $abs->relative('/foo'); # Relative to /foo
    
    print $dir->as_foreign('Mac');   # :foo:bar:
    print $dir->as_foreign('Win32'); #  foo\bar
  
    # Iterate with IO::Dir methods:
    my $handle = $dir->open;
    while (my $file = $handle->read) {
      $file = $dir->file($file);  # Turn into Path::Class::File object
      ...
    }
    
    # Iterate with Path::Class methods:
    while (my $file = $dir->next) {
      # $file is a Path::Class::File or Path::Class::Dir object
      ...
    }
  
  
  =head1 DESCRIPTION
  
  The C<Path::Class::Dir> class contains functionality for manipulating
  directory names in a cross-platform way.
  
  =head1 METHODS
  
  =over 4
  
  =item $dir = Path::Class::Dir->new( <dir1>, <dir2>, ... )
  
  =item $dir = dir( <dir1>, <dir2>, ... )
  
  Creates a new C<Path::Class::Dir> object and returns it.  The
  arguments specify names of directories which will be joined to create
  a single directory object.  A volume may also be specified as the
  first argument, or as part of the first argument.  You can use
  platform-neutral syntax:
  
    my $dir = dir( 'foo', 'bar', 'baz' );
  
  or platform-native syntax:
  
    my $dir = dir( 'foo/bar/baz' );
  
  or a mixture of the two:
  
    my $dir = dir( 'foo/bar', 'baz' );
  
  All three of the above examples create relative paths.  To create an
  absolute path, either use the platform native syntax for doing so:
  
    my $dir = dir( '/var/tmp' );
  
  or use an empty string as the first argument:
  
    my $dir = dir( '', 'var', 'tmp' );
  
  If the second form seems awkward, that's somewhat intentional - paths
  like C</var/tmp> or C<\Windows> aren't cross-platform concepts in the
  first place (many non-Unix platforms don't have a notion of a "root
  directory"), so they probably shouldn't appear in your code if you're
  trying to be cross-platform.  The first form is perfectly natural,
  because paths like this may come from config files, user input, or
  whatever.
  
  As a special case, since it doesn't otherwise mean anything useful and
  it's convenient to define this way, C<< Path::Class::Dir->new() >> (or
  C<dir()>) refers to the current directory (C<< File::Spec->curdir >>).
  To get the current directory as an absolute path, do C<<
  dir()->absolute >>.
  
  Finally, as another special case C<dir(undef)> will return undef,
  since that's usually an accident on the part of the caller, and
  returning the root directory would be a nasty surprise just asking for
  trouble a few lines later.
  
  =item $dir->stringify
  
  This method is called internally when a C<Path::Class::Dir> object is
  used in a string context, so the following are equivalent:
  
    $string = $dir->stringify;
    $string = "$dir";
  
  =item $dir->volume
  
  Returns the volume (e.g. C<C:> on Windows, C<Macintosh HD:> on Mac OS,
  etc.) of the directory object, if any.  Otherwise, returns the empty
  string.
  
  =item $dir->basename
  
  Returns the last directory name of the path as a string.
  
  =item $dir->is_dir
  
  Returns a boolean value indicating whether this object represents a
  directory.  Not surprisingly, L<Path::Class::File> objects always
  return false, and C<Path::Class::Dir> objects always return true.
  
  =item $dir->is_absolute
  
  Returns true or false depending on whether the directory refers to an
  absolute path specifier (like C</usr/local> or C<\Windows>).
  
  =item $dir->is_relative
  
  Returns true or false depending on whether the directory refers to a
  relative path specifier (like C<lib/foo> or C<./dir>).
  
  =item $dir->cleanup
  
  Performs a logical cleanup of the file path.  For instance:
  
    my $dir = dir('/foo//baz/./foo')->cleanup;
    # $dir now represents '/foo/baz/foo';
  
  =item $dir->resolve
  
  Performs a physical cleanup of the file path.  For instance:
  
    my $dir = dir('/foo//baz/../foo')->resolve;
    # $dir now represents '/foo/foo', assuming no symlinks
  
  This actually consults the filesystem to verify the validity of the
  path.
  
  =item $file = $dir->file( <dir1>, <dir2>, ..., <file> )
  
  Returns a L<Path::Class::File> object representing an entry in C<$dir>
  or one of its subdirectories.  Internally, this just calls C<<
  Path::Class::File->new( @_ ) >>.
  
  =item $subdir = $dir->subdir( <dir1>, <dir2>, ... )
  
  Returns a new C<Path::Class::Dir> object representing a subdirectory
  of C<$dir>.
  
  =item $parent = $dir->parent
  
  Returns the parent directory of C<$dir>.  Note that this is the
  I<logical> parent, not necessarily the physical parent.  It really
  means we just chop off entries from the end of the directory list
  until we cain't chop no more.  If the directory is relative, we start
  using the relative forms of parent directories.
  
  The following code demonstrates the behavior on absolute and relative
  directories:
  
    $dir = dir('/foo/bar');
    for (1..6) {
      print "Absolute: $dir\n";
      $dir = $dir->parent;
    }
    
    $dir = dir('foo/bar');
    for (1..6) {
      print "Relative: $dir\n";
      $dir = $dir->parent;
    }
    
    ########### Output on Unix ################
    Absolute: /foo/bar
    Absolute: /foo
    Absolute: /
    Absolute: /
    Absolute: /
    Absolute: /
    Relative: foo/bar
    Relative: foo
    Relative: .
    Relative: ..
    Relative: ../..
    Relative: ../../..
  
  =item @list = $dir->children
  
  Returns a list of L<Path::Class::File> and/or C<Path::Class::Dir>
  objects listed in this directory, or in scalar context the number of
  such objects.  Obviously, it is necessary for C<$dir> to
  exist and be readable in order to find its children.
  
  Note that the children are returned as subdirectories of C<$dir>,
  i.e. the children of F<foo> will be F<foo/bar> and F<foo/baz>, not
  F<bar> and F<baz>.
  
  Ordinarily C<children()> will not include the I<self> and I<parent>
  entries C<.> and C<..> (or their equivalents on non-Unix systems),
  because that's like I'm-my-own-grandpa business.  If you do want all
  directory entries including these special ones, pass a true value for
  the C<all> parameter:
  
    @c = $dir->children(); # Just the children
    @c = $dir->children(all => 1); # All entries
  
  In addition, there's a C<no_hidden> parameter that will exclude all
  normally "hidden" entries - on Unix this means excluding all entries
  that begin with a dot (C<.>):
  
    @c = $dir->children(no_hidden => 1); # Just normally-visible entries
  
  
  =item $abs = $dir->absolute
  
  Returns a C<Path::Class::Dir> object representing C<$dir> as an
  absolute path.  An optional argument, given as either a string or a
  C<Path::Class::Dir> object, specifies the directory to use as the base
  of relativity - otherwise the current working directory will be used.
  
  =item $rel = $dir->relative
  
  Returns a C<Path::Class::Dir> object representing C<$dir> as a
  relative path.  An optional argument, given as either a string or a
  C<Path::Class::Dir> object, specifies the directory to use as the base
  of relativity - otherwise the current working directory will be used.
  
  =item $boolean = $dir->subsumes($other)
  
  Returns true if this directory spec subsumes the other spec, and false
  otherwise.  Think of "subsumes" as "contains", but we only look at the
  I<specs>, not whether C<$dir> actually contains C<$other> on the
  filesystem.
  
  The C<$other> argument may be a C<Path::Class::Dir> object, a
  L<Path::Class::File> object, or a string.  In the latter case, we
  assume it's a directory.
  
    # Examples:
    dir('foo/bar' )->subsumes(dir('foo/bar/baz'))  # True
    dir('/foo/bar')->subsumes(dir('/foo/bar/baz')) # True
    dir('foo/..')->subsumes(dir('foo/../bar))      # True
    dir('foo/bar' )->subsumes(dir('bar/baz'))      # False
    dir('/foo/bar')->subsumes(dir('foo/bar'))      # False
    dir('foo/..')->subsumes(dir('bar'))            # False! Use C<contains> to resolve ".."
  
  
  =item $boolean = $dir->contains($other)
  
  Returns true if this directory actually contains C<$other> on the
  filesystem.  C<$other> doesn't have to be a direct child of C<$dir>,
  it just has to be subsumed after both paths have been resolved.
  
  =item $foreign = $dir->as_foreign($type)
  
  Returns a C<Path::Class::Dir> object representing C<$dir> as it would
  be specified on a system of type C<$type>.  Known types include
  C<Unix>, C<Win32>, C<Mac>, C<VMS>, and C<OS2>, i.e. anything for which
  there is a subclass of C<File::Spec>.
  
  Any generated objects (subdirectories, files, parents, etc.) will also
  retain this type.
  
  =item $foreign = Path::Class::Dir->new_foreign($type, @args)
  
  Returns a C<Path::Class::Dir> object representing C<$dir> as it would
  be specified on a system of type C<$type>.  Known types include
  C<Unix>, C<Win32>, C<Mac>, C<VMS>, and C<OS2>, i.e. anything for which
  there is a subclass of C<File::Spec>.
  
  The arguments in C<@args> are the same as they would be specified in
  C<new()>.
  
  =item @list = $dir->dir_list([OFFSET, [LENGTH]])
  
  Returns the list of strings internally representing this directory
  structure.  Each successive member of the list is understood to be an
  entry in its predecessor's directory list.  By contract, C<<
  Path::Class->new( $dir->dir_list ) >> should be equivalent to C<$dir>.
  
  The semantics of this method are similar to Perl's C<splice> or
  C<substr> functions; they return C<LENGTH> elements starting at
  C<OFFSET>.  If C<LENGTH> is omitted, returns all the elements starting
  at C<OFFSET> up to the end of the list.  If C<LENGTH> is negative,
  returns the elements from C<OFFSET> onward except for C<-LENGTH>
  elements at the end.  If C<OFFSET> is negative, it counts backward
  C<OFFSET> elements from the end of the list.  If C<OFFSET> and
  C<LENGTH> are both omitted, the entire list is returned.
  
  In a scalar context, C<dir_list()> with no arguments returns the
  number of entries in the directory list; C<dir_list(OFFSET)> returns
  the single element at that offset; C<dir_list(OFFSET, LENGTH)> returns
  the final element that would have been returned in a list context.
  
  =item $dir->components
  
  Identical to C<dir_list()>.  It exists because there's an analogous
  method C<dir_list()> in the C<Path::Class::File> class that also
  returns the basename string, so this method lets someone call
  C<components()> without caring whether the object is a file or a
  directory.
  
  =item $fh = $dir->open()
  
  Passes C<$dir> to C<< IO::Dir->open >> and returns the result as an
  L<IO::Dir> object.  If the opening fails, C<undef> is returned and
  C<$!> is set.
  
  =item $dir->mkpath($verbose, $mode)
  
  Passes all arguments, including C<$dir>, to C<< File::Path::mkpath()
  >> and returns the result (a list of all directories created).
  
  =item $dir->rmtree($verbose, $cautious)
  
  Passes all arguments, including C<$dir>, to C<< File::Path::rmtree()
  >> and returns the result (the number of files successfully deleted).
  
  =item $dir->remove()
  
  Removes the directory, which must be empty.  Returns a boolean value
  indicating whether or not the directory was successfully removed.
  This method is mainly provided for consistency with
  C<Path::Class::File>'s C<remove()> method.
  
  =item $dir->tempfile(...)
  
  An interface to L<File::Temp>'s C<tempfile()> function.  Just like
  that function, if you call this in a scalar context, the return value
  is the filehandle and the file is C<unlink>ed as soon as possible
  (which is immediately on Unix-like platforms).  If called in a list
  context, the return values are the filehandle and the filename.
  
  The given directory is passed as the C<DIR> parameter.
  
  Here's an example of pretty good usage which doesn't allow race
  conditions, won't leave yucky tempfiles around on your filesystem,
  etc.:
  
    my $fh = $dir->tempfile;
    print $fh "Here's some data...\n";
    seek($fh, 0, 0);
    while (<$fh>) { do something... }
  
  Or in combination with a C<fork>:
  
    my $fh = $dir->tempfile;
    print $fh "Here's some more data...\n";
    seek($fh, 0, 0);
    if ($pid=fork()) {
      wait;
    } else {
      something($_) while <$fh>;
    }
  
  
  =item $dir_or_file = $dir->next()
  
  A convenient way to iterate through directory contents.  The first
  time C<next()> is called, it will C<open()> the directory and read the
  first item from it, returning the result as a C<Path::Class::Dir> or
  L<Path::Class::File> object (depending, of course, on its actual
  type).  Each subsequent call to C<next()> will simply iterate over the
  directory's contents, until there are no more items in the directory,
  and then the undefined value is returned.  For example, to iterate
  over all the regular files in a directory:
  
    while (my $file = $dir->next) {
      next unless -f $file;
      my $fh = $file->open('r') or die "Can't read $file: $!";
      ...
    }
  
  If an error occurs when opening the directory (for instance, it
  doesn't exist or isn't readable), C<next()> will throw an exception
  with the value of C<$!>.
  
  =item $dir->traverse( sub { ... }, @args )
  
  Calls the given callback for the root, passing it a continuation
  function which, when called, will call this recursively on each of its
  children. The callback function should be of the form:
  
    sub {
      my ($child, $cont, @args) = @_;
      # ...
    }
  
  For instance, to calculate the number of files in a directory, you
  can do this:
  
    my $nfiles = $dir->traverse(sub {
      my ($child, $cont) = @_;
      return sum($cont->(), ($child->is_dir ? 0 : 1));
    });
  
  or to calculate the maximum depth of a directory:
  
    my $depth = $dir->traverse(sub {
      my ($child, $cont, $depth) = @_;
      return max($cont->($depth + 1), $depth);
    }, 0);
  
  You can also choose not to call the callback in certain situations:
  
    $dir->traverse(sub {
      my ($child, $cont) = @_;
      return if -l $child; # don't follow symlinks
      # do something with $child
      return $cont->();
    });
  
  =item $dir->traverse_if( sub { ... }, sub { ... }, @args )
  
  traverse with additional "should I visit this child" callback.
  Particularly useful in case examined tree contains inaccessible
  directories.
  
  Canonical example:
  
    $dir->traverse_if(
      sub {
         my ($child, $cont) = @_;
         # do something with $child
         return $cont->();
      }, 
      sub {
         my ($child) = @_;
         # Process only readable items
         return -r $child;
      });
  
  Second callback gets single parameter: child. Only children for
  which it returns true will be processed by the first callback.
  
  Remaining parameters are interpreted as in traverse, in particular
  C<traverse_if(callback, sub { 1 }, @args> is equivalent to
  C<traverse(callback, @args)>.
  
  =item $dir->recurse( callback => sub {...} )
  
  Iterates through this directory and all of its children, and all of
  its children's children, etc., calling the C<callback> subroutine for
  each entry.  This is a lot like what the L<File::Find> module does,
  and of course C<File::Find> will work fine on L<Path::Class> objects,
  but the advantage of the C<recurse()> method is that it will also feed
  your callback routine C<Path::Class> objects rather than just pathname
  strings.
  
  The C<recurse()> method requires a C<callback> parameter specifying
  the subroutine to invoke for each entry.  It will be passed the
  C<Path::Class> object as its first argument.
  
  C<recurse()> also accepts two boolean parameters, C<depthfirst> and
  C<preorder> that control the order of recursion.  The default is a
  preorder, breadth-first search, i.e. C<< depthfirst => 0, preorder => 1 >>.
  At the time of this writing, all combinations of these two parameters
  are supported I<except> C<< depthfirst => 0, preorder => 0 >>.
  
  C<callback> is normally not required to return any value. If it
  returns special constant C<Path::Class::Entity::PRUNE()> (more easily
  available as C<< $item->PRUNE >>),  no children of analyzed
  item will be analyzed (mostly as if you set C<$File::Find::prune=1>). Of course
  pruning is available only in C<preorder>, in postorder return value
  has no effect.
  
  =item $st = $file->stat()
  
  Invokes C<< File::stat::stat() >> on this directory and returns a
  C<File::stat> object representing the result.
  
  =item $st = $file->lstat()
  
  Same as C<stat()>, but if C<$file> is a symbolic link, C<lstat()>
  stats the link instead of the directory the link points to.
  
  =item $class = $file->file_class()
  
  Returns the class which should be used to create file objects.
  
  Generally overridden whenever this class is subclassed.
  
  =back
  
  =head1 AUTHOR
  
  Ken Williams, kwilliams@cpan.org
  
  =head1 SEE ALSO
  
  L<Path::Class>, L<Path::Class::File>, L<File::Spec>
  
  =cut
PATH_CLASS_DIR

$fatpacked{"Path/Class/Entity.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PATH_CLASS_ENTITY';
  use strict;
  
  package Path::Class::Entity;
  {
    $Path::Class::Entity::VERSION = '0.37';
  }
  
  use File::Spec 3.26;
  use File::stat ();
  use Cwd;
  use Carp();
  
  use overload
    (
     q[""] => 'stringify',
     'bool' => 'boolify',
     fallback => 1,
    );
  
  sub new {
    my $from = shift;
    my ($class, $fs_class) = (ref($from)
  			    ? (ref $from, $from->{file_spec_class})
  			    : ($from, $Path::Class::Foreign));
    return bless {file_spec_class => $fs_class}, $class;
  }
  
  sub is_dir { 0 }
  
  sub _spec_class {
    my ($class, $type) = @_;
  
    die "Invalid system type '$type'" unless ($type) = $type =~ /^(\w+)$/;  # Untaint
    my $spec = "File::Spec::$type";
    ## no critic
    eval "require $spec; 1" or die $@;
    return $spec;
  }
  
  sub new_foreign {
    my ($class, $type) = (shift, shift);
    local $Path::Class::Foreign = $class->_spec_class($type);
    return $class->new(@_);
  }
  
  sub _spec { (ref($_[0]) && $_[0]->{file_spec_class}) || 'File::Spec' }
  
  sub boolify { 1 }
    
  sub is_absolute { 
    # 5.6.0 has a bug with regexes and stringification that's ticked by
    # file_name_is_absolute().  Help it along with an explicit stringify().
    $_[0]->_spec->file_name_is_absolute($_[0]->stringify) 
  }
  
  sub is_relative { ! $_[0]->is_absolute }
  
  sub cleanup {
    my $self = shift;
    my $cleaned = $self->new( $self->_spec->canonpath("$self") );
    %$self = %$cleaned;
    return $self;
  }
  
  sub resolve {
    my $self = shift;
    Carp::croak($! . " $self") unless -e $self;  # No such file or directory
    my $cleaned = $self->new( scalar Cwd::realpath($self->stringify) );
  
    # realpath() always returns absolute path, kind of annoying
    $cleaned = $cleaned->relative if $self->is_relative;
  
    %$self = %$cleaned;
    return $self;
  }
  
  sub absolute {
    my $self = shift;
    return $self if $self->is_absolute;
    return $self->new($self->_spec->rel2abs($self->stringify, @_));
  }
  
  sub relative {
    my $self = shift;
    return $self->new($self->_spec->abs2rel($self->stringify, @_));
  }
  
  sub stat  { File::stat::stat("$_[0]") }
  sub lstat { File::stat::lstat("$_[0]") }
  
  sub PRUNE { return \&PRUNE; }
  
  1;
  __END__
  
  =head1 NAME
  
  Path::Class::Entity - Base class for files and directories
  
  =head1 VERSION
  
  version 0.37
  
  =head1 DESCRIPTION
  
  This class is the base class for C<Path::Class::File> and
  C<Path::Class::Dir>, it is not used directly by callers.
  
  =head1 AUTHOR
  
  Ken Williams, kwilliams@cpan.org
  
  =head1 SEE ALSO
  
  Path::Class
  
  =cut
PATH_CLASS_ENTITY

$fatpacked{"Path/Class/File.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PATH_CLASS_FILE';
  use strict;
  
  package Path::Class::File;
  {
    $Path::Class::File::VERSION = '0.37';
  }
  
  use Path::Class::Dir;
  use parent qw(Path::Class::Entity);
  use Carp;
  
  use IO::File ();
  
  sub new {
    my $self = shift->SUPER::new;
    my $file = pop();
    my @dirs = @_;
  
    my ($volume, $dirs, $base) = $self->_spec->splitpath($file);
  
    if (length $dirs) {
      push @dirs, $self->_spec->catpath($volume, $dirs, '');
    }
  
    $self->{dir}  = @dirs ? $self->dir_class->new(@dirs) : undef;
    $self->{file} = $base;
  
    return $self;
  }
  
  sub dir_class { "Path::Class::Dir" }
  
  sub as_foreign {
    my ($self, $type) = @_;
    local $Path::Class::Foreign = $self->_spec_class($type);
    my $foreign = ref($self)->SUPER::new;
    $foreign->{dir} = $self->{dir}->as_foreign($type) if defined $self->{dir};
    $foreign->{file} = $self->{file};
    return $foreign;
  }
  
  sub stringify {
    my $self = shift;
    return $self->{file} unless defined $self->{dir};
    return $self->_spec->catfile($self->{dir}->stringify, $self->{file});
  }
  
  sub dir {
    my $self = shift;
    return $self->{dir} if defined $self->{dir};
    return $self->dir_class->new($self->_spec->curdir);
  }
  BEGIN { *parent = \&dir; }
  
  sub volume {
    my $self = shift;
    return '' unless defined $self->{dir};
    return $self->{dir}->volume;
  }
  
  sub components {
    my $self = shift;
    croak "Arguments are not currently supported by File->components()" if @_;
    return ($self->dir->components, $self->basename);
  }
  
  sub basename { shift->{file} }
  sub open  { IO::File->new(@_) }
  
  sub openr { $_[0]->open('r') or croak "Can't read $_[0]: $!"  }
  sub openw { $_[0]->open('w') or croak "Can't write to $_[0]: $!" }
  sub opena { $_[0]->open('a') or croak "Can't append to $_[0]: $!" }
  
  sub touch {
    my $self = shift;
    if (-e $self) {
      utime undef, undef, $self;
    } else {
      $self->openw;
    }
  }
  
  sub slurp {
    my ($self, %args) = @_;
    my $iomode = $args{iomode} || 'r';
    my $fh = $self->open($iomode) or croak "Can't read $self: $!";
  
    if (wantarray) {
      my @data = <$fh>;
      chomp @data if $args{chomped} or $args{chomp};
  
      if ( my $splitter = $args{split} ) {
        @data = map { [ split $splitter, $_ ] } @data;
      }
  
      return @data;
    }
  
  
    croak "'split' argument can only be used in list context"
      if $args{split};
  
  
    if ($args{chomped} or $args{chomp}) {
      chomp( my @data = <$fh> );
      return join '', @data;
    }
  
  
    local $/;
    return <$fh>;
  }
  
  sub spew {
      my $self = shift;
      my %args = splice( @_, 0, @_-1 );
  
      my $iomode = $args{iomode} || 'w';
      my $fh = $self->open( $iomode ) or croak "Can't write to $self: $!";
  
      if (ref($_[0]) eq 'ARRAY') {
          # Use old-school for loop to avoid copying.
          for (my $i = 0; $i < @{ $_[0] }; $i++) {
              print $fh $_[0]->[$i]
                  or croak "Can't write to $self: $!";
          }
      }
      else {
          print $fh $_[0]
              or croak "Can't write to $self: $!";
      }
  
      close $fh
          or croak "Can't write to $self: $!";
  
      return;
  }
  
  sub spew_lines {
      my $self = shift;
      my %args = splice( @_, 0, @_-1 );
  
      my $content = $_[0];
  
      # If content is an array ref, appends $/ to each element of the array.
      # Otherwise, if it is a simple scalar, just appends $/ to that scalar.
  
      $content
          = ref( $content ) eq 'ARRAY'
          ? [ map { $_, $/ } @$content ]
          : "$content$/";
  
      return $self->spew( %args, $content );
  }
  
  sub remove {
    my $file = shift->stringify;
    return unlink $file unless -e $file; # Sets $! correctly
    1 while unlink $file;
    return not -e $file;
  }
  
  sub copy_to {
    my ($self, $dest) = @_;
    if ( eval{ $dest->isa("Path::Class::File")} ) { 
      $dest = $dest->stringify;
      croak "Can't copy to file $dest: it is a directory" if -d $dest;
    } elsif ( eval{ $dest->isa("Path::Class::Dir") } ) {
      $dest = $dest->stringify;
      croak "Can't copy to directory $dest: it is a file" if -f $dest;
      croak "Can't copy to directory $dest: no such directory" unless -d $dest;
    } elsif ( ref $dest ) {
      croak "Don't know how to copy files to objects of type '".ref($self)."'";
    }
  
    require Perl::OSType;
    if ( !Perl::OSType::is_os_type('Unix') ) {
  
        require File::Copy;
        return unless File::Copy::cp($self->stringify, "${dest}");
  
    } else {
  
        return unless (system('cp', $self->stringify, "${dest}") == 0);
  
    }
  
    return $self->new($dest);
  }
  
  sub move_to {
    my ($self, $dest) = @_;
    require File::Copy;
    if (File::Copy::move($self->stringify, "${dest}")) {
  
        my $new = $self->new($dest);
  
        $self->{$_} = $new->{$_} foreach (qw/ dir file /);
  
        return $self;
  
    } else {
  
        return;
  
    }
  }
  
  sub traverse {
    my $self = shift;
    my ($callback, @args) = @_;
    return $self->$callback(sub { () }, @args);
  }
  
  sub traverse_if {
    my $self = shift;
    my ($callback, $condition, @args) = @_;
    return $self->$callback(sub { () }, @args);
  }
  
  1;
  __END__
  
  =head1 NAME
  
  Path::Class::File - Objects representing files
  
  =head1 VERSION
  
  version 0.37
  
  =head1 SYNOPSIS
  
    use Path::Class;  # Exports file() by default
  
    my $file = file('foo', 'bar.txt');  # Path::Class::File object
    my $file = Path::Class::File->new('foo', 'bar.txt'); # Same thing
  
    # Stringifies to 'foo/bar.txt' on Unix, 'foo\bar.txt' on Windows, etc.
    print "file: $file\n";
  
    if ($file->is_absolute) { ... }
    if ($file->is_relative) { ... }
  
    my $v = $file->volume; # Could be 'C:' on Windows, empty string
                           # on Unix, 'Macintosh HD:' on Mac OS
  
    $file->cleanup; # Perform logical cleanup of pathname
    $file->resolve; # Perform physical cleanup of pathname
  
    my $dir = $file->dir;  # A Path::Class::Dir object
  
    my $abs = $file->absolute; # Transform to absolute path
    my $rel = $file->relative; # Transform to relative path
  
  =head1 DESCRIPTION
  
  The C<Path::Class::File> class contains functionality for manipulating
  file names in a cross-platform way.
  
  =head1 METHODS
  
  =over 4
  
  =item $file = Path::Class::File->new( <dir1>, <dir2>, ..., <file> )
  
  =item $file = file( <dir1>, <dir2>, ..., <file> )
  
  Creates a new C<Path::Class::File> object and returns it.  The
  arguments specify the path to the file.  Any volume may also be
  specified as the first argument, or as part of the first argument.
  You can use platform-neutral syntax:
  
    my $file = file( 'foo', 'bar', 'baz.txt' );
  
  or platform-native syntax:
  
    my $file = file( 'foo/bar/baz.txt' );
  
  or a mixture of the two:
  
    my $file = file( 'foo/bar', 'baz.txt' );
  
  All three of the above examples create relative paths.  To create an
  absolute path, either use the platform native syntax for doing so:
  
    my $file = file( '/var/tmp/foo.txt' );
  
  or use an empty string as the first argument:
  
    my $file = file( '', 'var', 'tmp', 'foo.txt' );
  
  If the second form seems awkward, that's somewhat intentional - paths
  like C</var/tmp> or C<\Windows> aren't cross-platform concepts in the
  first place, so they probably shouldn't appear in your code if you're
  trying to be cross-platform.  The first form is perfectly fine,
  because paths like this may come from config files, user input, or
  whatever.
  
  =item $file->stringify
  
  This method is called internally when a C<Path::Class::File> object is
  used in a string context, so the following are equivalent:
  
    $string = $file->stringify;
    $string = "$file";
  
  =item $file->volume
  
  Returns the volume (e.g. C<C:> on Windows, C<Macintosh HD:> on Mac OS,
  etc.) of the object, if any.  Otherwise, returns the empty string.
  
  =item $file->basename
  
  Returns the name of the file as a string, without the directory
  portion (if any).
  
  =item $file->components
  
  Returns a list of the directory components of this file, followed by
  the basename.
  
  Note: unlike C<< $dir->components >>, this method currently does not
  accept any arguments to select which elements of the list will be
  returned.  It may do so in the future.  Currently it throws an
  exception if such arguments are present.
  
  
  =item $file->is_dir
  
  Returns a boolean value indicating whether this object represents a
  directory.  Not surprisingly, C<Path::Class::File> objects always
  return false, and L<Path::Class::Dir> objects always return true.
  
  =item $file->is_absolute
  
  Returns true or false depending on whether the file refers to an
  absolute path specifier (like C</usr/local/foo.txt> or C<\Windows\Foo.txt>).
  
  =item $file->is_relative
  
  Returns true or false depending on whether the file refers to a
  relative path specifier (like C<lib/foo.txt> or C<.\Foo.txt>).
  
  =item $file->cleanup
  
  Performs a logical cleanup of the file path.  For instance:
  
    my $file = file('/foo//baz/./foo.txt')->cleanup;
    # $file now represents '/foo/baz/foo.txt';
  
  =item $dir->resolve
  
  Performs a physical cleanup of the file path.  For instance:
  
    my $file = file('/foo/baz/../foo.txt')->resolve;
    # $file now represents '/foo/foo.txt', assuming no symlinks
  
  This actually consults the filesystem to verify the validity of the
  path.
  
  =item $dir = $file->dir
  
  Returns a C<Path::Class::Dir> object representing the directory
  containing this file.
  
  =item $dir = $file->parent
  
  A synonym for the C<dir()> method.
  
  =item $abs = $file->absolute
  
  Returns a C<Path::Class::File> object representing C<$file> as an
  absolute path.  An optional argument, given as either a string or a
  L<Path::Class::Dir> object, specifies the directory to use as the base
  of relativity - otherwise the current working directory will be used.
  
  =item $rel = $file->relative
  
  Returns a C<Path::Class::File> object representing C<$file> as a
  relative path.  An optional argument, given as either a string or a
  C<Path::Class::Dir> object, specifies the directory to use as the base
  of relativity - otherwise the current working directory will be used.
  
  =item $foreign = $file->as_foreign($type)
  
  Returns a C<Path::Class::File> object representing C<$file> as it would
  be specified on a system of type C<$type>.  Known types include
  C<Unix>, C<Win32>, C<Mac>, C<VMS>, and C<OS2>, i.e. anything for which
  there is a subclass of C<File::Spec>.
  
  Any generated objects (subdirectories, files, parents, etc.) will also
  retain this type.
  
  =item $foreign = Path::Class::File->new_foreign($type, @args)
  
  Returns a C<Path::Class::File> object representing a file as it would
  be specified on a system of type C<$type>.  Known types include
  C<Unix>, C<Win32>, C<Mac>, C<VMS>, and C<OS2>, i.e. anything for which
  there is a subclass of C<File::Spec>.
  
  The arguments in C<@args> are the same as they would be specified in
  C<new()>.
  
  =item $fh = $file->open($mode, $permissions)
  
  Passes the given arguments, including C<$file>, to C<< IO::File->new >>
  (which in turn calls C<< IO::File->open >> and returns the result
  as an L<IO::File> object.  If the opening
  fails, C<undef> is returned and C<$!> is set.
  
  =item $fh = $file->openr()
  
  A shortcut for
  
   $fh = $file->open('r') or croak "Can't read $file: $!";
  
  =item $fh = $file->openw()
  
  A shortcut for
  
   $fh = $file->open('w') or croak "Can't write to $file: $!";
  
  =item $fh = $file->opena()
  
  A shortcut for
  
   $fh = $file->open('a') or croak "Can't append to $file: $!";
  
  =item $file->touch
  
  Sets the modification and access time of the given file to right now,
  if the file exists.  If it doesn't exist, C<touch()> will I<make> it
  exist, and - YES! - set its modification and access time to now.
  
  =item $file->slurp()
  
  In a scalar context, returns the contents of C<$file> in a string.  In
  a list context, returns the lines of C<$file> (according to how C<$/>
  is set) as a list.  If the file can't be read, this method will throw
  an exception.
  
  If you want C<chomp()> run on each line of the file, pass a true value
  for the C<chomp> or C<chomped> parameters:
  
    my @lines = $file->slurp(chomp => 1);
  
  You may also use the C<iomode> parameter to pass in an IO mode to use
  when opening the file, usually IO layers (though anything accepted by
  the MODE argument of C<open()> is accepted here).  Just make sure it's
  a I<reading> mode.
  
    my @lines = $file->slurp(iomode => ':crlf');
    my $lines = $file->slurp(iomode => '<:encoding(UTF-8)');
  
  The default C<iomode> is C<r>.
  
  Lines can also be automatically split, mimicking the perl command-line
  option C<-a> by using the C<split> parameter. If this parameter is used,
  each line will be returned as an array ref.
  
      my @lines = $file->slurp( chomp => 1, split => qr/\s*,\s*/ );
  
  The C<split> parameter can only be used in a list context.
  
  =item $file->spew( $content );
  
  The opposite of L</slurp>, this takes a list of strings and prints them
  to the file in write mode.  If the file can't be written to, this method
  will throw an exception.
  
  The content to be written can be either an array ref or a plain scalar.
  If the content is an array ref then each entry in the array will be
  written to the file.
  
  You may use the C<iomode> parameter to pass in an IO mode to use when
  opening the file, just like L</slurp> supports.
  
    $file->spew(iomode => '>:raw', $content);
  
  The default C<iomode> is C<w>.
  
  =item $file->spew_lines( $content );
  
  Just like C<spew>, but, if $content is a plain scalar, appends $/
  to it, or, if $content is an array ref, appends $/ to each element
  of the array.
  
  Can also take an C<iomode> parameter like C<spew>. Again, the
  default C<iomode> is C<w>.
  
  =item $file->traverse(sub { ... }, @args)
  
  Calls the given callback on $file. This doesn't do much on its own,
  but see the associated documentation in L<Path::Class::Dir>.
  
  =item $file->remove()
  
  This method will remove the file in a way that works well on all
  platforms, and returns a boolean value indicating whether or not the
  file was successfully removed.
  
  C<remove()> is better than simply calling Perl's C<unlink()> function,
  because on some platforms (notably VMS) you actually may need to call
  C<unlink()> several times before all versions of the file are gone -
  the C<remove()> method handles this process for you.
  
  =item $st = $file->stat()
  
  Invokes C<< File::stat::stat() >> on this file and returns a
  L<File::stat> object representing the result.
  
  =item $st = $file->lstat()
  
  Same as C<stat()>, but if C<$file> is a symbolic link, C<lstat()>
  stats the link instead of the file the link points to.
  
  =item $class = $file->dir_class()
  
  Returns the class which should be used to create directory objects.
  
  Generally overridden whenever this class is subclassed.
  
  =item $copy = $file->copy_to( $dest );
  
  Copies the C<$file> to C<$dest>. It returns a L<Path::Class::File>
  object when successful, C<undef> otherwise.
  
  =item $moved = $file->move_to( $dest );
  
  Moves the C<$file> to C<$dest>, and updates C<$file> accordingly.
  
  It returns C<$file> is successful, C<undef> otherwise.
  
  =back
  
  =head1 AUTHOR
  
  Ken Williams, kwilliams@cpan.org
  
  =head1 SEE ALSO
  
  L<Path::Class>, L<Path::Class::Dir>, L<File::Spec>
  
  =cut
PATH_CLASS_FILE

$fatpacked{"darwin-2level/Cpanel/JSON/XS.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'DARWIN-2LEVEL_CPANEL_JSON_XS';
  package Cpanel::JSON::XS;
  our $VERSION = '3.0239';
  our $XS_VERSION = $VERSION;
  # $VERSION = eval $VERSION;
  
  =pod
  
  =head1 NAME
  
  Cpanel::JSON::XS - cPanel fork of JSON::XS, fast and correct serializing
  
  =head1 SYNOPSIS
  
   use Cpanel::JSON::XS;
  
   # exported functions, they croak on error
   # and expect/generate UTF-8
  
   $utf8_encoded_json_text = encode_json $perl_hash_or_arrayref;
   $perl_hash_or_arrayref  = decode_json $utf8_encoded_json_text;
  
   # OO-interface
  
   $coder = Cpanel::JSON::XS->new->ascii->pretty->allow_nonref;
   $pretty_printed_unencoded = $coder->encode ($perl_scalar);
   $perl_scalar = $coder->decode ($unicode_json_text);
  
   # Note that 5.6 misses most smart utf8 and encoding functionalities
   # of newer releases.
  
   # Note that L<JSON::MaybeXS> will automatically use Cpanel::JSON::XS
   # if available, at virtually no speed overhead either, so you should
   # be able to just:
   
   use JSON::MaybeXS;
  
   # and do the same things, except that you have a pure-perl fallback now.
  
  =head1 DESCRIPTION
  
  This module converts Perl data structures to JSON and vice versa. Its
  primary goal is to be I<correct> and its secondary goal is to be
  I<fast>. To reach the latter goal it was written in C.
  
  As this is the n-th-something JSON module on CPAN, what was the reason
  to write yet another JSON module? While it seems there are many JSON
  modules, none of them correctly handle all corner cases, and in most cases
  their maintainers are unresponsive, gone missing, or not listening to bug
  reports for other reasons.
  
  See below for the cPanel fork.
  
  See MAPPING, below, on how Cpanel::JSON::XS maps perl values to JSON
  values and vice versa.
  
  =head2 FEATURES
  
  =over 4
  
  =item * correct Unicode handling
  
  This module knows how to handle Unicode with Perl version higher than 5.8.5,
  documents how and when it does so, and even documents what "correct" means.
  
  =item * round-trip integrity
  
  When you serialize a perl data structure using only data types supported
  by JSON and Perl, the deserialized data structure is identical on the Perl
  level. (e.g. the string "2.0" doesn't suddenly become "2" just because
  it looks like a number). There I<are> minor exceptions to this, read the
  MAPPING section below to learn about those.
  
  =item * strict checking of JSON correctness
  
  There is no guessing, no generating of illegal JSON texts by default,
  and only JSON is accepted as input by default. the latter is a security
  feature.
  
  =item * fast
  
  Compared to other JSON modules and other serializers such as Storable,
  this module usually compares favourably in terms of speed, too.
  
  =item * simple to use
  
  This module has both a simple functional interface as well as an object
  oriented interface.
  
  =item * reasonably versatile output formats
  
  You can choose between the most compact guaranteed-single-line format
  possible (nice for simple line-based protocols), a pure-ASCII format
  (for when your transport is not 8-bit clean, still supports the whole
  Unicode range), or a pretty-printed format (for when you want to read that
  stuff). Or you can combine those features in whatever way you like.
  
  =back
  
  =head2 cPanel fork
  
  Since the original author MLEHMANN has no public
  bugtracker, this cPanel fork sits now on github.
  
  src repo: L<https://github.com/rurban/Cpanel-JSON-XS>
  original: L<http://cvs.schmorp.de/JSON-XS/>
  
  RT:       L<https://github.com/rurban/Cpanel-JSON-XS/issues>
  or        L<https://rt.cpan.org/Public/Dist/Display.html?Queue=Cpanel-JSON-XS>
  
  B<Changes to JSON::XS>
  
  - stricter decode_json() as documented. non-refs are disallowed.
    added a 2nd optional argument. decode() honors now allow_nonref.
  
  - fixed encode of numbers for dual-vars. Different string
    representations are preserved, but numbers with temporary strings
    which represent the same number are here treated as numbers, not
    strings. Cpanel::JSON::XS is a bit slower, but preserves numeric
    types better.
  
  - numbers ending with .0 stay numbers, are not converted to
    integers. [#63] dual-vars which are represented as number not
    integer (42+"bar" != 5.8.9) are now encoded as number (=> 42.0)
    because internally it's now a NOK type.  However !!1 which is
    wrongly encoded in 5.8 as "1"/1.0 is still represented as integer.
  
  - different handling of inf/nan. Default now to null, optionally with
    stringify_infnan() to "inf"/"nan". [#28, #32]
  
  - added C<binary> extension, non-JSON and non JSON parsable, allows
    C<\xNN> and C<\NNN> sequences.
  
  - 5.6.2 support; sacrificing some utf8 features (assuming bytes
    all-over), no multi-byte unicode characters with 5.6.
  
  - interop for true/false overloading. JSON::XS, JSON::PP and Mojo::JSON 
    representations for booleans are accepted and JSON::XS accepts
    Cpanel::JSON::XS booleans [#13, #37]
    Fixed overloading of booleans. Cpanel::JSON::XS::true stringifies again
    to "1", not "true", analog to all other JSON modules.
  
  - native boolean mapping of yes and no to true and false, as in YAML::XS.
    In perl C<!0> is yes, C<!1> is no.
    The JSON value true maps to 1, false maps to 0. [#39]
  
  - support arbitrary stringification with encode, with convert_blessed
    and allow_blessed.
  
  - ithread support. Cpanel::JSON::XS is thread-safe, JSON::XS not
  
  - is_bool can be called as method, JSON::XS::is_bool not.
  
  - performance optimizations for threaded Perls
  
  - relaxed mode, allowing many popular extensions
  
  - additional fixes for:
  
    - [cpan #88061] AIX atof without USE_LONG_DOUBLE
  
    - #10 unshare_hek crash
  
    - #7, #29 avoid re-blessing where possible. It fails in JSON::XS for
     READONLY values, i.e. restricted hashes.
  
    - #41 overloading of booleans, use the object not the reference.
  
    - #62 -Dusequadmath conversion and no SEGV.
  
    - #72 parsing of values followed \0, like 1\0 does fail.
  
    - #72 parsing of illegal unicode or non-unicode characters.
  
    - #96 locale-insensitive numeric conversion
  
  - public maintenance and bugtracker
  
  - use ppport.h, sanify XS.xs comment styles, harness C coding style
  
  - common::sense is optional. When available it is not used in the
    published production module, just during development and testing.
  
  - extended testsuite, passes all http://seriot.ch/parsing_json.html
    tests.  In fact it is the only know JSON decoder which does so,
    while also being the fastest.
  
  - support many more options and methods from JSON::PP:
    stringify_infnan, allow_unknown, allow_stringify, allow_barekey,
    encode_stringify, allow_bignum, allow_singlequote, sort_by
    (partially), escape_slash, convert_blessed, ...  optional
    decode_json(, allow_nonref) arg.
    relaxed implements allow_dupkeys.
  
  - support all 5 unicode BOM's: UTF-8, UTF-16LE, UTF-16BE, UTF-32LE,
    UTF-32BE, encoding internally to UTF-8.
  
  =cut
  
  our @ISA = qw(Exporter);
  our @EXPORT = qw(encode_json decode_json to_json from_json);
  
  sub to_json($@) {
     if ($] >= 5.008) {
       require Carp;
       Carp::croak ("Cpanel::JSON::XS::to_json has been renamed to encode_json,".
                    " either downgrade to pre-2.0 versions of Cpanel::JSON::XS or".
                    " rename the call");
     } else {
       _to_json(@_);
     }
  }
  
  sub from_json($@) {
     if ($] >= 5.008) {
       require Carp;
       Carp::croak ("Cpanel::JSON::XS::from_json has been renamed to decode_json,".
                    " either downgrade to pre-2.0 versions of Cpanel::JSON::XS or".
                    " rename the call");
     } else {
       _from_json(@_);
     }
  }
  
  use Exporter;
  use XSLoader;
  
  =head1 FUNCTIONAL INTERFACE
  
  The following convenience methods are provided by this module. They are
  exported by default:
  
  =over 4
  
  =item $json_text = encode_json $perl_scalar
  
  Converts the given Perl data structure to a UTF-8 encoded, binary string
  (that is, the string contains octets only). Croaks on error.
  
  This function call is functionally identical to:
  
     $json_text = Cpanel::JSON::XS->new->utf8->encode ($perl_scalar)
  
  Except being faster.
  
  =item $perl_scalar = decode_json $json_text [, $allow_nonref ]
  
  The opposite of C<encode_json>: expects an UTF-8 (binary) string of an
  json reference and tries to parse that as an UTF-8 encoded JSON text,
  returning the resulting reference. Croaks on error.
  
  This function call is functionally identical to:
  
     $perl_scalar = Cpanel::JSON::XS->new->utf8->decode ($json_text)
  
  except being faster.
  
  Note that older decode_json versions in Cpanel::JSON::XS older than
  3.0116 and JSON::XS did not set allow_nonref but allowed them due to a
  bug in the decoder.
  
  If the new optional $allow_nonref argument is set and not false, the
  allow_nonref option will be set and the function will act is described
  as in the relaxed RFC 7159 allowing all values such as objects,
  arrays, strings, numbers, "null", "true", and "false".
  
  =item $is_boolean = Cpanel::JSON::XS::is_bool $scalar
  
  Returns true if the passed scalar represents either C<JSON::XS::true>
  or C<JSON::XS::false>, two constants that act like C<1> and C<0>,
  respectively and are used to represent JSON C<true> and C<false>
  values in Perl.
  
  See MAPPING, below, for more information on how JSON values are mapped
  to Perl.
  
  =back
  
  =head1 DEPRECATED FUNCTIONS
  
  =over
  
  =item from_json
  
  from_json has been renamed to decode_json
  
  =item to_json
  
  to_json has been renamed to encode_json
  
  =back
  
  
  =head1 A FEW NOTES ON UNICODE AND PERL
  
  Since this often leads to confusion, here are a few very clear words on
  how Unicode works in Perl, modulo bugs.
  
  =over 4
  
  =item 1. Perl strings can store characters with ordinal values > 255.
  
  This enables you to store Unicode characters as single characters in a
  Perl string - very natural.
  
  =item 2. Perl does I<not> associate an encoding with your strings.
  
  ... until you force it to, e.g. when matching it against a regex, or
  printing the scalar to a file, in which case Perl either interprets
  your string as locale-encoded text, octets/binary, or as Unicode,
  depending on various settings. In no case is an encoding stored
  together with your data, it is I<use> that decides encoding, not any
  magical meta data.
  
  =item 3. The internal utf-8 flag has no meaning with regards to the
  encoding of your string.
  
  =item 4. A "Unicode String" is simply a string where each character
  can be validly interpreted as a Unicode code point.
  
  If you have UTF-8 encoded data, it is no longer a Unicode string, but
  a Unicode string encoded in UTF-8, giving you a binary string.
  
  =item 5. A string containing "high" (> 255) character values is I<not>
  a UTF-8 string.
  
  =item 6. Unicode noncharacters only warn, as in core.
  
  The 66 Unicode noncharacters U+FDD0..U+FDEF, and U+*FFFE, U+*FFFF just
  warn, see L<http://www.unicode.org/versions/corrigendum9.html>.  But
  illegal surrogate pairs fail to parse.
  
  =item 7. Raw non-Unicode characters above U+10FFFF are disallowed.
  
  Raw non-Unicode characters outside the valid unicode range fail to
  parse, because "A string is a sequence of zero or more Unicode
  characters" RFC 7159 section 1 and "JSON text SHALL be encoded in
  Unicode RFC 7159 section 8.1. We use now the UTF8_DISALLOW_SUPER
  flag when parsing unicode.
  
  =back
  
  I hope this helps :)
  
  
  =head1 OBJECT-ORIENTED INTERFACE
  
  The object oriented interface lets you configure your own encoding or
  decoding style, within the limits of supported formats.
  
  =over 4
  
  =item $json = new Cpanel::JSON::XS
  
  Creates a new JSON object that can be used to de/encode JSON
  strings. All boolean flags described below are by default I<disabled>.
  
  The mutators for flags all return the JSON object again and thus calls can
  be chained:
  
     my $json = Cpanel::JSON::XS->new->utf8->space_after->encode ({a => [1,2]})
     => {"a": [1, 2]}
  
  =item $json = $json->ascii ([$enable])
  
  =item $enabled = $json->get_ascii
  
  If C<$enable> is true (or missing), then the C<encode> method will not
  generate characters outside the code range C<0..127> (which is ASCII). Any
  Unicode characters outside that range will be escaped using either a
  single C<\uXXXX> (BMP characters) or a double C<\uHHHH\uLLLLL> escape sequence,
  as per RFC4627. The resulting encoded JSON text can be treated as a native
  Unicode string, an ascii-encoded, latin1-encoded or UTF-8 encoded string,
  or any other superset of ASCII.
  
  If C<$enable> is false, then the C<encode> method will not escape Unicode
  characters unless required by the JSON syntax or other flags. This results
  in a faster and more compact format.
  
  See also the section I<ENCODING/CODESET FLAG NOTES> later in this
  document.
  
  The main use for this flag is to produce JSON texts that can be
  transmitted over a 7-bit channel, as the encoded JSON texts will not
  contain any 8 bit characters.
  
    Cpanel::JSON::XS->new->ascii (1)->encode ([chr 0x10401])
    => ["\ud801\udc01"]
  
  =item $json = $json->latin1 ([$enable])
  
  =item $enabled = $json->get_latin1
  
  If C<$enable> is true (or missing), then the C<encode> method will encode
  the resulting JSON text as latin1 (or ISO-8859-1), escaping any characters
  outside the code range C<0..255>. The resulting string can be treated as a
  latin1-encoded JSON text or a native Unicode string. The C<decode> method
  will not be affected in any way by this flag, as C<decode> by default
  expects Unicode, which is a strict superset of latin1.
  
  If C<$enable> is false, then the C<encode> method will not escape Unicode
  characters unless required by the JSON syntax or other flags.
  
  See also the section I<ENCODING/CODESET FLAG NOTES> later in this
  document.
  
  The main use for this flag is efficiently encoding binary data as JSON
  text, as most octets will not be escaped, resulting in a smaller encoded
  size. The disadvantage is that the resulting JSON text is encoded
  in latin1 (and must correctly be treated as such when storing and
  transferring), a rare encoding for JSON. It is therefore most useful when
  you want to store data structures known to contain binary data efficiently
  in files or databases, not when talking to other JSON encoders/decoders.
  
    Cpanel::JSON::XS->new->latin1->encode (["\x{89}\x{abc}"]
    => ["\x{89}\\u0abc"]    # (perl syntax, U+abc escaped, U+89 not)
  
  
  =item $json = $json->binary ([$enable])
  
  =item $enabled = $json = $json->get_binary
  
  If the C<$enable> argument is true (or missing), then the C<encode>
  method will not try to detect an UTF-8 encoding in any JSON string, it
  will strictly interpret it as byte sequence.  The result might contain
  new C<\xNN> sequences, which is B<unparsable JSON>.  The C<decode>
  method forbids C<\uNNNN> sequences and accepts C<\xNN> and octal
  C<\NNN> sequences.
  
  There is also a special logic for perl 5.6 and utf8. 5.6 encodes any
  string to utf-8 automatically when seeing a codepoint >= C<0x80> and
  < C<0x100>. With the binary flag enabled decode the perl utf8 encoded
  string to the original byte encoding and encode this with C<\xNN>
  escapes. This will result to the same encodings as with newer
  perls. But note that binary multi-byte codepoints with 5.6 will
  result in C<illegal unicode character in binary string> errors,
  unlike with newer perls.
  
  If C<$enable> is false, then the C<encode> method will smartly try to
  detect Unicode characters unless required by the JSON syntax or other
  flags and hex and octal sequences are forbidden.
  
  See also the section I<ENCODING/CODESET FLAG NOTES> later in this
  document.
  
  The main use for this flag is to avoid the smart unicode detection and
  possible double encoding. The disadvantage is that the resulting JSON
  text is encoded in new C<\xNN> and in latin1 characters and must
  correctly be treated as such when storing and transferring, a rare
  encoding for JSON. It will produce non-readable JSON strings in the
  browser.  It is therefore most useful when you want to store data
  structures known to contain binary data efficiently in files or
  databases, not when talking to other JSON encoders/decoders.  The
  binary decoding method can also be used when an encoder produced a
  non-JSON conformant hex or octal encoding C<\xNN> or C<\NNN>.
  
    Cpanel::JSON::XS->new->binary->encode (["\x{89}\x{abc}"])
    5.6:   Error: malformed or illegal unicode character in binary string
    >=5.8: ['\x89\xe0\xaa\xbc']
  
    Cpanel::JSON::XS->new->binary->encode (["\x{89}\x{bc}"])
    => ["\x89\xbc"]
  
    Cpanel::JSON::XS->new->binary->decode (["\x89\ua001"])
    Error: malformed or illegal unicode character in binary string
  
    Cpanel::JSON::XS->new->decode (["\x89"])
    Error: illegal hex character in non-binary string
  
  
  =item $json = $json->utf8 ([$enable])
  
  =item $enabled = $json->get_utf8
  
  If C<$enable> is true (or missing), then the C<encode> method will encode
  the JSON result into UTF-8, as required by many protocols, while the
  C<decode> method expects to be handled an UTF-8-encoded string.  Please
  note that UTF-8-encoded strings do not contain any characters outside the
  range C<0..255>, they are thus useful for bytewise/binary I/O. In future
  versions, enabling this option might enable autodetection of the UTF-16
  and UTF-32 encoding families, as described in RFC4627.
  
  If C<$enable> is false, then the C<encode> method will return the JSON
  string as a (non-encoded) Unicode string, while C<decode> expects thus a
  Unicode string.  Any decoding or encoding (e.g. to UTF-8 or UTF-16) needs
  to be done yourself, e.g. using the Encode module.
  
  See also the section I<ENCODING/CODESET FLAG NOTES> later in this
  document.
  
  Example, output UTF-16BE-encoded JSON:
  
    use Encode;
    $jsontext = encode "UTF-16BE", Cpanel::JSON::XS->new->encode ($object);
  
  Example, decode UTF-32LE-encoded JSON:
  
    use Encode;
    $object = Cpanel::JSON::XS->new->decode (decode "UTF-32LE", $jsontext);
  
  =item $json = $json->pretty ([$enable])
  
  This enables (or disables) all of the C<indent>, C<space_before> and
  C<space_after> (and in the future possibly more) flags in one call to
  generate the most readable (or most compact) form possible.
  
  Example, pretty-print some simple structure:
  
     my $json = Cpanel::JSON::XS->new->pretty(1)->encode ({a => [1,2]})
     =>
     {
        "a" : [
           1,
           2
        ]
     }
  
  
  =item $json = $json->indent ([$enable])
  
  =item $enabled = $json->get_indent
  
  If C<$enable> is true (or missing), then the C<encode> method will use
  a multiline format as output, putting every array member or
  object/hash key-value pair into its own line, indenting them properly.
  
  If C<$enable> is false, no newlines or indenting will be produced, and the
  resulting JSON text is guaranteed not to contain any C<newlines>.
  
  This setting has no effect when decoding JSON texts.
  
  
  =item $json = $json->space_before ([$enable])
  
  =item $enabled = $json->get_space_before
  
  If C<$enable> is true (or missing), then the C<encode> method will add an extra
  optional space before the C<:> separating keys from values in JSON objects.
  
  If C<$enable> is false, then the C<encode> method will not add any extra
  space at those places.
  
  This setting has no effect when decoding JSON texts. You will also
  most likely combine this setting with C<space_after>.
  
  Example, space_before enabled, space_after and indent disabled:
  
     {"key" :"value"}
  
  =item $json = $json->space_after ([$enable])
  
  =item $enabled = $json->get_space_after
  
  If C<$enable> is true (or missing), then the C<encode> method will add
  an extra optional space after the C<:> separating keys from values in
  JSON objects and extra whitespace after the C<,> separating key-value
  pairs and array members.
  
  If C<$enable> is false, then the C<encode> method will not add any extra
  space at those places.
  
  This setting has no effect when decoding JSON texts.
  
  Example, space_before and indent disabled, space_after enabled:
  
     {"key": "value"}
  
  =item $json = $json->relaxed ([$enable])
  
  =item $enabled = $json->get_relaxed
  
  If C<$enable> is true (or missing), then C<decode> will accept some
  extensions to normal JSON syntax (see below). C<encode> will not be
  affected in anyway. I<Be aware that this option makes you accept invalid
  JSON texts as if they were valid!>. I suggest only to use this option to
  parse application-specific files written by humans (configuration files,
  resource files etc.)
  
  If C<$enable> is false (the default), then C<decode> will only accept
  valid JSON texts.
  
  Currently accepted extensions are:
  
  =over 4
  
  =item * list items can have an end-comma
  
  JSON I<separates> array elements and key-value pairs with commas. This
  can be annoying if you write JSON texts manually and want to be able to
  quickly append elements, so this extension accepts comma at the end of
  such items not just between them:
  
     [
        1,
        2, <- this comma not normally allowed
     ]
     {
        "k1": "v1",
        "k2": "v2", <- this comma not normally allowed
     }
  
  =item * shell-style '#'-comments
  
  Whenever JSON allows whitespace, shell-style comments are additionally
  allowed. They are terminated by the first carriage-return or line-feed
  character, after which more white-space and comments are allowed.
  
    [
       1, # this comment not allowed in JSON
          # neither this one...
    ]
  
  =item * literal ASCII TAB characters in strings
  
  Literal ASCII TAB characters are now allowed in strings (and treated as
  C<\t>) in relaxed mode. Despite JSON mandates, that TAB character is
  substituted for "\t" sequence.
  
    [
       "Hello\tWorld",
       "Hello<TAB>World", # literal <TAB> would not normally be allowed
    ]
  
  =item * allow_singlequote
  
  Single quotes are accepted instead of double quotes. See the
  L</allow_singlequote> option.
  
      { "foo":'bar' }
      { 'foo':"bar" }
      { 'foo':'bar' }
  
  =item * allow_barekey
  
  Accept unquoted object keys instead of with mandatory double quotes. See the
  L</allow_barekey> option.
  
      { foo:"bar" }
  
  =item * duplicate keys
  
  With relaxed decoding of duplicate keys does not error and are silently accepted.
  See L<http://seriot.ch/parsing_json.php#24>:
  RFC 7159 section 4: "The names within an object should be unique."
  
  =back
  
  
  =item $json = $json->canonical ([$enable])
  
  =item $enabled = $json->get_canonical
  
  If C<$enable> is true (or missing), then the C<encode> method will
  output JSON objects by sorting their keys. This is adding a
  comparatively high overhead.
  
  If C<$enable> is false, then the C<encode> method will output key-value
  pairs in the order Perl stores them (which will likely change between runs
  of the same script, and can change even within the same run from 5.18
  onwards).
  
  This option is useful if you want the same data structure to be encoded as
  the same JSON text (given the same overall settings). If it is disabled,
  the same hash might be encoded differently even if contains the same data,
  as key-value pairs have no inherent ordering in Perl.
  
  This setting has no effect when decoding JSON texts.
  
  This setting has currently no effect on tied hashes.
  
  
  =item $json = $json->sort_by (undef, 0, 1 or a block)
  
  This currently only (un)sets the C<canonical> option, and ignores
  custom sort blocks.
  
  This setting has no effect when decoding JSON texts.
  
  This setting has currently no effect on tied hashes.
  
  
  =item $json = $json->escape_slash ([$enable])
  
  =item $enabled = $json->get_escape_slash
  
  According to the JSON Grammar, the I<forward slash> character (U+002F)
  C<"/"> need to be escaped.  But by default strings are encoded without
  escaping slashes in all perl JSON encoders.
  
  If C<$enable> is true (or missing), then C<encode> will escape slashes,
  C<"\/">.
  
  This setting has no effect when decoding JSON texts.
  
  
  =item $json = $json->allow_singlequote ([$enable])
  
  =item $enabled = $json->get_allow_singlequote
  
      $json = $json->allow_singlequote([$enable])
  
  If C<$enable> is true (or missing), then C<decode> will accept
  JSON strings quoted by single quotations that are invalid JSON
  format.
  
      $json->allow_singlequote->decode({"foo":'bar'});
      $json->allow_singlequote->decode({'foo':"bar"});
      $json->allow_singlequote->decode({'foo':'bar'});
  
  This is also enabled with C<relaxed>.
  As same as the C<relaxed> option, this option may be used to parse
  application-specific files written by humans.
  
  
  =item $json = $json->allow_barekey ([$enable])
  
  =item $enabled = $json->get_allow_barekey
  
      $json = $json->allow_barekey([$enable])
  
  If C<$enable> is true (or missing), then C<decode> will accept
  bare keys of JSON object that are invalid JSON format.
  
  Same as with the C<relaxed> option, this option may be used to parse
  application-specific files written by humans.
  
      $json->allow_barekey->decode('{foo:"bar"}');
  
  =item $json = $json->allow_bignum ([$enable])
  
  =item $enabled = $json->get_allow_bignum
  
      $json = $json->allow_bignum([$enable])
  
  If C<$enable> is true (or missing), then C<decode> will convert
  the big integer Perl cannot handle as integer into a L<Math::BigInt>
  object and convert a floating number (any) into a L<Math::BigFloat>.
  
  On the contrary, C<encode> converts C<Math::BigInt> objects and
  C<Math::BigFloat> objects into JSON numbers with C<allow_blessed>
  enable.
  
     $json->allow_nonref->allow_blessed->allow_bignum;
     $bigfloat = $json->decode('2.000000000000000000000000001');
     print $json->encode($bigfloat);
     # => 2.000000000000000000000000001
  
  See L</MAPPING> about the normal conversion of JSON number.
  
  
  =item $json = $json->allow_bigint ([$enable])
  
  This option is obsolete and replaced by allow_bignum.
  
  
  =item $json = $json->allow_nonref ([$enable])
  
  =item $enabled = $json->get_allow_nonref
  
  If C<$enable> is true (or missing), then the C<encode> method can
  convert a non-reference into its corresponding string, number or null
  JSON value, which is an extension to RFC4627. Likewise, C<decode> will
  accept those JSON values instead of croaking.
  
  If C<$enable> is false, then the C<encode> method will croak if it isn't
  passed an arrayref or hashref, as JSON texts must either be an object
  or array. Likewise, C<decode> will croak if given something that is not a
  JSON object or array.
  
  Example, encode a Perl scalar as JSON value with enabled C<allow_nonref>,
  resulting in an invalid JSON text:
  
     Cpanel::JSON::XS->new->allow_nonref->encode ("Hello, World!")
     => "Hello, World!"
  
  =item $json = $json->allow_unknown ([$enable])
  
  =item $enabled = $json->get_allow_unknown
  
  If C<$enable> is true (or missing), then C<encode> will I<not> throw an
  exception when it encounters values it cannot represent in JSON (for
  example, filehandles) but instead will encode a JSON C<null> value. Note
  that blessed objects are not included here and are handled separately by
  c<allow_nonref>.
  
  If C<$enable> is false (the default), then C<encode> will throw an
  exception when it encounters anything it cannot encode as JSON.
  
  This option does not affect C<decode> in any way, and it is recommended to
  leave it off unless you know your communications partner.
  
  =item $json = $json->allow_stringify ([$enable])
  
  =item $enabled = $json->get_allow_stringify
  
  If C<$enable> is true (or missing), then C<encode> will stringify the
  non-object perl value or reference. Note that blessed objects are not
  included here and are handled separately by C<allow_blessed> and
  C<convert_blessed>.  String references are stringified to the string
  value, other references as in perl.
  
  This option does not affect C<decode> in any way.
  
  This option is special to this module, it is not supported by other
  encoders.  So it is not recommended to use it.
  
  =item $json = $json->allow_blessed ([$enable])
  
  =item $enabled = $json->get_allow_blessed
  
  If C<$enable> is true (or missing), then the C<encode> method will not
  barf when it encounters a blessed reference. Instead, the value of the
  B<convert_blessed> option will decide whether C<null> (C<convert_blessed>
  disabled or no C<TO_JSON> method found) or a representation of the
  object (C<convert_blessed> enabled and C<TO_JSON> method found) is being
  encoded. Has no effect on C<decode>.
  
  If C<$enable> is false (the default), then C<encode> will throw an
  exception when it encounters a blessed object.
  
  This setting has no effect on C<decode>.
  
  =item $json = $json->convert_blessed ([$enable])
  
  =item $enabled = $json->get_convert_blessed
  
  If C<$enable> is true (or missing), then C<encode>, upon encountering a
  blessed object, will check for the availability of the C<TO_JSON> method
  on the object's class. If found, it will be called in scalar context
  and the resulting scalar will be encoded instead of the object. If no
  C<TO_JSON> method is found, a stringification overload method is tried next.
  If both are not found, the value of C<allow_blessed> will decide what
  to do.
  
  The C<TO_JSON> method may safely call die if it wants. If C<TO_JSON>
  returns other blessed objects, those will be handled in the same
  way. C<TO_JSON> must take care of not causing an endless recursion cycle
  (== crash) in this case. The name of C<TO_JSON> was chosen because other
  methods called by the Perl core (== not by the user of the object) are
  usually in upper case letters and to avoid collisions with any C<to_json>
  function or method.
  
  If C<$enable> is false (the default), then C<encode> will not consider
  this type of conversion.
  
  This setting has no effect on C<decode>.
  
  =item $json = $json->allow_tags ([$enable])
  
  =item $enabled = $json->get_allow_tags
  
  See L<OBJECT SERIALIZATION> for details.
  
  If C<$enable> is true (or missing), then C<encode>, upon encountering a
  blessed object, will check for the availability of the C<FREEZE> method on
  the object's class. If found, it will be used to serialize the object into
  a nonstandard tagged JSON value (that JSON decoders cannot decode).
  
  It also causes C<decode> to parse such tagged JSON values and deserialize
  them via a call to the C<THAW> method.
  
  If C<$enable> is false (the default), then C<encode> will not consider
  this type of conversion, and tagged JSON values will cause a parse error
  in C<decode>, as if tags were not part of the grammar.
  
  =item $json = $json->filter_json_object ([$coderef->($hashref)])
  
  When C<$coderef> is specified, it will be called from C<decode> each
  time it decodes a JSON object. The only argument is a reference to the
  newly-created hash. If the code references returns a single scalar (which
  need not be a reference), this value (i.e. a copy of that scalar to avoid
  aliasing) is inserted into the deserialized data structure. If it returns
  an empty list (NOTE: I<not> C<undef>, which is a valid scalar), the
  original deserialized hash will be inserted. This setting can slow down
  decoding considerably.
  
  When C<$coderef> is omitted or undefined, any existing callback will
  be removed and C<decode> will not change the deserialized hash in any
  way.
  
  Example, convert all JSON objects into the integer 5:
  
     my $js = Cpanel::JSON::XS->new->filter_json_object (sub { 5 });
     # returns [5]
     $js->decode ('[{}]')
     # throw an exception because allow_nonref is not enabled
     # so a lone 5 is not allowed.
     $js->decode ('{"a":1, "b":2}');
  
  =item $json = $json->filter_json_single_key_object ($key [=> $coderef->($value)])
  
  Works remotely similar to C<filter_json_object>, but is only called for
  JSON objects having a single key named C<$key>.
  
  This C<$coderef> is called before the one specified via
  C<filter_json_object>, if any. It gets passed the single value in the JSON
  object. If it returns a single value, it will be inserted into the data
  structure. If it returns nothing (not even C<undef> but the empty list),
  the callback from C<filter_json_object> will be called next, as if no
  single-key callback were specified.
  
  If C<$coderef> is omitted or undefined, the corresponding callback will be
  disabled. There can only ever be one callback for a given key.
  
  As this callback gets called less often then the C<filter_json_object>
  one, decoding speed will not usually suffer as much. Therefore, single-key
  objects make excellent targets to serialize Perl objects into, especially
  as single-key JSON objects are as close to the type-tagged value concept
  as JSON gets (it's basically an ID/VALUE tuple). Of course, JSON does not
  support this in any way, so you need to make sure your data never looks
  like a serialized Perl hash.
  
  Typical names for the single object key are C<__class_whatever__>, or
  C<$__dollars_are_rarely_used__$> or C<}ugly_brace_placement>, or even
  things like C<__class_md5sum(classname)__>, to reduce the risk of clashing
  with real hashes.
  
  Example, decode JSON objects of the form C<< { "__widget__" => <id> } >>
  into the corresponding C<< $WIDGET{<id>} >> object:
  
     # return whatever is in $WIDGET{5}:
     Cpanel::JSON::XS
        ->new
        ->filter_json_single_key_object (__widget__ => sub {
              $WIDGET{ $_[0] }
           })
        ->decode ('{"__widget__": 5')
  
     # this can be used with a TO_JSON method in some "widget" class
     # for serialization to json:
     sub WidgetBase::TO_JSON {
        my ($self) = @_;
  
        unless ($self->{id}) {
           $self->{id} = ..get..some..id..;
           $WIDGET{$self->{id}} = $self;
        }
  
        { __widget__ => $self->{id} }
     }
  
  =item $json = $json->shrink ([$enable])
  
  =item $enabled = $json->get_shrink
  
  Perl usually over-allocates memory a bit when allocating space for
  strings. This flag optionally resizes strings generated by either
  C<encode> or C<decode> to their minimum size possible. This can save
  memory when your JSON texts are either very very long or you have many
  short strings. It will also try to downgrade any strings to octet-form
  if possible: perl stores strings internally either in an encoding called
  UTF-X or in octet-form. The latter cannot store everything but uses less
  space in general (and some buggy Perl or C code might even rely on that
  internal representation being used).
  
  The actual definition of what shrink does might change in future versions,
  but it will always try to save space at the expense of time.
  
  If C<$enable> is true (or missing), the string returned by C<encode> will
  be shrunk-to-fit, while all strings generated by C<decode> will also be
  shrunk-to-fit.
  
  If C<$enable> is false, then the normal perl allocation algorithms are used.
  If you work with your data, then this is likely to be faster.
  
  In the future, this setting might control other things, such as converting
  strings that look like integers or floats into integers or floats
  internally (there is no difference on the Perl level), saving space.
  
  =item $json = $json->max_depth ([$maximum_nesting_depth])
  
  =item $max_depth = $json->get_max_depth
  
  Sets the maximum nesting level (default C<512>) accepted while encoding
  or decoding. If a higher nesting level is detected in JSON text or a Perl
  data structure, then the encoder and decoder will stop and croak at that
  point.
  
  Nesting level is defined by number of hash- or arrayrefs that the encoder
  needs to traverse to reach a given point or the number of C<{> or C<[>
  characters without their matching closing parenthesis crossed to reach a
  given character in a string.
  
  Setting the maximum depth to one disallows any nesting, so that ensures
  that the object is only a single hash/object or array.
  
  If no argument is given, the highest possible setting will be used, which
  is rarely useful.
  
  Note that nesting is implemented by recursion in C. The default value has
  been chosen to be as large as typical operating systems allow without
  crashing.
  
  See SECURITY CONSIDERATIONS, below, for more info on why this is useful.
  
  =item $json = $json->max_size ([$maximum_string_size])
  
  =item $max_size = $json->get_max_size
  
  Set the maximum length a JSON text may have (in bytes) where decoding is
  being attempted. The default is C<0>, meaning no limit. When C<decode>
  is called on a string that is longer then this many bytes, it will not
  attempt to decode the string but throw an exception. This setting has no
  effect on C<encode> (yet).
  
  If no argument is given, the limit check will be deactivated (same as when
  C<0> is specified).
  
  See L</SECURITY CONSIDERATIONS>, below, for more info on why this is useful.
  
  =item $json->stringify_infnan ([$infnan_mode = 1])
  
  =item $infnan_mode = $json->get_stringify_infnan
  
  Get or set how Cpanel::JSON::XS encodes C<inf>, C<-inf> or C<nan> for numeric
  values. Also qnan, snan or negative nan on some platforms.
  
  C<null>:     infnan_mode = 0. Similar to most JSON modules in other languages.
  Always null.
  
  stringified: infnan_mode = 1. As in Mojo::JSON. Platform specific strings.
  Stringified via sprintf(%g), with double quotes.
  
  inf/nan:     infnan_mode = 2. As in JSON::XS, and older releases.
  Passes through platform dependent values, invalid JSON. Stringified via
  sprintf(%g), but without double quotes.
  
  "inf/-inf/nan": infnan_mode = 3. Platform independent inf/nan/-inf
  strings.  No QNAN/SNAN/negative NAN support, unified to "nan". Much
  easier to detect, but may conflict with valid strings.
  
  =item $json_text = $json->encode ($perl_scalar)
  
  Converts the given Perl data structure (a simple scalar or a reference
  to a hash or array) to its JSON representation. Simple scalars will be
  converted into JSON string or number sequences, while references to
  arrays become JSON arrays and references to hashes become JSON
  objects. Undefined Perl values (e.g. C<undef>) become JSON C<null>
  values. Neither C<true> nor C<false> values will be generated.
  
  =item $perl_scalar = $json->decode ($json_text)
  
  The opposite of C<encode>: expects a JSON text and tries to parse it,
  returning the resulting simple scalar or reference. Croaks on error.
  
  JSON numbers and strings become simple Perl scalars. JSON arrays become
  Perl arrayrefs and JSON objects become Perl hashrefs. C<true> becomes
  C<1>, C<false> becomes C<0> and C<null> becomes C<undef>.
  
  =item ($perl_scalar, $characters) = $json->decode_prefix ($json_text)
  
  This works like the C<decode> method, but instead of raising an exception
  when there is trailing garbage after the first JSON object, it will
  silently stop parsing there and return the number of characters consumed
  so far.
  
  This is useful if your JSON texts are not delimited by an outer protocol
  and you need to know where the JSON text ends.
  
     Cpanel::JSON::XS->new->decode_prefix ("[1] the tail")
     => ([1], 3)
  
  =item $json->to_json ($perl_hash_or_arrayref)
  
  Deprecated method for perl 5.8 and newer. Use L<encode_json> instead.
  
  =item $json->from_json ($utf8_encoded_json_text)
  
  Deprecated method for perl 5.8 and newer. Use L<decode_json> instead.
  
  =back
  
  
  =head1 INCREMENTAL PARSING
  
  In some cases, there is the need for incremental parsing of JSON
  texts. While this module always has to keep both JSON text and resulting
  Perl data structure in memory at one time, it does allow you to parse a
  JSON stream incrementally. It does so by accumulating text until it has
  a full JSON object, which it then can decode. This process is similar to
  using C<decode_prefix> to see if a full JSON object is available, but
  is much more efficient (and can be implemented with a minimum of method
  calls).
  
  Cpanel::JSON::XS will only attempt to parse the JSON text once it is
  sure it has enough text to get a decisive result, using a very simple
  but truly incremental parser. This means that it sometimes won't stop
  as early as the full parser, for example, it doesn't detect mismatched
  parentheses. The only thing it guarantees is that it starts decoding
  as soon as a syntactically valid JSON text has been seen. This means
  you need to set resource limits (e.g. C<max_size>) to ensure the
  parser will stop parsing in the presence if syntax errors.
  
  The following methods implement this incremental parser.
  
  =over 4
  
  =item [void, scalar or list context] = $json->incr_parse ([$string])
  
  This is the central parsing function. It can both append new text and
  extract objects from the stream accumulated so far (both of these
  functions are optional).
  
  If C<$string> is given, then this string is appended to the already
  existing JSON fragment stored in the C<$json> object.
  
  After that, if the function is called in void context, it will simply
  return without doing anything further. This can be used to add more text
  in as many chunks as you want.
  
  If the method is called in scalar context, then it will try to extract
  exactly I<one> JSON object. If that is successful, it will return this
  object, otherwise it will return C<undef>. If there is a parse error,
  this method will croak just as C<decode> would do (one can then use
  C<incr_skip> to skip the erroneous part). This is the most common way of
  using the method.
  
  And finally, in list context, it will try to extract as many objects
  from the stream as it can find and return them, or the empty list
  otherwise. For this to work, there must be no separators between the JSON
  objects or arrays, instead they must be concatenated back-to-back. If
  an error occurs, an exception will be raised as in the scalar context
  case. Note that in this case, any previously-parsed JSON texts will be
  lost.
  
  Example: Parse some JSON arrays/objects in a given string and return
  them.
  
     my @objs = Cpanel::JSON::XS->new->incr_parse ("[5][7][1,2]");
  
  =item $lvalue_string = $json->incr_text (>5.8 only)
  
  This method returns the currently stored JSON fragment as an lvalue, that
  is, you can manipulate it. This I<only> works when a preceding call to
  C<incr_parse> in I<scalar context> successfully returned an object, and
  2. only with Perl >= 5.8 
  
  Under all other circumstances you must not call this function (I mean
  it.  although in simple tests it might actually work, it I<will> fail
  under real world conditions). As a special exception, you can also
  call this method before having parsed anything.
  
  This function is useful in two cases: a) finding the trailing text after a
  JSON object or b) parsing multiple JSON objects separated by non-JSON text
  (such as commas).
  
  =item $json->incr_skip
  
  This will reset the state of the incremental parser and will remove
  the parsed text from the input buffer so far. This is useful after
  C<incr_parse> died, in which case the input buffer and incremental parser
  state is left unchanged, to skip the text parsed so far and to reset the
  parse state.
  
  The difference to C<incr_reset> is that only text until the parse error
  occurred is removed.
  
  =item $json->incr_reset
  
  This completely resets the incremental parser, that is, after this call,
  it will be as if the parser had never parsed anything.
  
  This is useful if you want to repeatedly parse JSON objects and want to
  ignore any trailing data, which means you have to reset the parser after
  each successful decode.
  
  =back
  
  =head2 LIMITATIONS
  
  All options that affect decoding are supported, except
  C<allow_nonref>. The reason for this is that it cannot be made to work
  sensibly: JSON objects and arrays are self-delimited, i.e. you can
  concatenate them back to back and still decode them perfectly. This
  does not hold true for JSON numbers, however.
  
  For example, is the string C<1> a single JSON number, or is it simply
  the start of C<12>? Or is C<12> a single JSON number, or the
  concatenation of C<1> and C<2>? In neither case you can tell, and this
  is why Cpanel::JSON::XS takes the conservative route and disallows
  this case.
  
  =head2 EXAMPLES
  
  Some examples will make all this clearer. First, a simple example that
  works similarly to C<decode_prefix>: We want to decode the JSON object at
  the start of a string and identify the portion after the JSON object:
  
     my $text = "[1,2,3] hello";
  
     my $json = new Cpanel::JSON::XS;
  
     my $obj = $json->incr_parse ($text)
        or die "expected JSON object or array at beginning of string";
  
     my $tail = $json->incr_text;
     # $tail now contains " hello"
  
  Easy, isn't it?
  
  Now for a more complicated example: Imagine a hypothetical protocol where
  you read some requests from a TCP stream, and each request is a JSON
  array, without any separation between them (in fact, it is often useful to
  use newlines as "separators", as these get interpreted as whitespace at
  the start of the JSON text, which makes it possible to test said protocol
  with C<telnet>...).
  
  Here is how you'd do it (it is trivial to write this in an event-based
  manner):
  
     my $json = new Cpanel::JSON::XS;
  
     # read some data from the socket
     while (sysread $socket, my $buf, 4096) {
  
        # split and decode as many requests as possible
        for my $request ($json->incr_parse ($buf)) {
           # act on the $request
        }
     }
  
  Another complicated example: Assume you have a string with JSON objects
  or arrays, all separated by (optional) comma characters (e.g. C<[1],[2],
  [3]>). To parse them, we have to skip the commas between the JSON texts,
  and here is where the lvalue-ness of C<incr_text> comes in useful:
  
     my $text = "[1],[2], [3]";
     my $json = new Cpanel::JSON::XS;
  
     # void context, so no parsing done
     $json->incr_parse ($text);
  
     # now extract as many objects as possible. note the
     # use of scalar context so incr_text can be called.
     while (my $obj = $json->incr_parse) {
        # do something with $obj
  
        # now skip the optional comma
        $json->incr_text =~ s/^ \s* , //x;
     }
  
  Now lets go for a very complex example: Assume that you have a gigantic
  JSON array-of-objects, many gigabytes in size, and you want to parse it,
  but you cannot load it into memory fully (this has actually happened in
  the real world :).
  
  Well, you lost, you have to implement your own JSON parser. But
  Cpanel::JSON::XS can still help you: You implement a (very simple)
  array parser and let JSON decode the array elements, which are all
  full JSON objects on their own (this wouldn't work if the array
  elements could be JSON numbers, for example):
  
     my $json = new Cpanel::JSON::XS;
  
     # open the monster
     open my $fh, "<bigfile.json"
        or die "bigfile: $!";
  
     # first parse the initial "["
     for (;;) {
        sysread $fh, my $buf, 65536
           or die "read error: $!";
        $json->incr_parse ($buf); # void context, so no parsing
  
        # Exit the loop once we found and removed(!) the initial "[".
        # In essence, we are (ab-)using the $json object as a simple scalar
        # we append data to.
        last if $json->incr_text =~ s/^ \s* \[ //x;
     }
  
     # now we have the skipped the initial "[", so continue
     # parsing all the elements.
     for (;;) {
        # in this loop we read data until we got a single JSON object
        for (;;) {
           if (my $obj = $json->incr_parse) {
              # do something with $obj
              last;
           }
  
           # add more data
           sysread $fh, my $buf, 65536
              or die "read error: $!";
           $json->incr_parse ($buf); # void context, so no parsing
        }
  
        # in this loop we read data until we either found and parsed the
        # separating "," between elements, or the final "]"
        for (;;) {
           # first skip whitespace
           $json->incr_text =~ s/^\s*//;
  
           # if we find "]", we are done
           if ($json->incr_text =~ s/^\]//) {
              print "finished.\n";
              exit;
           }
  
           # if we find ",", we can continue with the next element
           if ($json->incr_text =~ s/^,//) {
              last;
           }
  
           # if we find anything else, we have a parse error!
           if (length $json->incr_text) {
              die "parse error near ", $json->incr_text;
           }
  
           # else add more data
           sysread $fh, my $buf, 65536
              or die "read error: $!";
           $json->incr_parse ($buf); # void context, so no parsing
        }
  
  This is a complex example, but most of the complexity comes from the fact
  that we are trying to be correct (bear with me if I am wrong, I never ran
  the above example :).
  
  =head1 BOM
  
  Detect all unicode B<Byte Order Marks> on decode.
  Which are UTF-8, UTF-16LE, UTF-16BE, UTF-32LE and UTF-32BE.
  
  B<Warning>: With perls older than 5.20 you need load the Encode module
  before loading a multibyte BOM, i.e. >= UTF-16. Otherwise an error is
  thrown. This is an implementation limitation and might get fixed later.
  
  See L<https://tools.ietf.org/html/rfc7159#section-8.1>
  I<"JSON text SHALL be encoded in UTF-8, UTF-16, or UTF-32.">
  
  I<"Implementations MUST NOT add a byte order mark to the beginning of a
  JSON text", "implementations (...) MAY ignore the presence of a byte
  order mark rather than treating it as an error".>
  
  See also L<http://www.unicode.org/faq/utf_bom.html#BOM>.
  
  Beware that Cpanel::JSON::XS is currently the only JSON module which
  does accept and decode a BOM.
  
  =head1 MAPPING
  
  This section describes how Cpanel::JSON::XS maps Perl values to JSON
  values and vice versa. These mappings are designed to "do the right
  thing" in most circumstances automatically, preserving round-tripping
  characteristics (what you put in comes out as something equivalent).
  
  For the more enlightened: note that in the following descriptions,
  lowercase I<perl> refers to the Perl interpreter, while uppercase I<Perl>
  refers to the abstract Perl language itself.
  
  
  =head2 JSON -> PERL
  
  =over 4
  
  =item object
  
  A JSON object becomes a reference to a hash in Perl. No ordering of object
  keys is preserved (JSON does not preserve object key ordering itself).
  
  =item array
  
  A JSON array becomes a reference to an array in Perl.
  
  =item string
  
  A JSON string becomes a string scalar in Perl - Unicode codepoints in JSON
  are represented by the same codepoints in the Perl string, so no manual
  decoding is necessary.
  
  =item number
  
  A JSON number becomes either an integer, numeric (floating point) or
  string scalar in perl, depending on its range and any fractional parts. On
  the Perl level, there is no difference between those as Perl handles all
  the conversion details, but an integer may take slightly less memory and
  might represent more values exactly than floating point numbers.
  
  If the number consists of digits only, Cpanel::JSON::XS will try to
  represent it as an integer value. If that fails, it will try to
  represent it as a numeric (floating point) value if that is possible
  without loss of precision. Otherwise it will preserve the number as a
  string value (in which case you lose roundtripping ability, as the
  JSON number will be re-encoded to a JSON string).
  
  Numbers containing a fractional or exponential part will always be
  represented as numeric (floating point) values, possibly at a loss of
  precision (in which case you might lose perfect roundtripping ability, but
  the JSON number will still be re-encoded as a JSON number).
  
  Note that precision is not accuracy - binary floating point values
  cannot represent most decimal fractions exactly, and when converting
  from and to floating point, C<Cpanel::JSON::XS> only guarantees precision
  up to but not including the least significant bit.
  
  =item true, false
  
  These JSON atoms become C<Cpanel::JSON::XS::true> and
  C<Cpanel::JSON::XS::false>, respectively. They are C<JSON::PP::Boolean>
  objects and are overloaded to act almost exactly like the numbers C<1>
  and C<0>. You can check whether a scalar is a JSON boolean by using
  the C<Cpanel::JSON::XS::is_bool> function.
  
  The other round, from perl to JSON, C<!0> which is represented as
  C<yes> becomes C<true>, and C<!1> which is represented as
  C<no> becomes C<false>.
  
  =item null
  
  A JSON null atom becomes C<undef> in Perl.
  
  =item shell-style comments (C<< # I<text> >>)
  
  As a nonstandard extension to the JSON syntax that is enabled by the
  C<relaxed> setting, shell-style comments are allowed. They can start
  anywhere outside strings and go till the end of the line.
  
  =item tagged values (C<< (I<tag>)I<value> >>).
  
  Another nonstandard extension to the JSON syntax, enabled with the
  C<allow_tags> setting, are tagged values. In this implementation, the
  I<tag> must be a perl package/class name encoded as a JSON string, and the
  I<value> must be a JSON array encoding optional constructor arguments.
  
  See L<OBJECT SERIALIZATION>, below, for details.
  
  =back
  
  
  =head2 PERL -> JSON
  
  The mapping from Perl to JSON is slightly more difficult, as Perl is a
  truly typeless language, so we can only guess which JSON type is meant by
  a Perl value.
  
  =over 4
  
  =item hash references
  
  Perl hash references become JSON objects. As there is no inherent ordering
  in hash keys (or JSON objects), they will usually be encoded in a
  pseudo-random order that can change between runs of the same program but
  stays generally the same within a single run of a program. Cpanel::JSON::XS can
  optionally sort the hash keys (determined by the I<canonical> flag), so
  the same datastructure will serialize to the same JSON text (given same
  settings and version of Cpanel::JSON::XS), but this incurs a runtime overhead
  and is only rarely useful, e.g. when you want to compare some JSON text
  against another for equality.
  
  =item array references
  
  Perl array references become JSON arrays.
  
  =item other references
  
  Other unblessed references are generally not allowed and will cause an
  exception to be thrown, except for references to the integers C<0> and
  C<1>, which get turned into C<false> and C<true> atoms in JSON. 
  
  With the option C<allow_stringify>, you can ignore the exception and return
  the stringification of the perl value.
  
  With the option C<allow_unknown>, you can ignore the exception and
  return C<null> instead.
  
     encode_json [\"x"]        # => cannot encode reference to scalar 'SCALAR(0x..)'
                               # unless the scalar is 0 or 1
     encode_json [\0, \1]      # yields [false,true]
  
     allow_stringify->encode_json [\"x"] # yields "x" unlike JSON::PP
     allow_unknown->encode_json [\"x"]   # yields null as in JSON::PP
  
  =item Cpanel::JSON::XS::true, Cpanel::JSON::XS::false
  
  These special values become JSON true and JSON false values,
  respectively. You can also use C<\1> and C<\0> or C<!0> and C<!1>
  directly if you want.
  
     encode_json [Cpanel::JSON::XS::true, Cpanel::JSON::XS::true] # yields [false,true]
     encode_json [!1, !0]      # yields [false,true]
  
  =item blessed objects
  
  Blessed objects are not directly representable in JSON, but
  C<Cpanel::JSON::XS> allows various optional ways of handling
  objects. See L<OBJECT SERIALIZATION>, below, for details.
  
  See the C<allow_blessed> and C<convert_blessed> methods on various
  options on how to deal with this: basically, you can choose between
  throwing an exception, encoding the reference as if it weren't
  blessed, use the objects overloaded stringification method or provide
  your own serializer method.
  
  =item simple scalars
  
  Simple Perl scalars (any scalar that is not a reference) are the most
  difficult objects to encode: Cpanel::JSON::XS will encode undefined
  scalars or inf/nan as JSON C<null> values, scalars that have last been
  used in a string context before encoding as JSON strings, and anything
  else as number value:
  
     # dump as number
     encode_json [2]                      # yields [2]
     encode_json [-3.0e17]                # yields [-3e+17]
     my $value = 5; encode_json [$value]  # yields [5]
  
     # used as string, but the two representations are for the same number
     print $value;
     encode_json [$value]                 # yields [5]
  
     # used as different string (non-matching dual-var)
     my $str = '0 but true';
     my $num = 1 + $str;
     encode_json [$num, $str]           # yields [1,"0 but true"]
  
     # undef becomes null
     encode_json [undef]                  # yields [null]
  
     # inf or nan becomes null, unless you answered
     # "Do you want to handle inf/nan as strings" with yes
     encode_json [9**9**9]                # yields [null]
  
  You can force the type to be a JSON string by stringifying it:
  
     my $x = 3.1; # some variable containing a number
     "$x";        # stringified
     $x .= "";    # another, more awkward way to stringify
     print $x;    # perl does it for you, too, quite often
  
  You can force the type to be a JSON number by numifying it:
  
     my $x = "3"; # some variable containing a string
     $x += 0;     # numify it, ensuring it will be dumped as a number
     $x *= 1;     # same thing, the choice is yours.
  
  Note that numerical precision has the same meaning as under Perl (so
  binary to decimal conversion follows the same rules as in Perl, which
  can differ to other languages). Also, your perl interpreter might expose
  extensions to the floating point numbers of your platform, such as
  infinities or NaN's - these cannot be represented in JSON, and thus
  null is returned instead. Optionally you can configure it to stringify
  inf and nan values.
  
  =back
  
  =head2 OBJECT SERIALIZATION
  
  As JSON cannot directly represent Perl objects, you have to choose between
  a pure JSON representation (without the ability to deserialize the object
  automatically again), and a nonstandard extension to the JSON syntax,
  tagged values.
  
  =head3 SERIALIZATION
  
  What happens when C<Cpanel::JSON::XS> encounters a Perl object depends
  on the C<allow_blessed>, C<convert_blessed> and C<allow_tags>
  settings, which are used in this order:
  
  =over 4
  
  =item 1. C<allow_tags> is enabled and the object has a C<FREEZE> method.
  
  In this case, C<Cpanel::JSON::XS> uses the L<Types::Serialiser> object
  serialization protocol to create a tagged JSON value, using a nonstandard
  extension to the JSON syntax.
  
  This works by invoking the C<FREEZE> method on the object, with the first
  argument being the object to serialize, and the second argument being the
  constant string C<JSON> to distinguish it from other serializers.
  
  The C<FREEZE> method can return any number of values (i.e. zero or
  more). These values and the paclkage/classname of the object will then be
  encoded as a tagged JSON value in the following format:
  
     ("classname")[FREEZE return values...]
  
  e.g.:
  
     ("URI")["http://www.google.com/"]
     ("MyDate")[2013,10,29]
     ("ImageData::JPEG")["Z3...VlCg=="]
  
  For example, the hypothetical C<My::Object> C<FREEZE> method might use the
  objects C<type> and C<id> members to encode the object:
  
     sub My::Object::FREEZE {
        my ($self, $serializer) = @_;
  
        ($self->{type}, $self->{id})
     }
  
  =item 2. C<convert_blessed> is enabled and the object has a C<TO_JSON> method.
  
  In this case, the C<TO_JSON> method of the object is invoked in scalar
  context. It must return a single scalar that can be directly encoded into
  JSON. This scalar replaces the object in the JSON text.
  
  For example, the following C<TO_JSON> method will convert all L<URI>
  objects to JSON strings when serialized. The fact that these values
  originally were L<URI> objects is lost.
  
     sub URI::TO_JSON {
        my ($uri) = @_;
        $uri->as_string
     }
  
  =item 2. C<convert_blessed> is enabled and the object has a stringification overload.
  
  In this case, the overloaded C<""> method of the object is invoked in scalar
  context. It must return a single scalar that can be directly encoded into
  JSON. This scalar replaces the object in the JSON text.
  
  For example, the following C<""> method will convert all L<URI>
  objects to JSON strings when serialized. The fact that these values
  originally were L<URI> objects is lost.
  
      package URI;
      use overload '""' => sub { shift->as_string };
  
  =item 3. C<allow_blessed> is enabled.
  
  The object will be serialized as a JSON null value.
  
  =item 4. none of the above
  
  If none of the settings are enabled or the respective methods are missing,
  C<Cpanel::JSON::XS> throws an exception.
  
  =back
  
  =head3 DESERIALIZATION
  
  For deserialization there are only two cases to consider: either
  nonstandard tagging was used, in which case C<allow_tags> decides,
  or objects cannot be automatically be deserialized, in which
  case you can use postprocessing or the C<filter_json_object> or
  C<filter_json_single_key_object> callbacks to get some real objects our of
  your JSON.
  
  This section only considers the tagged value case: I a tagged JSON object
  is encountered during decoding and C<allow_tags> is disabled, a parse
  error will result (as if tagged values were not part of the grammar).
  
  If C<allow_tags> is enabled, C<Cpanel::JSON::XS> will look up the C<THAW> method
  of the package/classname used during serialization (it will not attempt
  to load the package as a Perl module). If there is no such method, the
  decoding will fail with an error.
  
  Otherwise, the C<THAW> method is invoked with the classname as first
  argument, the constant string C<JSON> as second argument, and all the
  values from the JSON array (the values originally returned by the
  C<FREEZE> method) as remaining arguments.
  
  The method must then return the object. While technically you can return
  any Perl scalar, you might have to enable the C<enable_nonref> setting to
  make that work in all cases, so better return an actual blessed reference.
  
  As an example, let's implement a C<THAW> function that regenerates the
  C<My::Object> from the C<FREEZE> example earlier:
  
     sub My::Object::THAW {
        my ($class, $serializer, $type, $id) = @_;
  
        $class->new (type => $type, id => $id)
     }
  
  See the L</SECURITY CONSIDERATIONS> section below. Allowing external
  json objects being deserialized to perl objects is usually a very bad
  idea.
  
  
  =head1 ENCODING/CODESET FLAG NOTES
  
  The interested reader might have seen a number of flags that signify
  encodings or codesets - C<utf8>, C<latin1>, C<binary> and
  C<ascii>. There seems to be some confusion on what these do, so here
  is a short comparison:
  
  C<utf8> controls whether the JSON text created by C<encode> (and expected
  by C<decode>) is UTF-8 encoded or not, while C<latin1> and C<ascii> only
  control whether C<encode> escapes character values outside their respective
  codeset range. Neither of these flags conflict with each other, although
  some combinations make less sense than others.
  
  Care has been taken to make all flags symmetrical with respect to
  C<encode> and C<decode>, that is, texts encoded with any combination of
  these flag values will be correctly decoded when the same flags are used
  - in general, if you use different flag settings while encoding vs. when
  decoding you likely have a bug somewhere.
  
  Below comes a verbose discussion of these flags. Note that a "codeset" is
  simply an abstract set of character-codepoint pairs, while an encoding
  takes those codepoint numbers and I<encodes> them, in our case into
  octets. Unicode is (among other things) a codeset, UTF-8 is an encoding,
  and ISO-8859-1 (= latin 1) and ASCII are both codesets I<and> encodings at
  the same time, which can be confusing.
  
  =over 4
  
  =item C<utf8> flag disabled
  
  When C<utf8> is disabled (the default), then C<encode>/C<decode> generate
  and expect Unicode strings, that is, characters with high ordinal Unicode
  values (> 255) will be encoded as such characters, and likewise such
  characters are decoded as-is, no changes to them will be done, except
  "(re-)interpreting" them as Unicode codepoints or Unicode characters,
  respectively (to Perl, these are the same thing in strings unless you do
  funny/weird/dumb stuff).
  
  This is useful when you want to do the encoding yourself (e.g. when you
  want to have UTF-16 encoded JSON texts) or when some other layer does
  the encoding for you (for example, when printing to a terminal using a
  filehandle that transparently encodes to UTF-8 you certainly do NOT want
  to UTF-8 encode your data first and have Perl encode it another time).
  
  =item C<utf8> flag enabled
  
  If the C<utf8>-flag is enabled, C<encode>/C<decode> will encode all
  characters using the corresponding UTF-8 multi-byte sequence, and will
  expect your input strings to be encoded as UTF-8, that is, no "character"
  of the input string must have any value > 255, as UTF-8 does not allow
  that.
  
  The C<utf8> flag therefore switches between two modes: disabled means you
  will get a Unicode string in Perl, enabled means you get an UTF-8 encoded
  octet/binary string in Perl.
  
  =item C<latin1>, C<binary> or C<ascii> flags enabled
  
  With C<latin1> (or C<ascii>) enabled, C<encode> will escape
  characters with ordinal values > 255 (> 127 with C<ascii>) and encode
  the remaining characters as specified by the C<utf8> flag.
  With C<binary> enabled, ordinal values > 255 are illegal.
  
  If C<utf8> is disabled, then the result is also correctly encoded in those
  character sets (as both are proper subsets of Unicode, meaning that a
  Unicode string with all character values < 256 is the same thing as a
  ISO-8859-1 string, and a Unicode string with all character values < 128 is
  the same thing as an ASCII string in Perl).
  
  If C<utf8> is enabled, you still get a correct UTF-8-encoded string,
  regardless of these flags, just some more characters will be escaped using
  C<\uXXXX> then before.
  
  Note that ISO-8859-1-I<encoded> strings are not compatible with UTF-8
  encoding, while ASCII-encoded strings are. That is because the ISO-8859-1
  encoding is NOT a subset of UTF-8 (despite the ISO-8859-1 I<codeset> being
  a subset of Unicode), while ASCII is.
  
  Surprisingly, C<decode> will ignore these flags and so treat all input
  values as governed by the C<utf8> flag. If it is disabled, this allows you
  to decode ISO-8859-1- and ASCII-encoded strings, as both strict subsets of
  Unicode. If it is enabled, you can correctly decode UTF-8 encoded strings.
  
  So neither C<latin1>, C<binary> nor C<ascii> are incompatible with the
  C<utf8> flag - they only govern when the JSON output engine escapes a
  character or not.
  
  The main use for C<latin1> or C<binary> is to relatively efficiently
  store binary data as JSON, at the expense of breaking compatibility
  with most JSON decoders.
  
  The main use for C<ascii> is to force the output to not contain characters
  with values > 127, which means you can interpret the resulting string
  as UTF-8, ISO-8859-1, ASCII, KOI8-R or most about any character set and
  8-bit-encoding, and still get the same data structure back. This is useful
  when your channel for JSON transfer is not 8-bit clean or the encoding
  might be mangled in between (e.g. in mail), and works because ASCII is a
  proper subset of most 8-bit and multibyte encodings in use in the world.
  
  =back
  
  
  =head2 JSON and ECMAscript
  
  JSON syntax is based on how literals are represented in javascript (the
  not-standardized predecessor of ECMAscript) which is presumably why it is
  called "JavaScript Object Notation".
  
  However, JSON is not a subset (and also not a superset of course) of
  ECMAscript (the standard) or javascript (whatever browsers actually
  implement).
  
  If you want to use javascript's C<eval> function to "parse" JSON, you
  might run into parse errors for valid JSON texts, or the resulting data
  structure might not be queryable:
  
  One of the problems is that U+2028 and U+2029 are valid characters inside
  JSON strings, but are not allowed in ECMAscript string literals, so the
  following Perl fragment will not output something that can be guaranteed
  to be parsable by javascript's C<eval>:
  
     use Cpanel::JSON::XS;
  
     print encode_json [chr 0x2028];
  
  The right fix for this is to use a proper JSON parser in your javascript
  programs, and not rely on C<eval> (see for example Douglas Crockford's
  F<json2.js> parser).
  
  If this is not an option, you can, as a stop-gap measure, simply encode to
  ASCII-only JSON:
  
     use Cpanel::JSON::XS;
  
     print Cpanel::JSON::XS->new->ascii->encode ([chr 0x2028]);
  
  Note that this will enlarge the resulting JSON text quite a bit if you
  have many non-ASCII characters. You might be tempted to run some regexes
  to only escape U+2028 and U+2029, e.g.:
  
     # DO NOT USE THIS!
     my $json = Cpanel::JSON::XS->new->utf8->encode ([chr 0x2028]);
     $json =~ s/\xe2\x80\xa8/\\u2028/g; # escape U+2028
     $json =~ s/\xe2\x80\xa9/\\u2029/g; # escape U+2029
     print $json;
  
  Note that I<this is a bad idea>: the above only works for U+2028 and
  U+2029 and thus only for fully ECMAscript-compliant parsers. Many existing
  javascript implementations, however, have issues with other characters as
  well - using C<eval> naively simply I<will> cause problems.
  
  Another problem is that some javascript implementations reserve
  some property names for their own purposes (which probably makes
  them non-ECMAscript-compliant). For example, Iceweasel reserves the
  C<__proto__> property name for its own purposes.
  
  If that is a problem, you could parse try to filter the resulting JSON
  output for these property strings, e.g.:
  
     $json =~ s/"__proto__"\s*:/"__proto__renamed":/g;
  
  This works because C<__proto__> is not valid outside of strings, so every
  occurrence of C<"__proto__"\s*:> must be a string used as property name.
  
  Unicode non-characters between U+FFFD and U+10FFFF are decoded either
  to the recommended U+FFFD REPLACEMENT CHARACTER (see Unicode PR #121:
  Recommended Practice for Replacement Characters), or in the binary or
  relaxed mode left as is, keeping the illegal non-characters as before.
  
  Raw non-Unicode characters outside the valid unicode range fail now to
  parse, because "A string is a sequence of zero or more Unicode
  characters" RFC 7159 section 1 and "JSON text SHALL be encoded in
  Unicode RFC 7159 section 8.1. We use now the UTF8_DISALLOW_SUPER
  flag when parsing unicode.
  
  If you know of other incompatibilities, please let me know.
  
  
  =head2 JSON and YAML
  
  You often hear that JSON is a subset of YAML.  I<in general, there is
  no way to configure JSON::XS to output a data structure as valid YAML>
  that works in all cases.  If you really must use Cpanel::JSON::XS to
  generate YAML, you should use this algorithm (subject to change in
  future versions):
  
     my $to_yaml = Cpanel::JSON::XS->new->utf8->space_after (1);
     my $yaml = $to_yaml->encode ($ref) . "\n";
  
  This will I<usually> generate JSON texts that also parse as valid
  YAML.
  
  
  =head2 SPEED
  
  It seems that JSON::XS is surprisingly fast, as shown in the following
  tables. They have been generated with the help of the C<eg/bench> program
  in the JSON::XS distribution, to make it easy to compare on your own
  system.
  
  JSON::XS is with L<Data::MessagePack> and L<Sereal> one of the fastest
  serializers, because JSON and JSON::XS do not support backrefs (no
  graph structures), only trees. Storable supports backrefs,
  i.e. graphs. Data::MessagePack encodes its data binary (as Storable)
  and supports only very simple subset of JSON.
  
  First comes a comparison between various modules using
  a very short single-line JSON string (also available at
  L<http://dist.schmorp.de/misc/json/short.json>).
  
     {"method": "handleMessage", "params": ["user1",
     "we were just talking"], "id": null, "array":[1,11,234,-5,1e5,1e7,
     1,  0]}
  
  It shows the number of encodes/decodes per second (JSON::XS uses
  the functional interface, while Cpanel::JSON::XS/2 uses the OO interface
  with pretty-printing and hash key sorting enabled, Cpanel::JSON::XS/3 enables
  shrink. JSON::DWIW/DS uses the deserialize function, while JSON::DWIW::FJ
  uses the from_json method). Higher is better:
  
     module        |     encode |     decode |
     --------------|------------|------------|
     JSON::DWIW/DS |  86302.551 | 102300.098 |
     JSON::DWIW/FJ |  86302.551 |  75983.768 |
     JSON::PP      |  15827.562 |   6638.658 |
     JSON::Syck    |  63358.066 |  47662.545 |
     JSON::XS      | 511500.488 | 511500.488 |
     JSON::XS/2    | 291271.111 | 388361.481 |
     JSON::XS/3    | 361577.931 | 361577.931 |
     Storable      |  66788.280 | 265462.278 |
     --------------+------------+------------+
  
  That is, JSON::XS is almost six times faster than JSON::DWIW on encoding,
  about five times faster on decoding, and over thirty to seventy times
  faster than JSON's pure perl implementation. It also compares favourably
  to Storable for small amounts of data.
  
  Using a longer test string (roughly 18KB, generated from Yahoo! Locals
  search API (L<http://dist.schmorp.de/misc/json/long.json>).
  
     module        |     encode |     decode |
     --------------|------------|------------|
     JSON::DWIW/DS |   1647.927 |   2673.916 |
     JSON::DWIW/FJ |   1630.249 |   2596.128 |
     JSON::PP      |    400.640 |     62.311 |
     JSON::Syck    |   1481.040 |   1524.869 |
     JSON::XS      |  20661.596 |   9541.183 |
     JSON::XS/2    |  10683.403 |   9416.938 |
     JSON::XS/3    |  20661.596 |   9400.054 |
     Storable      |  19765.806 |  10000.725 |
     --------------+------------+------------+
  
  Again, JSON::XS leads by far (except for Storable which non-surprisingly
  decodes a bit faster).
  
  On large strings containing lots of high Unicode characters, some modules
  (such as JSON::PC) seem to decode faster than JSON::XS, but the result
  will be broken due to missing (or wrong) Unicode handling. Others refuse
  to decode or encode properly, so it was impossible to prepare a fair
  comparison table for that case.
  
  For updated graphs see L<https://github.com/Sereal/Sereal/wiki/Sereal-Comparison-Graphs>
  
  
  =head1 INTEROP with JSON and JSON::XS and other JSON modules
  
  As long as you only serialize data that can be directly expressed in
  JSON, C<Cpanel::JSON::XS> is incapable of generating invalid JSON
  output (modulo bugs, but C<JSON::XS> has found more bugs in the
  official JSON testsuite (1) than the official JSON testsuite has found
  in C<JSON::XS> (0)).
  C<Cpanel::JSON::XS> is currently the only known JSON decoder which passes all
  L<http://seriot.ch/parsing_json.html> tests, while being the fastest also.
  
  When you have trouble decoding JSON generated by this module using other
  decoders, then it is very likely that you have an encoding mismatch or the
  other decoder is broken.
  
  When decoding, C<JSON::XS> is strict by default and will likely catch
  all errors. There are currently two settings that change this:
  C<relaxed> makes C<JSON::XS> accept (but not generate) some
  non-standard extensions, and C<allow_tags> or C<allow_blessed> will
  allow you to encode and decode Perl objects, at the cost of being
  totally insecure and not outputting valid JSON anymore.
  
  JSON-XS-3.01 broke interoperability with JSON-2.90 with booleans. See L<JSON>.
  
  Cpanel::JSON::XS needs to know the JSON and JSON::XS versions to be able work
  with those objects, especially when encoding a booleans like C<{"is_true":true}>.
  So you need to load these modules before.
  
  true/false overloading and boolean representations are supported.
  
  JSON::XS and JSON::PP representations are accepted and older JSON::XS
  accepts Cpanel::JSON::XS booleans. All JSON modules JSON, JSON, PP,
  JSON::XS, Cpanel::JSON::XS produce JSON::PP::Boolean objects, just
  Mojo and JSON::YAJL not.  Mojo produces Mojo::JSON::_Bool and
  JSON::YAJL::Parser just an unblessed IV.
  
  Cpanel::JSON::XS accepts JSON::PP::Boolean and Mojo::JSON::_Bool objects as booleans.
  
  I cannot think of any reason to still use JSON::XS anymore.
  
  
  =head2 TAGGED VALUE SYNTAX AND STANDARD JSON EN/DECODERS
  
  When you use C<allow_tags> to use the extended (and also nonstandard
  and invalid) JSON syntax for serialized objects, and you still want to
  decode the generated serialize objects, you can run a regex to replace
  the tagged syntax by standard JSON arrays (it only works for "normal"
  package names without comma, newlines or single colons). First, the
  readable Perl version:
  
     # if your FREEZE methods return no values, you need this replace first:
     $json =~ s/\( \s* (" (?: [^\\":,]+|\\.|::)* ") \s* \) \s* \[\s*\]/[$1]/gx;
  
     # this works for non-empty constructor arg lists:
     $json =~ s/\( \s* (" (?: [^\\":,]+|\\.|::)* ") \s* \) \s* \[/[$1,/gx;
  
  And here is a less readable version that is easy to adapt to other
  languages:
  
     $json =~ s/\(\s*("([^\\":,]+|\\.|::)*")\s*\)\s*\[/[$1,/g;
  
  Here is an ECMAScript version (same regex):
  
     json = json.replace (/\(\s*("([^\\":,]+|\\.|::)*")\s*\)\s*\[/g, "[$1,");
  
  Since this syntax converts to standard JSON arrays, it might be hard to
  distinguish serialized objects from normal arrays. You can prepend a
  "magic number" as first array element to reduce chances of a collision:
  
     $json =~ s/\(\s*("([^\\":,]+|\\.|::)*")\s*\)\s*\[/["XU1peReLzT4ggEllLanBYq4G9VzliwKF",$1,/g;
  
  And after decoding the JSON text, you could walk the data
  structure looking for arrays with a first element of
  C<XU1peReLzT4ggEllLanBYq4G9VzliwKF>.
  
  The same approach can be used to create the tagged format with another
  encoder. First, you create an array with the magic string as first member,
  the classname as second, and constructor arguments last, encode it as part
  of your JSON structure, and then:
  
     $json =~ s/\[\s*"XU1peReLzT4ggEllLanBYq4G9VzliwKF"\s*,\s*("([^\\":,]+|\\.|::)*")\s*,/($1)[/g;
  
  Again, this has some limitations - the magic string must not be encoded
  with character escapes, and the constructor arguments must be non-empty.
  
  
  =head1 RFC7159
  
  Since this module was written, Google has written a new JSON RFC, RFC 7159
  (and RFC7158). Unfortunately, this RFC breaks compatibility with both the
  original JSON specification on www.json.org and RFC4627.
  
  As far as I can see, you can get partial compatibility when parsing by
  using C<< ->allow_nonref >>. However, consider the security implications
  of doing so.
  
  I haven't decided yet when to break compatibility with RFC4627 by default
  (and potentially leave applications insecure) and change the default to
  follow RFC7159, but application authors are well advised to call C<<
  ->allow_nonref(0) >> even if this is the current default, if they cannot
  handle non-reference values, in preparation for the day when the default
  will change.
  
  =head1 SECURITY CONSIDERATIONS
  
  JSON::XS and Cpanel::JSON::XS are not only fast. JSON is generally the
  most secure serializing format, because it is the only one besides
  Data::MessagePack, which does not deserialize objects per default. For
  all languages, not just perl.  The binary variant BSON (MongoDB) does
  more but is unsafe.
  
  It is trivial for any attacker to create such serialized objects in
  JSON and trick perl into expanding them, thereby triggering certain
  methods. Watch L<https://www.youtube.com/watch?v=Gzx6KlqiIZE> for an
  exploit demo for "CVE-2015-1592 SixApart MovableType Storable Perl
  Code Execution" for a deserializer which expands objects.
  Deserializing even coderefs (methods, functions) or external
  data would be considered the most dangerous.
  
  Security relevant overview of serializers regarding deserializing
  objects by default:
  
                        Objects   Coderefs  External Data
  
      Data::Dumper      YES       YES       YES
      Storable          YES       NO (def)  NO
      Sereal            YES       NO        NO
      YAML              YES       NO        NO
      B::C              YES       YES       YES
      B::Bytecode       YES       YES       YES
      BSON              YES       YES       NO
      JSON::SL          YES       NO        YES
      JSON              NO (def)  NO        NO
      Data::MessagePack NO        NO        NO
      XML               NO        NO        YES
  
      Pickle            YES       YES       YES
      PHP Deserialize   YES       NO        NO
  
  When you are using JSON in a protocol, talking to untrusted potentially
  hostile creatures requires relatively few measures.
  
  First of all, your JSON decoder should be secure, that is, should not have
  any buffer overflows. Obviously, this module should ensure that.
  
  Second, you need to avoid resource-starving attacks. That means you should
  limit the size of JSON texts you accept, or make sure then when your
  resources run out, that's just fine (e.g. by using a separate process that
  can crash safely). The size of a JSON text in octets or characters is
  usually a good indication of the size of the resources required to decode
  it into a Perl structure. While JSON::XS can check the size of the JSON
  text, it might be too late when you already have it in memory, so you
  might want to check the size before you accept the string.
  
  Third, Cpanel::JSON::XS recurses using the C stack when decoding objects and
  arrays. The C stack is a limited resource: for instance, on my amd64
  machine with 8MB of stack size I can decode around 180k nested arrays but
  only 14k nested JSON objects (due to perl itself recursing deeply on croak
  to free the temporary). If that is exceeded, the program crashes. To be
  conservative, the default nesting limit is set to 512. If your process
  has a smaller stack, you should adjust this setting accordingly with the
  C<max_depth> method.
  
  Also keep in mind that Cpanel::JSON::XS might leak contents of your Perl data
  structures in its error messages, so when you serialize sensitive
  information you might want to make sure that exceptions thrown by JSON::XS
  will not end up in front of untrusted eyes.
  
  If you are using Cpanel::JSON::XS to return packets to consumption
  by JavaScript scripts in a browser you should have a look at
  L<http://blog.archive.jpsykes.com/47/practical-csrf-and-json-security/> to
  see whether you are vulnerable to some common attack vectors (which really
  are browser design bugs, but it is still you who will have to deal with
  it, as major browser developers care only for features, not about getting
  security right). You might also want to also look at L<Mojo::JSON>
  special escape rules to prevent from XSS attacks.
  
  =head1 "OLD" VS. "NEW" JSON (RFC 4627 VS. RFC 7159)
  
  TL;DR: Due to security concerns, Cpanel::JSON::XS will not allow
  scalar data in JSON texts by default - you need to create your own
  Cpanel::JSON::XS object and enable C<allow_nonref>:
  
  
     my $json = JSON::XS->new->allow_nonref;
  
     $text = $json->encode ($data);
     $data = $json->decode ($text);
  
  The long version: JSON being an important and supposedly stable format,
  the IETF standardized it as RFC 4627 in 2006. Unfortunately the inventor
  of JSON Douglas Crockford unilaterally changed the definition of JSON in
  javascript. Rather than create a fork, the IETF decided to standardize the
  new syntax (apparently, so I as told, without finding it very amusing).
  
  The biggest difference between the original JSON and the new JSON is that
  the new JSON supports scalars (anything other than arrays and objects) at
  the top-level of a JSON text. While this is strictly backwards compatible
  to older versions, it breaks a number of protocols that relied on sending
  JSON back-to-back, and is a minor security concern.
  
  For example, imagine you have two banks communicating, and on one side,
  the JSON coder gets upgraded. Two messages, such as C<10> and C<1000>
  might then be confused to mean C<101000>, something that couldn't happen
  in the original JSON, because neither of these messages would be valid
  JSON.
  
  If one side accepts these messages, then an upgrade in the coder on either
  side could result in this becoming exploitable.
  
  This module has always allowed these messages as an optional extension, by
  default disabled. The security concerns are the reason why the default is
  still disabled, but future versions might/will likely upgrade to the newer
  RFC as default format, so you are advised to check your implementation
  and/or override the default with C<< ->allow_nonref (0) >> to ensure that
  future versions are safe.
  
  =head1 THREADS
  
  Cpanel::JSON::XS has proper ithreads support, unlike JSON::XS. If you
  encounter any bugs with thread support please report them.
  
  =head1 BUGS
  
  While the goal of the Cpanel::JSON::XS module is to be correct, that
  unfortunately does not mean it's bug-free, only that the author thinks
  its design is bug-free. If you keep reporting bugs and tests they will
  be fixed swiftly, though.
  
  Since the JSON::XS author refuses to use a public bugtracker and
  prefers private emails, we've setup a tracker at RT, so you might want
  to report any issues twice. Once in private to MLEHMANN to be fixed in
  JSON::XS and one to our the public tracker. Issues fixed by JSON::XS
  with a new release will also be backported to Cpanel::JSON::XS and
  5.6.2, as long as cPanel relies on 5.6.2 and Cpanel::JSON::XS as our
  serializer of choice.
  
  L<https://rt.cpan.org/Public/Dist/Display.html?Queue=Cpanel-JSON-XS>
  
  =head1 LICENSE
  
  This module is available under the same licences as perl, the Artistic
  license and the GPL.
  
  =cut
  
  sub allow_bigint {
      Carp::carp("allow_bigint() is obsoleted. use allow_bignum() instead.");
  }
  
  our ($true, $false);
  BEGIN {
    if ($INC{'JSON/XS.pm'}
        and $INC{'Types/Serialiser.pm'}
        and $JSON::XS::VERSION ge "3.00") {
      $true  = $Types::Serialiser::true; # readonly if loaded by JSON::XS
      $false = $Types::Serialiser::false;
    } else {
      $true  = do { bless \(my $dummy = 1), "JSON::PP::Boolean" };
      $false = do { bless \(my $dummy = 0), "JSON::PP::Boolean" };
    }
  }
  
  sub true()  { $true  }
  sub false() { $false }
  sub is_bool($) {
    shift if @_ == 2; # as method call
    (ref($_[0]) and UNIVERSAL::isa( $_[0], JSON::PP::Boolean::))
    or (exists $INC{'Types/Serialiser.pm'} and Types::Serialiser::is_bool($_[0]))
  }
  
  XSLoader::load 'Cpanel::JSON::XS', $XS_VERSION;
  
  package
    JSON::PP::Boolean;
  
  use overload ();
  
  BEGIN {
    local $^W; # silence redefine warnings. no warnings 'redefine' does not help
    &overload::import( 'overload', # workaround 5.6 reserved keyword warning
      "0+"     => sub { ${$_[0]} },
      "++"     => sub { $_[0] = ${$_[0]} + 1 },
      "--"     => sub { $_[0] = ${$_[0]} - 1 },
      '""'     => sub { ${$_[0]} == 1 ? '1' : '0' }, # GH 29
      'eq'     => sub {
        my ($obj, $op) = ref ($_[0]) ? ($_[0], $_[1]) : ($_[1], $_[0]);
        if ($op eq 'true' or $op eq 'false') {
          return "$obj" eq '1' ? 'true' eq $op : 'false' eq $op;
        }
        else {
          return $obj ? 1 == $op : 0 == $op;
        }
      },
      fallback => 1);
  }
  
  1;
  
  =head1 SEE ALSO
  
  The F<cpanel_json_xs> command line utility for quick experiments.
  
  L<JSON>, L<JSON::XS>, L<JSON::MaybeXS>, L<Mojo::JSON>, L<Mojo::JSON::MaybeXS>,
  L<JSON::SL>, L<JSON::DWIW>, L<JSON::YAJL>,  L<JSON::Any>, L<Test::JSON>,
  L<Locale::Wolowitz>,
  L<https://metacpan.org/search?q=JSON>
  
  L<https://tools.ietf.org/html/rfc7159>
  
  L<https://tools.ietf.org/html/rfc4627>
  
  
  =head1 AUTHOR
  
  Marc Lehmann <schmorp@schmorp.de>, http://home.schmorp.de/
  
  Reini Urban <rurban@cpan.org>
  
  =head1 MAINTAINER
  
  Reini Urban <rurban@cpan.org>
  
  =cut
  
DARWIN-2LEVEL_CPANEL_JSON_XS

$fatpacked{"darwin-2level/Cpanel/JSON/XS/Boolean.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'DARWIN-2LEVEL_CPANEL_JSON_XS_BOOLEAN';
  =head1 NAME
  
  Cpanel::JSON::XS::Boolean - dummy module providing JSON::XS::Boolean
  
  =head1 SYNOPSIS
  
   # do not "use" yourself
  
  =head1 DESCRIPTION
  
  This module exists only to provide overload resolution for Storable and similar modules
  and interop with L<JSON::XS> booleans.
  See L<Cpanel::JSON::XS> for more info about this class.
  
  =cut
  
  use Cpanel::JSON::XS ();
  
  1;
  
  =head1 AUTHOR
  
   Marc Lehmann <schmorp@schmorp.de>
   http://home.schmorp.de/
  
  =cut
  
DARWIN-2LEVEL_CPANEL_JSON_XS_BOOLEAN

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



package Devel::IPerl::Plugin::Perlbrew::Install;

use strict;
use warnings;
use Applify;
use JSON::MaybeXS qw(decode_json encode_json);
use Path::Class qw{dir};

version our $VERSION = '0.02';

documentation $0;

my @VARIABLES =
  (qw{PERLBREW_HOME PERLBREW_PATH PERLBREW_PERL PERLBREW_ROOT PERLBREW_VERSION});

option str  => iperl     => 'path to iperl command        [default=iperl]',
  default => 'iperl';
option str  => jupyter   => 'path to jupyter command      [default=jupyter]',
  default => 'jupyter';
option flag => omit_home => 'Do not include PERLBREW_HOME [default=0]',
  default => 0;

sub _all_variables_set {
  my $spec = shift;
  return '' unless exists $spec->{env};
  return !!(@VARIABLES == (grep {
    exists $spec->{env}{$_} && $spec->{env}{$_} eq $ENV{$_}
  } @VARIABLES));
}

sub augment_kernel_spec {
  my $class       = shift;
  my $kernel_file = shift;
	my $kernel_spec = decode_json( $kernel_file->slurp );
  my $augmented   = (_all_variables_set($kernel_spec) ? 0 : 1);
  $kernel_spec->{env} = {
    %{$kernel_spec->{env} || {}}
  };
  for my $var (@VARIABLES) {
    $kernel_spec->{env}{$var} = $ENV{$var};
  }
  if ($augmented) {
    $kernel_file->spew( encode_json($kernel_spec) );
  }
  return $augmented;
}

sub get_ipython_target_dir {
  my $self = shift;
  my $ipython_dir;
  open my $fh, '-|', "@$self{jupyter} --data-dir" or return;
  while (my $line = <$fh>) {
    chomp($line);
    $ipython_dir ||= $line;
  }
	return unless length $ipython_dir;
	$ipython_dir;
}

sub get_kernels_target_dir {
  my $self = shift;
	my $ipython_dir = $self->get_ipython_target_dir();
	return unless length $ipython_dir;
	dir($ipython_dir)->subdir(qw[ kernels iperl ]);
}

sub report_iperl_version {
  my $class = shift;
  open my $fh, '-|', "@$class{iperl} --version 2>&1" or return;
  while (<$fh>) {
    chomp;
    say STDERR $_;
  }
}

app {
  my ($class) = (shift);

  $class->report_iperl_version;

  @VARIABLES = grep { $_ ne 'PERLBREW_HOME' } @VARIABLES if $class->omit_home;

  my $target = $class->get_kernels_target_dir;
  my $kernel_file = dir($target)->file('kernel.json');

  if (-e $kernel_file) {
    $class->augment_kernel_spec($kernel_file) if $ENV{PERLBREW_ROOT};
  } else {
    say STDERR "$kernel_file does not exist";
    say STDERR 'augment_kernel_spec() requires an existing kernel.json';
    return 1;
  }

  return 0;
};

=pod

=head1 NAME

perlbrewise-spec

=head1 DESCRIPTION

=head1 SYNOPSIS

  perlbrewise-spec [options]

=cut