#!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{"Clone/PP.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'CLONE_PP';
  package Clone::PP;
  
  use 5.006;
  use strict;
  use warnings;
  use vars qw($VERSION @EXPORT_OK);
  use Exporter;
  
  $VERSION = 1.06;
  
  @EXPORT_OK = qw( clone );
  sub import { goto &Exporter::import } 
  
  use vars qw( $CloneSelfMethod $CloneInitMethod );
  $CloneSelfMethod ||= 'clone_self';
  $CloneInitMethod ||= 'clone_init';
  
  use vars qw( %CloneCache );
  
  sub clone {
    my $source = shift;
  
    return undef if not defined($source);
    
    my $depth = shift;
    return $source if ( defined $depth and $depth -- < 1 );
    
    local %CloneCache = ( undef => undef ) unless ( exists $CloneCache{undef} );
    
    return $CloneCache{ $source } if ( defined $CloneCache{ $source } );
    
    my $ref_type = ref $source or return $source;
    
    my $class_name;
    if ( "$source" =~ /^\Q$ref_type\E\=([A-Z]+)\(0x[0-9a-f]+\)$/ ) {
      $class_name = $ref_type;
      $ref_type = $1;
      return $CloneCache{ $source } = $source->$CloneSelfMethod() 
  				  if $source->can($CloneSelfMethod);
    }
    
    
    my $copy;
    if ($ref_type eq 'HASH') {
      $CloneCache{ $source } = $copy = {};
      if ( my $tied = tied( %$source ) ) { tie %$copy, ref $tied }
      %$copy = map { ! ref($_) ? $_ : clone($_, $depth) } %$source;
    } elsif ($ref_type eq 'ARRAY') {
      $CloneCache{ $source } = $copy = [];
      if ( my $tied = tied( @$source ) ) { tie @$copy, ref $tied }
      @$copy = map { ! ref($_) ? $_ : clone($_, $depth) } @$source;
    } elsif ($ref_type eq 'REF' or $ref_type eq 'SCALAR') {
      $CloneCache{ $source } = $copy = \( my $var = "" );
      if ( my $tied = tied( $$source ) ) { tie $$copy, ref $tied }
      $$copy = clone($$source, $depth);
    } else {
      $CloneCache{ $source } = $copy = $source;
    }
    
    if ( $class_name ) {
      bless $copy, $class_name;
      $copy->$CloneInitMethod() if $copy->can($CloneInitMethod);
    }
    
    return $copy;
  }
  
  1;
  
  __END__
  
CLONE_PP

$fatpacked{"Complete.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'COMPLETE';
  package Complete;
  
  our $DATE = '2015-03-04'; 
  our $VERSION = '0.12'; 
  
  use 5.010001;
  use strict;
  use warnings;
  
  our $OPT_CI          = ($ENV{COMPLETE_OPT_CI}          // 1) ? 1:0;
  our $OPT_MAP_CASE    = ($ENV{COMPLETE_OPT_MAP_CASE}    // 1) ? 1:0;
  our $OPT_EXP_IM_PATH = ($ENV{COMPLETE_OPT_EXP_IM_PATH} // 1) ? 1:0;
  our $OPT_EXP_IM_PATH_MAX_LEN = ($ENV{COMPLETE_OPT_EXP_IM_PATH_MAX_LEN} // 2)+0;
  our $OPT_DIG_LEAF    = ($ENV{COMPLETE_OPT_DIG_LEAF}    // 1) ? 1:0;
  
  1;
  
  __END__
  
COMPLETE

$fatpacked{"Complete/Bash.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'COMPLETE_BASH';
  package Complete::Bash;
  
  our $DATE = '2015-04-02'; 
  our $VERSION = '0.19'; 
  
  use 5.010001;
  use strict;
  use warnings;
  
  
  require Exporter;
  our @ISA = qw(Exporter);
  our @EXPORT_OK = qw(
                         parse_cmdline
                         parse_options
                         format_completion
                 );
  
  our %SPEC;
  
  $SPEC{':package'} = {
      v => 1.1,
      summary => 'Completion module for bash shell',
      links => [
          {url => 'pm:Complete'},
      ],
  };
  
  sub _expand_tilde {
      my ($user, $slash) = @_;
      my @ent;
      if (length $user) {
          @ent = getpwnam($user);
      } else {
          @ent = getpwuid($>);
          $user = $ent[0];
      }
      return $ent[7] . $slash if @ent;
      "~$user$slash"; 
  }
  
  sub _add_unquoted {
      no warnings 'uninitialized';
  
      my ($word, $is_cur_word, $after_ws) = @_;
  
  
      $word =~ s!^(~)(\w*)(/|\z) |  # 1) tilde  2) username  3) optional slash
                 \\(.)           |  # 4) escaped char
                 \$(\w+)            # 5) variable name
                !
                    $1 ? (not($after_ws) || $is_cur_word ? "$1$2$3" : _expand_tilde($2, $3)) :
                        $4 ? $4 :
                            ($is_cur_word ? "\$$5" : $ENV{$5})
                                !egx;
      $word;
  }
  
  sub _add_double_quoted {
      no warnings 'uninitialized';
  
      my ($word, $is_cur_word) = @_;
  
      $word =~ s!\\(.)           |  # 1) escaped char
                 \$(\w+)            # 2) variable name
                !
                    $1 ? $1 :
                        ($is_cur_word ? "\$$2" : $ENV{$2})
                            !egx;
      $word;
  }
  
  sub _add_single_quoted {
      my $word = shift;
      $word =~ s/\\(.)/$1/g;
      $word;
  }
  
  $SPEC{parse_cmdline} = {
      v => 1.1,
      summary => 'Parse shell command-line for processing by completion routines',
      description => <<'_',
  
  This function basically converts COMP_LINE (str) and COMP_POINT (int) into
  something like (but not exactly the same as) COMP_WORDS (array) and COMP_CWORD
  (int) that bash supplies to shell functions.
  
  The differences with bash are (these differences are mostly for parsing
  convenience for programs that use this routine):
  
  1) quotes and backslashes are stripped (bash's COMP_WORDS contains all the
  quotes and backslashes);
  
  2) variables are substituted with their values from environment variables except
  for the current word (COMP_WORDS[COMP_CWORD]) (bash does not perform variable
  substitution for COMP_WORDS). However, note that special shell variables that
  are not environment variables like `$0`, `$_`, `$IFS` will not be replaced
  correctly because bash does not export those variables for us.
  
  3) tildes (~) are expanded with user's home directory except for the current
  word (bash does not perform tilde expansion for COMP_WORDS);
  
  4) no word-breaking characters aside from whitespaces and `=` are currently used
  (bash uses COMP_WORDBREAKS which by default also include `:`, `;`, and so on).
  This is done for convenience of parsing of Getopt::Long-based applications. More
  word-breaking characters might be used in the future, e.g. when we want to
  handle complex bash statements like pipes, redirection, etc.
  
  Caveats:
  
  * Due to the way bash parses the command line, the two below are equivalent:
  
      % cmd --foo=bar
      % cmd --foo = bar
  
  Because they both expand to `['--foo', '=', 'bar']`. But obviously
  `Getopt::Long` does not regard the two as equivalent.
  
  _
      args_as => 'array',
      args => {
          cmdline => {
              summary => 'Command-line, defaults to COMP_LINE environment',
              schema => 'str*',
              pos => 0,
          },
          point => {
              summary => 'Point/position to complete in command-line, '.
                  'defaults to COMP_POINT',
              schema => 'int*',
              pos => 1,
          },
      },
      result => {
          schema => ['array*', len=>2],
          description => <<'_',
  
  Return a 2-element array: `[$words, $cword]`. `$words` is array of str,
  equivalent to `COMP_WORDS` provided by bash to shell functions. `$cword` is an
  integer, equivalent to `COMP_CWORD` provided by bash to shell functions. The
  word to be completed is at `$words->[$cword]`.
  
  Note that COMP_LINE includes the command name. If you want the command-line
  arguments only (like in `@ARGV`), you need to strip the first element from
  `$words` and reduce `$cword` by 1.
  
  
  _
      },
      result_naked => 1,
      links => [
      ],
  };
  sub parse_cmdline {
      no warnings 'uninitialized';
      my ($line, $point) = @_;
  
      $line  //= $ENV{COMP_LINE};
      $point //= $ENV{COMP_POINT} // 0;
  
      die "$0: COMP_LINE not set, make sure this script is run under ".
          "bash completion (e.g. through complete -C)\n" unless defined $line;
  
      my @words;
      my $cword;
      my $pos = 0;
      my $pos_min_ws = 0;
      my $after_ws = 1;
      my $chunk;
      my $add_blank;
      my $is_cur_word;
      $line =~ s!(                                                 # 1) everything
                    (")((?: \\\\|\\"|[^"])*)(?:"|\z)(\s*)       |  # 2) open "  3) content  4) space after
                    (')((?: \\\\|\\'|[^'])*)(?:'|\z)(\s*)       |  # 5) open '  6) content  7) space after
                    ((?: \\\\|\\"|\\'|\\=|\\\s|[^"'=\s])+)(\s*) |  # 8) unquoted word  9) space after
                    = |
                    \s+
                )!
                    $pos += length($1);
                    #say "D:<$1> pos=$pos, point=$point, cword=$cword, after_ws=$after_ws";
  
                    if ($2 || $5 || defined($8)) {
                        # double-quoted/single-quoted/unquoted chunk
  
                        if (not(defined $cword)) {
                            $pos_min_ws = $pos - length($2 ? $4 : $5 ? $7 : $9);
                            #say "D:pos_min_ws=$pos_min_ws";
                            if ($point <= $pos_min_ws) {
                                $cword = @words - ($after_ws ? 0 : 1);
                            } elsif ($point < $pos) {
                                $cword = @words + 1 - ($after_ws ? 0 : 1);
                                $add_blank = 1;
                            }
                        }
  
                        if ($after_ws) {
                            $is_cur_word = defined($cword) && $cword==@words;
                        } else {
                            $is_cur_word = defined($cword) && $cword==@words-1;
                        }
                        $chunk =
                            $2 ? _add_double_quoted($3, $is_cur_word) :
                                $5 ? _add_single_quoted($6) :
                                    _add_unquoted($8, $is_cur_word, $after_ws);
                        if ($after_ws) {
                            push @words, $chunk;
                        } else {
                            $words[-1] .= $chunk;
                        }
                        if ($add_blank) {
                            push @words, '';
                            $add_blank = 0;
                        }
                        $after_ws = ($2 ? $4 : $5 ? $7 : $9) ? 1:0;
  
                    } elsif ($1 eq '=') {
                        # equal sign as word-breaking character
                        push @words, '=';
                        $after_ws = 1;
                    } else {
                        # whitespace
                        $after_ws = 1;
                    }
      !egx;
  
      $cword //= @words;
      $words[$cword] //= '';
  
      [\@words, $cword];
  }
  
  $SPEC{parse_options} = {
      v => 1.1,
      summary => 'Parse command-line for options and arguments, '.
          'more or less like Getopt::Long',
      description => <<'_',
  
  Parse command-line into words using `parse_cmdline()` then separate options and
  arguments. Since this routine does not accept `Getopt::Long` (this routine is
  meant to be a generic option parsing of command-lines), it uses a few simple
  rules to server the common cases:
  
  * After `--`, the rest of the words are arguments (just like Getopt::Long).
  
  * If we get something like `-abc` (a single dash followed by several letters) it
    is assumed to be a bundle of short options.
  
  * If we get something like `-MData::Dump` (a single dash, followed by a letter,
    followed by some letters *and* non-letters/numbers) it is assumed to be an
    option (`-M`) followed by a value.
  
  * If we get something like `--foo` it is a long option. If the next word is an
    option (starts with a `-`) then it is assumed that this option does not have
    argument. Otherwise, the next word is assumed to be this option's value.
  
  * Otherwise, it is an argument (that is, permute is assumed).
  
  _
  
      args => {
          cmdline => {
              summary => 'Command-line, defaults to COMP_LINE environment',
              schema => 'str*',
          },
          point => {
              summary => 'Point/position to complete in command-line, '.
                  'defaults to COMP_POINT',
              schema => 'int*',
          },
          words => {
              summary => 'Alternative to passing `cmdline` and `point`',
              schema => ['array*', of=>'str*'],
              description => <<'_',
  
  If you already did a `parse_cmdline()`, you can pass the words result (the first
  element) here to avoid calling `parse_cmdline()` twice.
  
  _
          },
          cword => {
              summary => 'Alternative to passing `cmdline` and `point`',
              schema => ['array*', of=>'str*'],
              description => <<'_',
  
  If you already did a `parse_cmdline()`, you can pass the cword result (the
  second element) here to avoid calling `parse_cmdline()` twice.
  
  _
          },
      },
      result => {
          schema => 'hash*',
      },
  };
  sub parse_options {
      my %args = @_;
  
      my ($words, $cword) = @_;
      if ($args{words}) {
          ($words, $cword) = ($args{words}, $args{cword});
      } else {
          ($words, $cword) = @{parse_cmdline($args{cmdline}, $args{point}, '=')};
      }
  
      my @types;
      my %opts;
      my @argv;
      my $type;
      $types[0] = 'command';
      my $i = 1;
      while ($i < @$words) {
          my $word = $words->[$i];
          if ($word eq '--') {
              if ($i == $cword) {
                  $types[$i] = 'opt_name';
                  $i++; next;
              }
              $types[$i] = 'separator';
              for ($i+1 .. @$words-1) {
                  $types[$_] = 'arg,' . @argv;
                  push @argv, $words->[$_];
              }
              last;
          } elsif ($word =~ /\A-(\w*)\z/) {
              $types[$i] = 'opt_name';
              for (split '', $1) {
                  push @{ $opts{$_} }, undef;
              }
              $i++; next;
          } elsif ($word =~ /\A-([\w?])(.*)/) {
              $types[$i] = 'opt_name';
              push @{ $opts{$1} }, $2;
              $i++; next;
          } elsif ($word =~ /\A--(\w[\w-]*)\z/) {
              $types[$i] = 'opt_name';
              my $opt = $1;
              $i++;
              if ($i < @$words) {
                  if ($words->[$i] eq '=') {
                      $types[$i] = 'separator';
                      $i++;
                  }
                  if ($words->[$i] =~ /\A-/) {
                      push @{ $opts{$opt} }, undef;
                      next;
                  }
                  $types[$i] = 'opt_val';
                  push @{ $opts{$opt} }, $words->[$i];
                  $i++; next;
              }
          } else {
              $types[$i] = 'arg,' . @argv;
              push @argv, $word;
              $i++; next;
          }
      }
  
      return {
          opts      => \%opts,
          argv      => \@argv,
          cword     => $cword,
          words     => $words,
          word_type => $types[$cword],
      };
  }
  
  $SPEC{format_completion} = {
      v => 1.1,
      summary => 'Format completion for output (for shell)',
      description => <<'_',
  
  Bash accepts completion reply in the form of one entry per line to STDOUT. Some
  characters will need to be escaped. This function helps you do the formatting,
  with some options.
  
  This function accepts completion answer structure as described in the `Complete`
  POD. Aside from `words`, this function also recognizes these keys:
  
  * `as` (str): Either `string` (the default) or `array` (to return array of lines
    instead of the lines joined together). Returning array is useful if you are
    doing completion inside `Term::ReadLine`, for example, where the library
    expects an array.
  
  * `esc_mode` (str): Escaping mode for entries. Either `default` (most
    nonalphanumeric characters will be escaped), `shellvar` (like `default`, but
    dollar sign `$` will not be escaped, convenient when completing environment
    variables for example), `filename` (currently equals to `default`), `option`
    (currently equals to `default`), or `none` (no escaping will be done).
  
  * `path_sep` (str): If set, will enable "path mode", useful for
    completing/drilling-down path. Below is the description of "path mode".
  
    In shell, when completing filename (e.g. `foo`) and there is only a single
    possible completion (e.g. `foo` or `foo.txt`), the shell will display the
    completion in the buffer and automatically add a space so the user can move to
    the next argument. This is also true when completing other values like
    variables or program names.
  
    However, when completing directory (e.g. `/et` or `Downloads`) and there is
    solely a single completion possible and it is a directory (e.g. `/etc` or
    `Downloads`), the shell automatically adds the path separator character
    instead (`/etc/` or `Downloads/`). The user can press Tab again to complete
    for files/directories inside that directory, and so on. This is obviously more
    convenient compared to when shell adds a space instead.
  
    The `path_sep` option, when set, will employ a trick to mimic this behaviour.
    The trick is, if you have a completion array of `['foo/']`, it will be changed
    to `['foo/', 'foo/ ']` (the second element is the first element with added
    space at the end) to prevent bash from adding a space automatically.
  
    Path mode is not restricted to completing filesystem paths. Anything path-like
    can use it. For example when you are completing Java or Perl module name (e.g.
    `com.company.product.whatever` or `File::Spec::Unix`) you can use this mode
    (with `path_sep` appropriately set to, e.g. `.` or `::`).
  
  _
      args_as => 'array',
      args => {
          completion => {
              summary => 'Completion answer structure',
              description => <<'_',
  
  Either an array or hash. See function description for more details.
  
  _
              schema=>['any*' => of => ['hash*', 'array*']],
              req=>1,
              pos=>0,
          },
          opts => {
              schema=>'hash*',
              pos=>1,
          },
      },
      result => {
          summary => 'Formatted string (or array, if `as` is set to `array`)',
          schema => ['any*' => of => ['str*', 'array*']],
      },
      result_naked => 1,
  };
  sub format_completion {
      my ($hcomp, $opts) = @_;
  
      $opts //= {};
  
      $hcomp = {words=>$hcomp} unless ref($hcomp) eq 'HASH';
      my $comp     = $hcomp->{words};
      my $as       = $hcomp->{as} // 'string';
      my $esc_mode = $hcomp->{esc_mode} // $hcomp->{escmode} // 'default';
      my $path_sep = $hcomp->{path_sep};
  
      if (defined($path_sep) && @$comp == 1) {
          my $re = qr/\Q$path_sep\E\z/;
          my $word;
          if (ref($comp->[0]) eq 'HASH') {
              $comp = [$comp->[0], {word=>"$comp->[0] "}] if
                  $comp->[0]{word} =~ $re;
          } else {
              $comp = [$comp->[0], "$comp->[0] "]
                  if $comp->[0] =~ $re;
          }
      }
  
      if (defined($opts->{word})) {
          if ($opts->{word} =~ s/(.+:)//) {
              my $prefix = $1;
              for (@$comp) {
                  if (ref($_) eq 'HASH') {
                      $_->{word} =~ s/\A\Q$prefix\E//i;
                  } else {
                      s/\A\Q$prefix\E//i;
                  }
              }
          }
      }
  
      my @res;
      for my $entry (@$comp) {
          my $word = ref($entry) eq 'HASH' ? $entry->{word} : $entry;
          if ($esc_mode eq 'shellvar') {
              $word =~ s!([^A-Za-z0-9,+._/\$~-])!\\$1!g;
          } elsif ($esc_mode eq 'none') {
          } else {
              $word =~ s!([^A-Za-z0-9,+._/:~-])!\\$1!g;
          }
          push @res, $word;
      }
  
      if ($as eq 'array') {
          return \@res;
      } else {
          return join("", map {($_, "\n")} @res);
      }
  }
  
  1;
  
  __END__
  
COMPLETE_BASH

$fatpacked{"Complete/Getopt/Long.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'COMPLETE_GETOPT_LONG';
  package Complete::Getopt::Long;
  
  our $DATE = '2015-04-09'; 
  our $VERSION = '0.31'; 
  
  use 5.010001;
  use strict;
  use warnings;
  use Log::Any::IfLOG '$log';
  
  
  require Exporter;
  our @ISA = qw(Exporter);
  our @EXPORT_OK = qw(
                         complete_cli_arg
                 );
  
  our %SPEC;
  
  sub _default_completion {
      my %args = @_;
      my $word = $args{word} // '';
  
      my $fres;
      $log->tracef('[comp][compgl] entering default completion routine');
  
      if ($word =~ /\A\$/) {
          $log->tracef('[comp][compgl] completing shell variable');
          require Complete::Util;
          {
              my $compres = Complete::Util::complete_env(
                  word=>$word);
              last unless @$compres;
              $fres = {words=>$compres, esc_mode=>'shellvar'};
              goto RETURN_RES;
          }
      }
  
      if ($word =~ m!\A~([^/]*)\z!) {
          $log->tracef("[comp][compgl] completing userdir, user=%s", $1);
          {
              eval { require Unix::Passwd::File };
              last if $@;
              my $res = Unix::Passwd::File::list_users(detail=>1);
              last unless $res->[0] == 200;
              my $compres = Complete::Util::complete_array(
                  array=>[map {"~" . $_->{user} . ((-d $_->{home}) ? "/":"")}
                              @{ $res->[2] }],
                  word=>$word,
              );
              last unless @$compres;
              $fres = {words=>$compres, path_sep=>'/'};
              goto RETURN_RES;
          }
      }
  
      if ($word =~ m!\A(~[^/]*)/!) {
          $log->tracef("[comp][compgl] completing file, path=<%s>", $word);
          $fres = {words=>Complete::Util::complete_file(word=>$word),
                   path_sep=>'/'};
          goto RETURN_RES;
      }
  
      require String::Wildcard::Bash;
      if (String::Wildcard::Bash::contains_wildcard($word)) {
          $log->tracef("[comp][compgl] completing with wildcard glob, glob=<%s>", "$word*");
          {
              my $compres = [glob("$word*")];
              last unless @$compres;
              for (@$compres) {
                  $_ .= "/" if (-d $_);
              }
              $fres = {words=>$compres, path_sep=>'/'};
              goto RETURN_RES;
          }
      }
      $log->tracef("[comp][compgl] completing with file, file=<%s>", $word);
      $fres = {words=>Complete::Util::complete_file(word=>$word),
               path_sep=>'/'};
    RETURN_RES:
      $log->tracef("[comp][compgl] leaving default completion routine, result=%s", $fres);
      $fres;
  }
  
  sub _expand1 {
      my ($opt, $opts) = @_;
      my @candidates;
      my $is_hash = ref($opts) eq 'HASH';
      for ($is_hash ? (sort {length($a)<=>length($b)} keys %$opts) : @$opts) {
          next unless index($_, $opt) == 0;
          push @candidates, $is_hash ? $opts->{$_} : $_;
          last if $opt eq $_;
      }
      return @candidates == 1 ? $candidates[0] : undef;
  }
  
  sub _mark_seen {
      my ($seen_opts, $opt, $opts) = @_;
      my $opthash = $opts->{$opt};
      return unless $opthash;
      my $ospec = $opthash->{ospec};
      for (keys %$opts) {
          my $v = $opts->{$_};
          $seen_opts->{$_}++ if $v->{ospec} eq $ospec;
      }
  }
  
  $SPEC{complete_cli_arg} = {
      v => 1.1,
      summary => 'Complete command-line argument using '.
          'Getopt::Long specification',
      description => <<'_',
  
  This routine can complete option names, where the option names are retrieved
  from `Getopt::Long` specification. If you provide completion routine in
  `completion`, you can also complete _option values_ and _arguments_.
  
  Note that this routine does not use `Getopt::Long` (it does its own parsing) and
  currently is not affected by Getopt::Long's configuration. Its behavior mimics
  Getopt::Long under these configuration: `no_ignore_case`, `bundling` (or
  `no_bundling` if the `bundling` option is turned off). Which I think is the
  sensible default. This routine also does not currently support `auto_help` and
  `auto_version`, so you'll need to add those options specifically if you want to
  recognize `--help/-?` and `--version`, respectively.
  
  _
      args => {
          getopt_spec => {
              summary => 'Getopt::Long specification',
              schema  => 'hash*',
              req     => 1,
          },
          completion => {
              summary     =>
                  'Completion routine to complete option value/argument',
              schema      => 'code*',
              description => <<'_',
  
  Completion code will receive a hash of arguments (`%args`) containing these
  keys:
  
  * `type` (str, what is being completed, either `optval`, or `arg`)
  * `word` (str, word to be completed)
  * `cword` (int, position of words in the words array, starts from 0)
  * `opt` (str, option name, e.g. `--str`; undef if we're completing argument)
  * `ospec` (str, Getopt::Long option spec, e.g. `str|S=s`; undef when completing
    argument)
  * `argpos` (int, argument position, zero-based; undef if type='optval')
  * `nth` (int, the number of times this option has seen before, starts from 0
    that means this is the first time this option has been seen; undef when
    type='arg')
  * `seen_opts` (hash, all the options seen in `words`)
  * `parsed_opts` (hash, options parsed the standard/raw way)
  
  as well as all keys from `extras` (but these won't override the above keys).
  
  and is expected to return a completion answer structure as described in
  `Complete` which is either a hash or an array. The simplest form of answer is
  just to return an array of strings. The various `complete_*` function like those
  in `Complete::Util` or the other `Complete::*` modules are suitable to use here.
  
  Completion routine can also return undef to express declination, in which case
  the default completion routine will then be consulted. The default routine
  completes from shell environment variables (`$FOO`), Unix usernames (`~foo`),
  and files/directories.
  
  Example:
  
      use Complete::Unix qw(complete_user);
      use Complete::Util qw(complete_array_elem);
      complete_cli_arg(
          getopt_spec => {
              'help|h'   => sub{...},
              'format=s' => \$format,
              'user=s'   => \$user,
          },
          completion  => sub {
              my %args  = @_;
              my $word  = $args{word};
              my $ospec = $args{ospec};
              if ($ospec && $ospec eq 'format=s') {
                  complete_array(array=>[qw/json text xml yaml/], word=>$word);
              } else {
                  complete_user(word=>$word);
              }
          },
      );
  
  _
          },
          words => {
              summary     => 'Command line arguments, like @ARGV',
              description => <<'_',
  
  See function `parse_cmdline` in `Complete::Bash` on how to produce this (if
  you're using bash).
  
  _
              schema      => 'array*',
              req         => 1,
          },
          cword => {
              summary     =>
                  "Index in words of the word we're trying to complete",
              description => <<'_',
  
  See function `parse_cmdline` in `Complete::Bash` on how to produce this (if
  you're using bash).
  
  _
              schema      => 'int*',
              req         => 1,
          },
          extras => {
              summary => 'Add extra arguments to completion routine',
              schema  => 'hash',
              description => <<'_',
  
  The keys from this `extras` hash will be merged into the final `%args` passed to
  completion routines. Note that standard keys like `type`, `word`, and so on as
  described in the function description will not be overwritten by this.
  
  _
          },
          bundling => {
              schema  => 'bool*',
              default => 1,
              'summary.alt.bool.not' => 'Turn off bundling',
              description => <<'_',
  
  If you turn off bundling, completion of short-letter options won't support
  bundling (e.g. `-b<tab>` won't add more single-letter options), but single-dash
  multiletter options can be recognized. Currently only those specified with a
  single dash will be completed. For example if you have `-foo=s` in your option
  specification, `-f<tab>` can complete it.
  
  This can be used to complete old-style programs, e.g. emacs which has options
  like `-nw`, `-nbc` etc (but also have double-dash options like
  `--no-window-system` or `--no-blinking-cursor`).
  
  _
          },
      },
      result_naked => 1,
      result => {
          schema => ['any*' => of => ['hash*', 'array*']],
          description => <<'_',
  
  You can use `format_completion` function in `Complete::Bash` module to format
  the result of this function for bash.
  
  _
      },
  };
  sub complete_cli_arg {
      require Complete::Util;
      require Getopt::Long::Util;
      require List::MoreUtils;
  
      my %args = @_;
  
      my $fname = __PACKAGE__ . "::complete_cli_arg"; 
      my $fres;
  
      $args{words} or die "Please specify words";
      my @words = @{ $args{words} };
      defined(my $cword = $args{cword}) or die "Please specify cword";
      my $gospec = $args{getopt_spec} or die "Please specify getopt_spec";
      my $comp = $args{completion};
      my $extras = $args{extras} // {};
      my $bundling = $args{bundling} // 1;
      my %parsed_opts;
  
      $log->tracef('[comp][compgl] entering %s(), words=%s, cword=%d, word=<%s>',
                   $fname, \@words, $cword, $words[$cword]);
  
      my %opts;
      for my $ospec (keys %$gospec) {
          my $res = Getopt::Long::Util::parse_getopt_long_opt_spec($ospec)
              or die "Can't parse option spec '$ospec'";
          $res->{min_vals} //= $res->{type} ? 1 : 0;
          $res->{max_vals} //= $res->{type} || $res->{opttype} ? 1:0;
          for my $o0 (@{ $res->{opts} }) {
              my @o = $res->{is_neg} && length($o0) > 1 ?
                  ($o0, "no$o0", "no-$o0") : ($o0);
              for my $o (@o) {
                  my $k = length($o)==1 ||
                      (!$bundling && $res->{dash_prefix} eq '-') ?
                          "-$o" : "--$o";
                  $opts{$k} = {
                      name => $k,
                      ospec => $ospec, 
                      parsed => $res,
                  };
              }
          }
      }
      my @optnames = sort keys %opts;
  
      my %seen_opts;
  
      my @expects;
  
      my $i = -1;
      my $argpos = 0;
  
    WORD:
      while (1) {
          last WORD if ++$i >= @words;
          my $word = $words[$i];
  
          if ($word eq '--' && $i != $cword) {
              $expects[$i] = {separator=>1};
              while (1) {
                  $i++;
                  last WORD if $i >= @words;
                  $expects[$i] = {arg=>1, argpos=>$argpos++};
              }
          }
  
          if ($word =~ /\A-/) {
  
            SPLIT_BUNDLED:
              {
                  last unless $bundling;
                  my $shorts = $word;
                  if ($shorts =~ s/\A-([^-])(.*)/$2/) {
                      my $opt = "-$1";
                      my $opthash = $opts{$opt};
                      if (!$opthash || $opthash->{parsed}{max_vals}) {
                          last SPLIT_BUNDLED;
                      }
                      $words[$i] = $word = "-$1";
                      $expects[$i]{prefix} = $word;
                      $expects[$i]{word} = '';
                      $expects[$i]{short_only} = 1;
                      my $len_before_split = @words;
                      my $j = $i+1;
                    SHORTOPT:
                      while ($shorts =~ s/(.)//) {
                          $opt = "-$1";
                          $opthash = $opts{$opt};
                          if (!$opthash || $opthash->{parsed}{max_vals}) {
                              $expects[$i]{do_complete_optname} = 0;
                              if (length $shorts) {
                                  splice @words, $j, 0, $opt, '=', $shorts;
                                  $j += 3;
                              } else {
                                  splice @words, $j, 0, $opt;
                                  $j++;
                              }
                              last SHORTOPT;
                          } else {
                              splice @words, $j, 0, $opt;
                              $j++;
                          }
                      }
                      $cword += @words-$len_before_split if $cword > $i;
                  }
              }
  
            SPLIT_EQUAL:
              {
                  if ($word =~ /\A(--?[^=]+)(=)(.*)/) {
                      splice @words, $i, 1, $1, $2, $3;
                      $word = $1;
                      $cword += 2 if $cword >= $i;
                  }
              }
  
              my $opt = $word;
              my $opthash = _expand1($opt, \%opts);
  
              if ($opthash) {
                  $opt = $opthash->{name};
                  $expects[$i]{optname} = $opt;
                  my $nth = $seen_opts{$opt} // 0;
                  $expects[$i]{nth} = $nth;
                  _mark_seen(\%seen_opts, $opt, \%opts);
  
                  my $min_vals = $opthash->{parsed}{min_vals};
                  my $max_vals = $opthash->{parsed}{max_vals};
  
                  if ($i+1 < @words && $words[$i+1] eq '=') {
                      $i++;
                      $expects[$i] = {separator=>1, optval=>$opt, word=>'', nth=>$nth};
                      if (!$max_vals) { $min_vals = $max_vals = 1 }
                  }
  
                  push @{ $parsed_opts{$opt} }, $words[$i+1];
                  for (1 .. $min_vals) {
                      $i++;
                      last WORD if $i >= @words;
                      $expects[$i]{optval} = $opt;
                      $expects[$i]{nth} = $nth;
                  }
                  for (1 .. $max_vals-$min_vals) {
                      last if $i+$_ >= @words;
                      last if $words[$i+$_] =~ /\A-/; 
                      $expects[$i+$_]{optval} = $opt; 
                      $expects[$i]{nth} = $nth;
                  }
              } else {
                  $opt = undef;
                  $expects[$i]{optname} = $opt;
  
                  if ($i+1 < @words && $words[$i+1] eq '=') {
                      $i++;
                      $expects[$i] = {separator=>1, optval=>undef, word=>''};
                      if ($i+1 < @words) {
                          $i++;
                          $expects[$i]{optval} = $opt;
                      }
                  }
              }
          } else {
              $expects[$i]{optname} = '';
              $expects[$i]{arg} = 1;
              $expects[$i]{argpos} = $argpos++;
          }
      }
  
  
      my $exp = $expects[$cword];
      my $word = $exp->{word} // $words[$cword];
      my @res;
  
      {
          last unless exists $exp->{optname};
          last if defined($exp->{do_complete_optname}) &&
              !$exp->{do_complete_optname};
          my $opt = $exp->{optname};
          my @o;
          for (@optnames) {
              my $repeatable = 0;
              next if $exp->{short_only} && /\A--/;
              if ($seen_opts{$_}) {
                  my $opthash = $opts{$_};
                  my $ospecval = $gospec->{$opthash->{ospec}};
                  my $parsed = $opthash->{parsed};
                  if (ref($ospecval) eq 'ARRAY') {
                      $repeatable = 1;
                  } elsif ($parsed->{desttype} || $parsed->{is_inc}) {
                      $repeatable = 1;
                  }
              }
              next if $seen_opts{$_} && !$repeatable && (
                  (!$opt || $opt ne $_) ||
                      (defined($exp->{prefix}) &&
                           index($exp->{prefix}, substr($opt, 1, 1)) >= 0));
              if (defined $exp->{prefix}) {
                  my $o = $_; $o =~ s/\A-//;
                  push @o, "$exp->{prefix}$o";
              } else {
                  push @o, $_;
              }
          }
          my $compres = Complete::Util::complete_array_elem(
              array => \@o, word => $word);
          $log->tracef('[comp][compgl] adding result from option names, '.
                           'matching options=%s', $compres);
          push @res, @$compres;
          if (!exists($exp->{optval}) && !exists($exp->{arg})) {
              $fres = {words=>\@res, esc_mode=>'option'};
              goto RETURN_RES;
          }
      }
  
      {
          last unless exists($exp->{optval});
          my $opt = $exp->{optval};
          my $opthash = $opts{$opt} if $opt;
          my %compargs = (
              %$extras,
              type=>'optval', words=>\@words, cword=>$args{cword},
              word=>$word, opt=>$opt, ospec=>$opthash->{ospec},
              argpos=>undef, nth=>$exp->{nth}, seen_opts=>\%seen_opts,
              parsed_opts=>\%parsed_opts,
          );
          my $compres;
          if ($comp) {
              $log->tracef("[comp][compgl] invoking routine supplied from 'completion' argument to complete option value, option=<%s>", $opt);
              $compres = $comp->(%compargs);
              $log->tracef('[comp][compgl] adding result from routine: %s', $compres);
          }
          if (!$compres || !$comp) {
              $compres = _default_completion(%compargs);
              $log->tracef('[comp][compgl] adding result from default '.
                               'completion routine');
          }
          if (ref($compres) eq 'ARRAY') {
              push @res, @$compres;
          } elsif (ref($compres) eq 'HASH') {
              unless (@res) {
                  $fres = $compres;
                  goto RETURN_RES;
              }
              push @res, @{ $compres->{words} // [] };
          }
      }
  
      {
          last unless exists($exp->{arg});
          my %compargs = (
              %$extras,
              type=>'arg', words=>\@words, cword=>$args{cword},
              word=>$word, opt=>undef, ospec=>undef,
              argpos=>$exp->{argpos}, seen_opts=>\%seen_opts,
              parsed_opts=>\%parsed_opts,
          );
          $log->tracef('[comp][compgl] invoking \'completion\' routine '.
                           'to complete argument');
          my $compres = $comp->(%compargs);
          if (!defined $compres) {
              $compres = _default_completion(%compargs);
              $log->tracef('[comp][compgl] adding result from default '.
                               'completion routine: %s', $compres);
          }
          if (ref($compres) eq 'ARRAY') {
              push @res, @$compres;
          } elsif (ref($compres) eq 'HASH') {
              unless (@res) {
                  $fres = $compres;
                  goto RETURN_RES;
              }
              push @res, @{ $compres->{words} // [] };
          }
      }
  
      $fres = [sort(List::MoreUtils::uniq(@res))];
    RETURN_RES:
      $log->tracef("[comp][compgl] leaving %s(), result=%s", $fname, $fres);
      $fres;
  }
  
  1;
  
  __END__
  
COMPLETE_GETOPT_LONG

$fatpacked{"Complete/Path.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'COMPLETE_PATH';
  package Complete::Path;
  
  our $DATE = '2015-01-09'; 
  our $VERSION = '0.12'; 
  
  use 5.010001;
  use strict;
  use warnings;
  
  use Complete;
  
  require Exporter;
  our @ISA = qw(Exporter);
  our @EXPORT_OK = qw(
                         complete_path
                 );
  
  sub _dig_leaf {
      my ($p, $list_func, $is_dir_func, $path_sep) = @_;
      my $num_dirs;
      my $listres = $list_func->($p, '', 0);
      return $p unless @$listres == 1;
      my $e = $listres->[0];
      my $p2 = $p =~ m!\Q$path_sep\E\z! ? "$p$e" : "$p$path_sep$e";
      my $is_dir;
      if ($e =~ m!\Q$path_sep\E\z!) {
          $is_dir++;
      } else {
          $is_dir = $is_dir_func && $is_dir_func->($p2);
      }
      return _dig_leaf($p2, $list_func, $is_dir_func, $path_sep) if $is_dir;
      $p2;
  }
  
  our %SPEC;
  
  $SPEC{complete_path} = {
      v => 1.1,
      summary => 'Complete path',
      description => <<'_',
  
  Complete path, for anything path-like. Meant to be used as backend for other
  functions like `Complete::Util::complete_file` or
  `Complete::Module::complete_module`. Provides features like case-insensitive
  matching, expanding intermediate paths, and case mapping.
  
  Algorithm is to split path into path elements, then list items (using the
  supplied `list_func`) and perform filtering (using the supplied `filter_func`)
  at every level.
  
  _
      args => {
          word => {
              schema  => [str=>{default=>''}],
              pos     => 0,
          },
          list_func => {
              summary => 'Function to list the content of intermediate "dirs"',
              schema => 'code*',
              req => 1,
              description => <<'_',
  
  Code will be called with arguments: ($path, $cur_path_elem, $is_intermediate).
  Code should return an arrayref containing list of elements. "Directories" can be
  marked by ending the name with the path separator (see `path_sep`). Or, you can
  also provide an `is_dir_func` function that will be consulted after filtering.
  If an item is a "directory" then its name will be suffixed with a path
  separator by `complete_path()`.
  
  _
          },
          is_dir_func => {
              summary => 'Function to check whether a path is a "dir"',
              schema  => 'code*',
              description => <<'_',
  
  Optional. You can provide this function to determine if an item is a "directory"
  (so its name can be suffixed with path separator). You do not need to do this if
  you already suffix names of "directories" with path separator in `list_func`.
  
  One reason you might want to provide this and not mark "directories" in
  `list_func` is when you want to do extra filtering with `filter_func`. Sometimes
  you do not want to suffix the names first (example: see `complete_file` in
  `Complete::Util`).
  
  _
          },
          starting_path => {
              schema => 'str*',
              req => 1,
              default => '',
          },
          filter_func => {
              schema  => 'code*',
              description => <<'_',
  
  Provide extra filtering. Code will be given path and should return 1 if the item
  should be included in the final result or 0 if the item should be excluded.
  
  _
          },
  
          path_sep => {
              schema  => 'str*',
              default => '/',
          },
          ci => {
              summary => 'Case-insensitive matching',
              schema  => 'bool',
          },
          map_case => {
              summary => 'Treat _ (underscore) and - (dash) as the same',
              schema  => 'bool',
              description => <<'_',
  
  This is another convenience option like `ci`, where you can type `-` (without
  pressing Shift, at least in US keyboard) and can still complete `_` (underscore,
  which is typed by pressing Shift, at least in US keyboard).
  
  This option mimics similar option in bash/readline: `completion-map-case`.
  
  _
          },
          exp_im_path => {
              summary => 'Expand intermediate paths',
              schema  => 'bool',
              description => <<'_',
  
  This option mimics feature in zsh where when you type something like `cd
  /h/u/b/myscript` and get `cd /home/ujang/bin/myscript` as a completion answer.
  
  _
          },
          dig_leaf => {
              summary => 'Dig leafs',
              schema => 'bool',
              description => <<'_',
  
  This feature mimics what's seen on GitHub. If a directory entry only contains a
  single entry, it will directly show the subentry (and subsubentry and so on) to
  save a number of tab presses.
  
  _
          },
      },
      result_naked => 1,
      result => {
          schema => 'array',
      },
  };
  sub complete_path {
      my %args   = @_;
      my $word   = $args{word} // "";
      my $path_sep = $args{path_sep} // '/';
      my $list_func   = $args{list_func};
      my $is_dir_func = $args{is_dir_func};
      my $filter_func = $args{filter_func};
      my $ci          = $args{ci} // $Complete::OPT_CI;
      my $map_case    = $args{map_case} // $Complete::OPT_MAP_CASE;
      my $exp_im_path = $args{exp_im_path} // $Complete::OPT_EXP_IM_PATH;
      my $dig_leaf    = $args{dig_leaf} // $Complete::OPT_DIG_LEAF;
      my $result_prefix = $args{result_prefix};
      my $starting_path = $args{starting_path} // '';
  
      my $exp_im_path_max_len = $Complete::OPT_EXP_IM_PATH_MAX_LEN;
  
      my $re_ends_with_path_sep = qr!\A\z|\Q$path_sep\E\z!;
  
      my @intermediate_dirs;
      {
          @intermediate_dirs = split qr/\Q$path_sep/, $word;
          @intermediate_dirs = ('') if !@intermediate_dirs;
          push @intermediate_dirs, '' if $word =~ $re_ends_with_path_sep;
      }
  
      my $leaf = pop @intermediate_dirs;
      @intermediate_dirs = ('') if !@intermediate_dirs;
  
  
      my @candidate_paths;
  
      for my $i (0..$#intermediate_dirs) {
          my $intdir = $intermediate_dirs[$i];
          my @dirs;
          if ($i == 0) {
              @dirs = ($starting_path);
          } else {
              @dirs = @candidate_paths;
          }
  
          if ($i == $#intermediate_dirs && $intdir eq '') {
              @candidate_paths = @dirs;
              last;
          }
  
          my @new_candidate_paths;
          for my $dir (@dirs) {
              my $listres = $list_func->($dir, $intdir, 1);
              next unless $listres && @$listres;
              my $re = do {
                  my $s = $intdir;
                  $s =~ s/_/-/g if $map_case;
                  $exp_im_path && length($s) <= $exp_im_path_max_len ?
                      ($ci ? qr/\A\Q$s/i : qr/\A\Q$s/) :
                          ($ci ? qr/\A\Q$s\E(?:\Q$path_sep\E)?\z/i :
                               qr/\A\Q$s\E(?:\Q$path_sep\E)?\z/);
              };
              for (@$listres) {
                  my $s = $_; $s =~ s/_/-/g if $map_case;
                  next unless $s =~ $re;
                  my $p = $dir =~ $re_ends_with_path_sep ?
                      "$dir$_" : "$dir$path_sep$_";
                  push @new_candidate_paths, $p;
              }
          }
          return [] unless @new_candidate_paths;
          @candidate_paths = @new_candidate_paths;
      }
  
      my $cut_chars = 0;
      if (length($starting_path)) {
          $cut_chars += length($starting_path);
          unless ($starting_path =~ /\Q$path_sep\E\z/) {
              $cut_chars += length($path_sep);
          }
      }
  
      my @res;
      for my $dir (@candidate_paths) {
          my $listres = $list_func->($dir, $leaf, 0);
          next unless $listres && @$listres;
          my $re = do {
              my $s = $leaf;
              $s =~ s/_/-/g if $map_case;
              $ci ? qr/\A\Q$s/i : qr/\A\Q$s/;
          };
        L1:
          for my $e (@$listres) {
              my $s = $e; $s =~ s/_/-/g if $map_case;
              next unless $s =~ $re;
              my $p = $dir =~ $re_ends_with_path_sep ?
                  "$dir$e" : "$dir$path_sep$e";
              {
                  local $_ = $p; 
                  next L1 if $filter_func && !$filter_func->($p);
              }
  
              my $is_dir;
              if ($e =~ $re_ends_with_path_sep) {
                  $is_dir = 1;
              } else {
                  local $_ = $p; 
                  $is_dir = $is_dir_func->($p);
              }
  
              if ($is_dir && $dig_leaf) {
                  $p = _dig_leaf($p, $list_func, $is_dir_func, $path_sep);
                  if ($p =~ $re_ends_with_path_sep) {
                      $is_dir = 1;
                  } else {
                      local $_ = $p; 
                      $is_dir = $is_dir_func->($p);
                  }
              }
  
              my $p0 = $p;
              substr($p, 0, $cut_chars) = '' if $cut_chars;
              $p = "$result_prefix$p" if length($result_prefix);
              unless ($p =~ /\Q$path_sep\E\z/) {
                  $p .= $path_sep if $is_dir;
              }
              push @res, $p;
          }
      }
  
      \@res;
  }
  1;
  
  __END__
  
COMPLETE_PATH

$fatpacked{"Complete/Util.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'COMPLETE_UTIL';
  package Complete::Util;
  
  our $DATE = '2015-04-02'; 
  our $VERSION = '0.27'; 
  
  use 5.010001;
  use strict;
  use warnings;
  
  use Complete;
  
  require Exporter;
  our @ISA = qw(Exporter);
  our @EXPORT_OK = qw(
                         hashify_answer
                         arrayify_answer
                         combine_answers
                         complete_array_elem
                         complete_hash_key
                         complete_env
                         complete_file
                         complete_program
                 );
  
  our %SPEC;
  
  $SPEC{':package'} = {
      v => 1.1,
      summary => 'General completion routine',
  };
  
  $SPEC{hashify_answer} = {
      v => 1.1,
      summary => 'Make sure we return completion answer in hash form',
      description => <<'_',
  
  This function accepts a hash or an array. If it receives an array, will convert
  the array into `{words=>$ary}' first to make sure the completion answer is in
  hash form.
  
  Then will add keys from `meta` to the hash.
  
  _
      args => {
          arg => {
              summary => '',
              schema  => ['any*' => of => ['array*','hash*']],
              req => 1,
              pos => 0,
          },
          meta => {
              summary => 'Metadata (extra keys) for the hash',
              schema  => 'hash*',
              pos => 1,
          },
      },
      result_naked => 1,
      result => {
          schema => 'hash*',
      },
  };
  sub hashify_answer {
      my $ans = shift;
      if (ref($ans) ne 'HASH') {
          $ans = {words=>$ans};
      }
      if (@_) {
          my $meta = shift;
          for (keys %$meta) {
              $ans->{$_} = $meta->{$_};
          }
      }
      $ans;
  }
  
  $SPEC{arrayify_answer} = {
      v => 1.1,
      summary => 'Make sure we return completion answer in array form',
      description => <<'_',
  
  This is the reverse of `hashify_answer`. It accepts a hash or an array. If it
  receives a hash, will return its `words` key.
  
  _
      args => {
          arg => {
              summary => '',
              schema  => ['any*' => of => ['array*','hash*']],
              req => 1,
              pos => 0,
          },
      },
      result_naked => 1,
      result => {
          schema => 'array*',
      },
  };
  sub arrayify_answer {
      my $ans = shift;
      if (ref($ans) eq 'HASH') {
          $ans = $ans->{words};
      }
      $ans;
  }
  
  $SPEC{complete_array_elem} = {
      v => 1.1,
      summary => 'Complete from array',
      description => <<'_',
  
  Will sort the resulting completion list, so you don't have to presort the array.
  
  _
      args => {
          word    => { schema=>[str=>{default=>''}], pos=>0, req=>1 },
          array   => { schema=>['array*'=>{of=>'str*'}], req=>1 },
          ci      => { schema=>['bool'] },
          exclude => { schema=>['array*'] },
      },
      result_naked => 1,
      result => {
          schema => 'array',
      },
  };
  sub complete_array_elem {
      use experimental 'smartmatch';
  
      my %args  = @_;
      my $array = $args{array} or die "Please specify array";
      my $word  = $args{word} // "";
      my $ci    = $args{ci} // $Complete::OPT_CI;
  
      my $has_exclude = $args{exclude};
      my $exclude;
      if ($ci) {
          $exclude = [map {uc} @{ $args{exclude} // [] }];
      } else {
          $exclude = $args{exclude} // [];
      }
  
      my $wordu = uc($word);
      my @words;
      for (@$array) {
          my $uc = uc($_) if $ci;
          next unless 0==($ci ? index($uc, $wordu) : index($_, $word));
          if ($has_exclude) {
              next if ($ci ? $uc : $_) ~~ @$exclude;
          }
          push @words, $_;
      }
      $ci ? [sort {lc($a) cmp lc($b)} @words] : [sort @words];
  }
  
  *complete_array = \&complete_array_elem;
  
  $SPEC{complete_hash_key} = {
      v => 1.1,
      summary => 'Complete from hash keys',
      args => {
          word  => { schema=>[str=>{default=>''}], pos=>0, req=>1 },
          hash  => { schema=>['hash*'=>{}], req=>1 },
          ci    => { schema=>['bool'] },
      },
      result_naked => 1,
      result => {
          schema => 'array',
      },
  };
  sub complete_hash_key {
      my %args  = @_;
      my $hash  = $args{hash} or die "Please specify hash";
      my $word  = $args{word} // "";
      my $ci    = $args{ci} // $Complete::OPT_CI;
  
      complete_array_elem(word=>$word, array=>[keys %$hash], ci=>$ci);
  }
  
  $SPEC{complete_env} = {
      v => 1.1,
      summary => 'Complete from environment variables',
      description => <<'_',
  
  On Windows, environment variable names are all converted to uppercase. You can
  use case-insensitive option (`ci`) to match against original casing.
  
  _
      args => {
          word  => { schema=>[str=>{default=>''}], pos=>0, req=>1 },
          ci    => { schema=>['bool'] },
      },
      result_naked => 1,
      result => {
          schema => 'array',
      },
  };
  sub complete_env {
      my %args  = @_;
      my $word  = $args{word} // "";
      my $ci    = $args{ci} // $Complete::OPT_CI;
      if ($word =~ /^\$/) {
          complete_array_elem(word=>$word, array=>[map {"\$$_"} keys %ENV],
                              ci=>$ci);
      } else {
          complete_array_elem(word=>$word, array=>[keys %ENV], ci=>$ci);
      }
  }
  
  $SPEC{complete_program} = {
      v => 1.1,
      summary => 'Complete program name found in PATH',
      description => <<'_',
  
  Windows is supported, on Windows PATH will be split using /;/ instead of /:/.
  
  _
      args => {
          word  => { schema=>[str=>{default=>''}], pos=>0, req=>1 },
          ci    => { schema=>'bool' },
      },
      result_naked => 1,
      result => {
          schema => 'array',
      },
  };
  sub complete_program {
      require List::MoreUtils;
  
      my %args = @_;
      my $word = $args{word} // "";
      my $ci   = $args{ci} // $Complete::OPT_CI;
  
      my $word_re = $ci ? qr/\A\Q$word/i : qr/\A\Q$word/;
  
      my @res;
      my @dirs = split(($^O =~ /Win32/ ? qr/;/ : qr/:/), $ENV{PATH});
      for my $dir (@dirs) {
          opendir my($dh), $dir or next;
          for (readdir($dh)) {
              push @res, $_ if $_ =~ $word_re && !(-d "$dir/$_") && (-x _);
          };
      }
  
      [sort(List::MoreUtils::uniq(@res))];
  }
  
  $SPEC{complete_file} = {
      v => 1.1,
      summary => 'Complete file and directory from local filesystem',
      args_groups => [
          {rel=>'one_of', args=>[qw/filter file_regex_filter/]},
      ],
      args => {
          word => {
              schema  => [str=>{default=>''}],
              req     => 1,
              pos     => 0,
          },
          ci => {
              summary => 'Case-insensitive matching',
              schema  => 'bool',
          },
          map_case => {
              schema  => 'bool',
          },
          exp_im_path => {
              schema  => 'bool',
          },
          dig_leaf => {
              schema  => 'bool',
          },
          filter => {
              summary => 'Only return items matching this filter',
              description => <<'_',
  
  Filter can either be a string or a code.
  
  For string filter, you can specify a pipe-separated groups of sequences of these
  characters: f, d, r, w, x. Dash can appear anywhere in the sequence to mean
  not/negate. An example: `f` means to only show regular files, `-f` means only
  show non-regular files, `drwx` means to show only directories which are
  readable, writable, and executable (cd-able). `wf|wd` means writable regular
  files or writable directories.
  
  For code filter, you supply a coderef. The coderef will be called for each item
  with these arguments: `$name`. It should return true if it wants the item to be
  included.
  
  _
              schema  => ['any*' => {of => ['str*', 'code*']}],
          },
          file_regex_filter => {
              summary => 'Filter shortcut for file regex',
              description => <<'_',
  
  This is a shortcut for constructing a filter. So instead of using `filter`, you
  use this option. This will construct a filter of including only directories or
  regular files, and the file must match a regex pattern. This use-case is common.
  
  _
              schema => 're*',
          },
          starting_path => {
              schema  => 'str*',
              default => '.',
          },
          handle_tilde => {
              schema  => 'bool',
              default => 1,
          },
          allow_dot => {
              summary => 'If turned off, will not allow "." or ".." in path',
              description => <<'_',
  
  This is most useful when combined with `starting_path` option to prevent user
  going up/outside the starting path.
  
  _
              schema  => 'bool',
              default => 1,
          },
      },
      result_naked => 1,
      result => {
          schema => 'array',
      },
  };
  sub complete_file {
      require Complete::Path;
      require File::Glob;
  
      my %args   = @_;
      my $word   = $args{word} // "";
      my $ci          = $args{ci} // $Complete::OPT_CI;
      my $map_case    = $args{map_case} // $Complete::OPT_MAP_CASE;
      my $exp_im_path = $args{exp_im_path} // $Complete::OPT_EXP_IM_PATH;
      my $dig_leaf    = $args{dig_leaf} // $Complete::OPT_DIG_LEAF;
      my $handle_tilde = $args{handle_tilde} // 1;
      my $allow_dot   = $args{allow_dot} // 1;
      my $filter = $args{filter};
  
      my $result_prefix;
      my $starting_path = $args{starting_path} // '.';
      if ($handle_tilde && $word =~ s!\A(~[^/]*)/!!) {
          $result_prefix = "$1/";
          my @dir = File::Glob::glob($1); 
          return [] unless @dir;
          $starting_path = $dir[0];
      } elsif ($allow_dot && $word =~ s!\A((?:\.\.?/+)+|/+)!!) {
          $starting_path = $1;
          $result_prefix = $1;
          $starting_path =~ s#/+\z## unless $starting_path =~ m!\A/!;
      }
  
      return [] if !$allow_dot &&
          $word =~ m!(?:\A|/)\.\.?(?:\z|/)!;
  
      my $list = sub {
          my ($path, $intdir, $isint) = @_;
          opendir my($dh), $path or return undef;
          my @res;
          for (sort readdir $dh) {
              next if ($_ eq '.' || $_ eq '..') && $intdir eq '';
              next if $isint && !(-d "$path/$_");
              push @res, $_;
          }
          \@res;
      };
  
      if ($filter && !ref($filter)) {
          my @seqs = split /\s*\|\s*/, $filter;
          $filter = sub {
              my $name = shift;
              my @st = stat($name) or return 0;
              my $mode = $st[2];
              my $pass;
            SEQ:
              for my $seq (@seqs) {
                  my $neg = sub { $_[0] };
                  for my $c (split //, $seq) {
                      if    ($c eq '-') { $neg = sub { $_[0] ? 0 : 1 } }
                      elsif ($c eq 'r') { next SEQ unless $neg->($mode & 0400) }
                      elsif ($c eq 'w') { next SEQ unless $neg->($mode & 0200) }
                      elsif ($c eq 'x') { next SEQ unless $neg->($mode & 0100) }
                      elsif ($c eq 'f') { next SEQ unless $neg->($mode & 0100000)}
                      elsif ($c eq 'd') { next SEQ unless $neg->($mode & 0040000)}
                      else {
                          die "Unknown character in filter: $c (in $seq)";
                      }
                  }
                  $pass = 1; last SEQ;
              }
              $pass;
          };
      } elsif (!$filter && $args{file_regex_filter}) {
          $filter = sub {
              my $name = shift;
              return 1 if -d $name;
              return 0 unless -f _;
              return 1 if $name =~ $args{file_regex_filter};
              0;
          };
      }
  
      Complete::Path::complete_path(
          word => $word,
  
          ci => $ci,
          map_case => $map_case,
          exp_im_path => $exp_im_path,
          dig_leaf => $dig_leaf,
  
          list_func => $list,
          is_dir_func => sub { -d $_[0] },
          filter_func => $filter,
          starting_path => $starting_path,
          result_prefix => $result_prefix,
      );
  }
  
  $SPEC{combine_answers} = {
      v => 1.1,
      summary => 'Given two or more answers, combine them into one',
      description => <<'_',
  
  This function is useful if you want to provide a completion answer that is
  gathered from multiple sources. For example, say you are providing completion
  for the Perl tool `cpanm`, which accepts a filename (a tarball like `*.tar.gz`),
  a directory, or a module name. You can do something like this:
  
      combine_answers(
          complete_file(word=>$word, ci=>1),
          complete_module(word=>$word, ci=>1),
      );
  
  _
      args => {
          answers => {
              schema => [
                  'array*' => {
                      of => ['any*', of=>['hash*','array*']], 
                      min_len => 1,
                  },
              ],
              req => 1,
              pos => 0,
              greedy => 1,
          },
      },
      args_as => 'array',
      result_naked => 1,
      result => {
          schema => 'hash*',
          description => <<'_',
  
  Return a combined completion answer. Words from each input answer will be
  combined, order preserved and duplicates removed. The other keys from each
  answer will be merged.
  
  _
      },
  };
  sub combine_answers {
      require List::Util;
  
      return undef unless @_;
      return $_[0] if @_ < 2;
  
      my $final = {words=>[]};
      my $encounter_hash;
      my $add_words = sub {
          my $words = shift;
          for my $entry (@$words) {
              push @{ $final->{words} }, $entry
                  unless List::Util::first(
                      sub {
                          (ref($entry) ? $entry->{word} : $entry)
                              eq
                                  (ref($_) ? $_->{word} : $_)
                              }, @{ $final->{words} }
                          );
          }
      };
  
      for my $ans (@_) {
          if (ref($ans) eq 'ARRAY') {
              $add_words->($ans);
          } elsif (ref($ans) eq 'HASH') {
              $encounter_hash++;
              $add_words->($ans->{words} // []);
              for (keys %$ans) {
                  if ($_ eq 'words') {
                      next;
                  } elsif ($_ eq 'static') {
                      if (exists $final->{$_}) {
                          $final->{$_} &&= $ans->{$_};
                      } else {
                          $final->{$_} = $ans->{$_};
                      }
                  } else {
                      $final->{$_} = $ans->{$_};
                  }
              }
          }
      }
      $encounter_hash ? $final : $final->{words};
  }
  
  
  1;
  
  __END__
  
COMPLETE_UTIL

$fatpacked{"Config/IOD/Base.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'CONFIG_IOD_BASE';
  package Config::IOD::Base;
  
  our $DATE = '2015-03-27'; 
  our $VERSION = '0.15'; 
  
  use 5.010001;
  use strict;
  use warnings;
  use Carp;
  
  use constant +{
      COL_V_ENCODING => 0, 
      COL_V_WS1 => 1,
      COL_V_VALUE => 2,
      COL_V_WS2 => 3,
      COL_V_COMMENT_CHAR => 4,
      COL_V_COMMENT => 5,
  };
  
  sub new {
      my ($class, %attrs) = @_;
      $attrs{default_section} //= 'GLOBAL';
      $attrs{allow_bang_only} //= 1;
      $attrs{allow_duplicate_key} //= 1;
      $attrs{enable_encoding} //= 1;
      $attrs{enable_quoting}  //= 1;
      $attrs{enable_bracket}  //= 1;
      $attrs{enable_brace}    //= 1;
      $attrs{enable_expr}     //= 0;
      $attrs{ignore_unknown_directive} //= 0;
      bless \%attrs, $class;
  }
  
  sub _parse_command_line {
      my ($self, $str) = @_;
  
      $str =~ s/\A\s+//ms;
      $str =~ s/\s+\z//ms;
  
      my @argv;
      my $buf;
      my $escaped;
      my $double_quoted;
      my $single_quoted;
  
      for my $char (split //, $str) {
          if ($escaped) {
              $buf .= $char;
              $escaped = undef;
              next;
          }
  
          if ($char eq '\\') {
              if ($single_quoted) {
                  $buf .= $char;
              }
              else {
                  $escaped = 1;
              }
              next;
          }
  
          if ($char =~ /\s/) {
              if ($single_quoted || $double_quoted) {
                  $buf .= $char;
              }
              else {
                  push @argv, $buf if defined $buf;
                  undef $buf;
              }
              next;
          }
  
          if ($char eq '"') {
              if ($single_quoted) {
                  $buf .= $char;
                  next;
              }
              $double_quoted = !$double_quoted;
              next;
          }
  
          if ($char eq "'") {
              if ($double_quoted) {
                  $buf .= $char;
                  next;
              }
              $single_quoted = !$single_quoted;
              next;
          }
  
          $buf .= $char;
      }
      push @argv, $buf if defined $buf;
  
      if ($escaped || $single_quoted || $double_quoted) {
          return undef;
      }
  
      \@argv;
  }
  
  sub _parse_raw_value {
      use experimental 'smartmatch';
  
      my ($self, $val, $needs_res) = @_;
  
      if ($val =~ /\A!/ && $self->{enable_encoding}) {
  
          $val =~ s/!(\w+)(\s+)// or return ("Invalid syntax in encoded value");
          my ($enc, $ws1) = ($1, $2);
  
          $enc = "json" if $enc eq 'j';
          $enc = "hex"  if $enc eq 'h';
          $enc = "expr" if $enc eq 'e';
  
          if ($self->{allow_encodings}) {
              return ("Encoding '$enc' is not in ".
                          "allow_encodings list")
                  unless $enc ~~ @{$self->{allow_encodings}};
          }
          if ($self->{disallow_encodings}) {
              return ("Encoding '$enc' is in ".
                          "disallow_encodings list")
                  if $enc ~~ @{$self->{disallow_encodings}};
          }
  
          if ($enc eq 'json') {
              $val =~ /\A
                       (".*"|\[.*\]|\{.*\}|\S+)
                       (\s*)
                       (?: ([;#])(.*) )?
                       \z/x or return ("Invalid syntax in JSON-encoded value");
              my $res = [
                  "!$enc", 
                  $ws1, 
                  $1, 
                  $2, 
                  $3, 
                  $4, 
              ] if $needs_res;
              my $decode_res = $self->_decode_json($val);
              return ($decode_res->[1]) unless $decode_res->[0] == 200;
              return (undef, $res, $decode_res->[2]);
          } elsif ($enc eq 'hex') {
              $val =~ /\A
                       ([0-9A-Fa-f]*)
                       (\s*)
                       (?: ([;#])(.*) )?
                       \z/x or return ("Invalid syntax in hex-encoded value");
              my $res = [
                  "!$enc", 
                  $ws1, 
                  $1, 
                  $2, 
                  $3, 
                  $4, 
              ] if $needs_res;
              my $decode_res = $self->_decode_hex($1);
              return ($decode_res->[1]) unless $decode_res->[0] == 200;
              return (undef, $res, $decode_res->[2]);
          } elsif ($enc eq 'base64') {
              $val =~ m!\A
                        ([A-Za-z0-9+/]*=*)
                        (\s*)
                        (?: ([;#])(.*) )?
                        \z!x or return ("Invalid syntax in base64-encoded value");
              my $res = [
                  "!$enc", 
                  $ws1, 
                  $1, 
                  $2, 
                  $3, 
                  $4, 
              ] if $needs_res;
              my $decode_res = $self->_decode_base64($1);
              return ($decode_res->[1]) unless $decode_res->[0] == 200;
              return (undef, $res, $decode_res->[2]);
          } elsif ($enc eq 'expr') {
              return ("expr is not allowed (enable_expr=0)")
                  unless $self->{enable_expr};
              $val =~ m!\A
                        ((?:[^#;])+?)
                        (\s*)
                        (?: ([;#])(.*) )?
                        \z!x or return ("Invalid syntax in expr-encoded value");
              my $res = [
                  "!$enc", 
                  $ws1, 
                  $1, 
                  $2, 
                  $3, 
                  $4, 
              ] if $needs_res;
              my $decode_res = $self->_decode_expr($1);
              return ($decode_res->[1]) unless $decode_res->[0] == 200;
              return (undef, $res, $decode_res->[2]);
          } else {
              return ("unknown encoding '$enc'");
          }
  
      } elsif ($val =~ /\A"/ && $self->{enable_quoting}) {
  
          $val =~ /\A
                   "( (?:
                           \\\\ | # backslash
                           \\.  | # escaped something
                           [^"\\]+ # non-doublequote or non-backslash
                       )* )"
                   (\s*)
                   (?: ([;#])(.*) )?
                   \z/x or return ("Invalid syntax in quoted string value");
          my $res = [
              '"', 
              '', 
              $1, 
              $2, 
              $3, 
              $4, 
          ] if $needs_res;
          my $decode_res = $self->_decode_json(qq("$1"));
          return ($decode_res->[1]) unless $decode_res->[0] == 200;
          return (undef, $res, $decode_res->[2]);
  
      } elsif ($val =~ /\A\[/ && $self->{enable_bracket}) {
  
          $val =~ /\A
                   \[(.*)\]
                   (?:
                       (\s*)
                       ([#;])(.*)
                   )?
                   \z/x or return ("Invalid syntax in bracketed array value");
          my $res = [
              '[', 
              '', 
              $1, 
              $2, 
              $3, 
              $4, 
          ] if $needs_res;
          my $decode_res = $self->_decode_json("[$1]");
          return ($decode_res->[1]) unless $decode_res->[0] == 200;
          return (undef, $res, $decode_res->[2]);
  
      } elsif ($val =~ /\A\{/ && $self->{enable_brace}) {
  
          $val =~ /\A
                   \{(.*)\}
                   (?:
                       (\s*)
                       ([#;])(.*)
                   )?
                   \z/x or return ("Invalid syntax in braced hash value");
          my $res = [
              '{', 
              '', 
              $1, 
              $2, 
              $3, 
              $4, 
          ] if $needs_res;
          my $decode_res = $self->_decode_json("{$1}");
          return ($decode_res->[1]) unless $decode_res->[0] == 200;
          return (undef, $res, $decode_res->[2]);
  
      } else {
  
          $val =~ /\A
                   (.*?)
                   (\s*)
                   (?: ([#;])(.*) )?
                   \z/x or return ("Invalid syntax in value"); 
          my $res = [
              '', 
              '', 
              $1, 
              $2, 
              $3, 
              $4, 
          ] if $needs_res;
          return (undef, $res, $1);
  
      }
  }
  
  sub _decode_json {
      my ($self, $val) = @_;
      state $json = do {
          require JSON;
          JSON->new->allow_nonref;
      };
      my $res;
      eval { $res = $json->decode($val) };
      if ($@) {
          return [500, "Invalid JSON: $@"];
      } else {
          return [200, "OK", $res];
      }
  }
  
  sub _decode_hex {
      my ($self, $val) = @_;
      [200, "OK", pack("H*", $val)];
  }
  
  sub _decode_base64 {
      my ($self, $val) = @_;
      require MIME::Base64;
      [200, "OK", MIME::Base64::decode_base64($val)];
  }
  
  sub _decode_expr {
      require Config::IOD::Expr;
  
      my ($self, $val) = @_;
      no strict 'refs';
      local *{"Config::IOD::Expr::val"} = sub {
          my $arg = shift;
          if ($arg =~ /(.+)\.(.+)/) {
              return $self->{_res}{$1}{$2};
          } else {
              return $self->{_res}{ $self->{_cur_section} }{$arg};
          }
      };
      Config::IOD::Expr::_parse_expr($val);
  }
  
  sub _err {
      my ($self, $msg) = @_;
      croak join(
          "",
          @{ $self->{_include_stack} } ? "$self->{_include_stack}[0] " : "",
          "line $self->{_linum}: ",
          $msg
      );
  }
  
  sub _push_include_stack {
      require Cwd;
  
      my ($self, $path) = @_;
  
      if (@{ $self->{_include_stack} }) {
          require File::Spec;
          my (undef, $dir, $file) =
              File::Spec->splitpath($self->{_include_stack}[-1]);
          $path = File::Spec->rel2abs($path, $dir);
      }
  
      my $abs_path = Cwd::abs_path($path) or return [400, "Invalid path name"];
      return [409, "Recursive", $abs_path]
          if grep { $_ eq $abs_path } @{ $self->{_include_stack} };
      push @{ $self->{_include_stack} }, $abs_path;
      return [200, "OK", $abs_path];
  }
  
  sub _pop_include_stack {
      my $self = shift;
  
      croak "BUG: Overpopped _pop_include_stack"
          unless @{$self->{_include_stack}};
      pop @{ $self->{_include_stack} };
  }
  
  sub _init_read {
      my $self = shift;
  
      $self->{_include_stack} = [];
  }
  
  sub _read_file {
      my ($self, $filename) = @_;
      open my $fh, "<", $filename
          or croak "Can't open file '$filename': $!";
      binmode($fh, ":utf8");
      local $/;
      return ~~<$fh>;
  }
  
  sub read_file {
      my ($self, $filename) = @_;
      $self->_init_read;
      my $res = $self->_push_include_stack($filename);
      croak "Can't read '$filename': $res->[1]" unless $res->[0] == 200;
      $res =
          $self->_read_string($self->_read_file($filename));
      $self->_pop_include_stack;
      $res;
  }
  
  sub read_string {
      my ($self, $str) = @_;
      $self->_init_read;
      $self->_read_string($str);
  }
  
  1;
  
  __END__
  
CONFIG_IOD_BASE

$fatpacked{"Config/IOD/Reader.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'CONFIG_IOD_READER';
  package Config::IOD::Reader;
  
  our $DATE = '2015-03-27'; 
  our $VERSION = '0.15'; 
  
  use 5.010001;
  use strict;
  use warnings;
  
  use parent qw(Config::IOD::Base);
  
  sub _merge {
      my ($self, $section) = @_;
  
      my $res = $self->{_res};
      for my $msect (@{ $self->{_merge} }) {
          if ($msect eq $section) {
              next;
          }
          if (!exists($res->{$msect})) {
              local $self->{_linum} = $self->{_linum}-1;
              $self->_err("Can't merge section '$msect' to '$section': ".
                              "Section '$msect' not seen yet");
          }
          for my $k (keys %{ $res->{$msect} }) {
              $res->{$section}{$k} //= $res->{$msect}{$k};
          }
      }
  }
  
  sub _init_read {
      my $self = shift;
  
      $self->SUPER::_init_read;
      $self->{_res} = {};
      $self->{_merge} = undef;
      $self->{_num_seen_section_lines} = 0;
      $self->{_cur_section} = $self->{default_section};
      $self->{_arrayified} = {};
  }
  
  sub _read_string {
      my ($self, $str) = @_;
  
      my $res = $self->{_res};
      my $cur_section = $self->{_cur_section};
  
      my $directive_re = $self->{allow_bang_only} ?
          qr/^;?\s*!\s*(\w+)\s*/ :
          qr/^;\s*!\s*(\w+)\s*/;
  
      my @lines = split /^/, $str;
      local $self->{_linum} = 0;
    LINE:
      for my $line (@lines) {
          $self->{_linum}++;
  
          if ($line !~ /\S/) {
              next LINE;
          }
  
          if ($line =~ s/$directive_re//) {
              my $directive = $1;
              if ($self->{allow_directives}) {
                  $self->_err("Directive '$directive' is not in ".
                                  "allow_directives list")
                      unless grep { $_ eq $directive }
                          @{$self->{allow_directives}};
              }
              if ($self->{disallow_directives}) {
                  $self->_err("Directive '$directive' is in ".
                                  "disallow_directives list")
                      if grep { $_ eq $directive }
                          @{$self->{disallow_directives}};
              }
              my $args = $self->_parse_command_line($line);
              if (!defined($args)) {
                  $self->_err("Invalid arguments syntax '$line'");
              }
              if ($directive eq 'include') {
                  my $path;
                  if (! @$args) {
                      $self->_err("Missing filename to include");
                  } elsif (@$args > 1) {
                      $self->_err("Extraneous arguments");
                  } else {
                      $path = $args->[0];
                  }
                  my $res = $self->_push_include_stack($path);
                  if ($res->[0] != 200) {
                      $self->_err("Can't include '$path': $res->[1]");
                  }
                  $path = $res->[2];
                  $self->_read_string($self->_read_file($path));
                  $self->_pop_include_stack;
              } elsif ($directive eq 'merge') {
                  $self->{_merge} = @$args ? $args : undef;
              } elsif ($directive eq 'noop') {
              } else {
                  if ($self->{ignore_unknown_directive}) {
                      next LINE;
                  } else {
                      $self->_err("Unknown directive '$directive'");
                  }
              }
              next LINE;
          }
  
          if ($line =~ /^\s*[;#]/) {
              next LINE;
          }
  
          if ($line =~ /^\s*\[\s*(.+?)\s*\](?: \s*[;#].*)?/) {
              my $prev_section = $self->{_cur_section};
              $self->{_cur_section} = $cur_section = $1;
              $res->{$cur_section} //= {};
              $self->{_num_seen_section_lines}++;
  
              if ($self->{_merge} && $self->{_num_seen_section_lines} > 1) {
                  $self->_merge($prev_section);
              }
  
              next LINE;
          }
  
          if ($line =~ /^\s*([^=]+?)\s*=\s*(.*)/) {
              my $key = $1;
              my $val = $2;
  
              if ($val =~ /\A["!\\[\{]/) {
                  my ($err, $parse_res, $decoded_val) = $self->_parse_raw_value($val);
                  $self->_err("Invalid value: " . $err) if $err;
                  $val = $decoded_val;
              } else {
                  $val =~ s/\s*[#;].*//; 
              }
  
              if (exists $res->{$cur_section}{$key}) {
                  if (!$self->{allow_duplicate_key}) {
                      $self->_err("Duplicate key: $key (section $cur_section)");
                  } elsif ($self->{_arrayified}{$cur_section}{$key}++) {
                      push @{ $res->{$cur_section}{$key} }, $val;
                  } else {
                      $res->{$cur_section}{$key} = [
                          $res->{$cur_section}{$key}, $val];
                  }
              } else {
                  $res->{$cur_section}{$key} = $val;
              }
  
              next LINE;
          }
  
          $self->_err("Invalid syntax");
      }
  
      if ($self->{_merge} && $self->{_num_seen_section_lines} > 1) {
          $self->_merge($cur_section);
      }
  
      $res;
  }
  
  1;
  
  __END__
  
CONFIG_IOD_READER

$fatpacked{"Data/Check/Structure.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'DATA_CHECK_STRUCTURE';
  package Data::Check::Structure;
  
  our $DATE = '2014-07-14'; 
  our $VERSION = '0.03'; 
  
  use 5.010001;
  use strict;
  use warnings;
  
  require Exporter;
  our @ISA = qw(Exporter);
  our @EXPORT_OK = qw(
                         is_aoa
                         is_aoaos
                         is_aoh
                         is_aohos
                         is_aos
                         is_hoa
                         is_hoaos
                         is_hoh
                         is_hohos
                         is_hos
                 );
  
  sub is_aos {
      my ($data, $opts) = @_;
      $opts //= {};
      my $max = $opts->{max};
  
      return 0 unless ref($data) eq 'ARRAY';
      for my $i (0..@$data-1) {
          last if defined($max) && $i >= $max;
          return 0 if ref($data->[$i]);
      }
      1;
  }
  
  sub is_aoa {
      my ($data, $opts) = @_;
      $opts //= {};
      my $max = $opts->{max};
  
      return 0 unless ref($data) eq 'ARRAY';
      for my $i (0..@$data-1) {
          last if defined($max) && $i >= $max;
          return 0 unless ref($data->[$i]) eq 'ARRAY';
      }
      1;
  }
  
  sub is_aoaos {
      my ($data, $opts) = @_;
      $opts //= {};
      my $max = $opts->{max};
  
      return 0 unless ref($data) eq 'ARRAY';
      my $aos_opts = {max=>$max};
      for my $i (0..@$data-1) {
          last if defined($max) && $i >= $max;
          return 0 unless is_aos($data->[$i], $aos_opts);
      }
      1;
  }
  
  sub is_aoh {
      my ($data, $opts) = @_;
      $opts //= {};
      my $max = $opts->{max};
  
      return 0 unless ref($data) eq 'ARRAY';
      for my $i (0..@$data-1) {
          last if defined($max) && $i >= $max;
          return 0 unless ref($data->[$i]) eq 'HASH';
      }
      1;
  }
  
  sub is_aohos {
      my ($data, $opts) = @_;
      $opts //= {};
      my $max = $opts->{max};
  
      return 0 unless ref($data) eq 'ARRAY';
      my $hos_opts = {max=>$max};
      for my $i (0..@$data-1) {
          last if defined($max) && $i >= $max;
          return 0 unless is_hos($data->[$i], $hos_opts);
      }
      1;
  }
  
  sub is_hos {
      my ($data, $opts) = @_;
      $opts //= {};
      my $max = $opts->{max};
  
      return 0 unless ref($data) eq 'HASH';
      my $i = 0;
      for my $k (keys %$data) {
          last if defined($max) && ++$i >= $max;
          return 0 if ref($data->{$k});
      }
      1;
  }
  
  sub is_hoa {
      my ($data, $opts) = @_;
      $opts //= {};
      my $max = $opts->{max};
  
      return 0 unless ref($data) eq 'HASH';
      my $i = 0;
      for my $k (keys %$data) {
          last if defined($max) && ++$i >= $max;
          return 0 unless ref($data->{$k}) eq 'ARRAY';
      }
      1;
  }
  
  sub is_hoaos {
      my ($data, $opts) = @_;
      $opts //= {};
      my $max = $opts->{max};
  
      return 0 unless ref($data) eq 'HASH';
      my $i = 0;
      for my $k (keys %$data) {
          last if defined($max) && ++$i >= $max;
          return 0 unless is_aos($data->{$k});
      }
      1;
  }
  
  sub is_hoh {
      my ($data, $opts) = @_;
      $opts //= {};
      my $max = $opts->{max};
  
      return 0 unless ref($data) eq 'HASH';
      my $i = 0;
      for my $k (keys %$data) {
          last if defined($max) && ++$i >= $max;
          return 0 unless ref($data->{$k}) eq 'HASH';
      }
      1;
  }
  
  sub is_hohos {
      my ($data, $opts) = @_;
      $opts //= {};
      my $max = $opts->{max};
  
      return 0 unless ref($data) eq 'HASH';
      my $i = 0;
      for my $k (keys %$data) {
          last if defined($max) && ++$i >= $max;
          return 0 unless is_hos($data->{$k});
      }
      1;
  }
  
  1;
  
  __END__
  
DATA_CHECK_STRUCTURE

$fatpacked{"Data/Clone.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'DATA_CLONE';
  package Data::Clone;
  
  use 5.008_001;
  use strict;
  
  our $VERSION = '0.004';
  
  use XSLoader;
  XSLoader::load(__PACKAGE__, $VERSION);
  
  use parent qw(Exporter);
  our @EXPORT    = qw(clone);
  our @EXPORT_OK = qw(data_clone TIECLONE);
  
  sub data_clone;
  *data_clone = \&clone; 
  
  sub TIECLONE;
  *TIECLONE = \&clone; 
  
  1;
  __END__
  
DATA_CLONE

$fatpacked{"Data/Dmp.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'DATA_DMP';
  package Data::Dmp;
  
  our $DATE = '2015-03-24'; 
  our $VERSION = '0.10'; 
  
  use 5.010001;
  use strict;
  use warnings;
  
  use Scalar::Util qw(looks_like_number blessed reftype refaddr);
  
  require Exporter;
  our @ISA = qw(Exporter);
  our @EXPORT = qw(dd dmp);
  
  our %_seen_refaddrs;
  our %_subscripts;
  our @_fixups;
  
  our $OPT_PERL_VERSION;
  
  my %esc = (
      "\a" => "\\a",
      "\b" => "\\b",
      "\t" => "\\t",
      "\n" => "\\n",
      "\f" => "\\f",
      "\r" => "\\r",
      "\e" => "\\e",
  );
  
  sub _double_quote {
      local($_) = $_[0];
  
      s/([\\\"\@\$])/\\$1/g;
      return qq("$_") unless /[^\040-\176]/;  
  
      s/([\a\b\t\n\f\r\e])/$esc{$1}/g;
  
      s/([\0-\037])(?!\d)/sprintf('\\%o',ord($1))/eg;
  
      s/([\0-\037\177-\377])/sprintf('\\x%02X',ord($1))/eg;
      s/([^\040-\176])/sprintf('\\x{%X}',ord($1))/eg;
  
      return qq("$_");
  }
  
  sub _dump {
      my ($val, $subscript) = @_;
  
      my $ref = ref($val);
      if ($ref eq '') {
          if (!defined($val)) {
              return "undef";
          } elsif (looks_like_number($val)) {
              return $val;
          } else {
              return _double_quote($val);
          }
      }
      my $refaddr = refaddr($val);
      $_subscripts{$refaddr} //= $subscript;
      if ($_seen_refaddrs{$refaddr}++) {
          push @_fixups, "\$a->$subscript=\$a",
              ($_subscripts{$refaddr} ? "->$_subscripts{$refaddr}" : ""), ";";
          return "'fix'";
      }
  
      my $class;
  
      if ($ref eq 'Regexp' || $ref eq 'REGEXP') {
          require Regexp::Stringify;
          return Regexp::Stringify::stringify_regexp(
              regexp=>$val, with_qr=>1, plver=>$OPT_PERL_VERSION);
      }
  
      if (blessed $val) {
          $class = $ref;
          $ref = reftype($val);
      }
  
      my $res;
      if ($ref eq 'ARRAY') {
          $res = "[";
          my $i = 0;
          for (@$val) {
              $res .= "," if $i;
              $res .= _dump($_, "$subscript\[$i]");
              $i++;
          }
          $res .= "]";
      } elsif ($ref eq 'HASH') {
          $res = "{";
          my $i = 0;
          for (sort keys %$val) {
              $res .= "," if $i++;
              my $k = /\W/ ? _double_quote($_) : $_;
              my $v = _dump($val->{$_}, "$subscript\{$k}");
              $res .= "$k=>$v";
          }
          $res .= "}";
      } elsif ($ref eq 'SCALAR') {
          $res = "\\"._dump($$val, $subscript);
      } elsif ($ref eq 'REF') {
          $res = "\\"._dump($$val, $subscript);
      } elsif ($ref eq 'CODE') {
          $res = "sub{'DUMMY'}";
      } else {
          die "Sorry, I can't dump $val (ref=$ref) yet";
      }
  
      $res = "bless($res,"._double_quote($class).")" if defined($class);
      $res;
  }
  
  our $_is_dd;
  sub _dd_or_dmp {
      local %_seen_refaddrs;
      local %_subscripts;
      local @_fixups;
  
      my $res;
      if (@_ > 1) {
          $res = "(" . join(",", map {_dump($_, '')} @_) . ")";
      } else {
          $res = _dump($_[0], '');
      }
      if (@_fixups) {
          $res = "do{my\$a=$res;" . join("", @_fixups) . "\$a}";
      }
  
      if ($_is_dd) {
          say $res;
          return @_;
      } else {
          return $res;
      }
  }
  
  sub dd { local $_is_dd=1; _dd_or_dmp(@_) }
  sub dmp { goto &_dd_or_dmp }
  
  1;
  
  __END__
  
DATA_DMP

$fatpacked{"Data/Sah.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'DATA_SAH';
  package Data::Sah;
  
  our $DATE = '2015-04-14'; 
  our $VERSION = '0.51'; 
  
  use 5.010001;
  use strict;
  use warnings;
  
  use Mo qw(build default);
  
  our $Log_Validator_Code = $ENV{LOG_SAH_VALIDATOR_CODE} // 0;
  
  use Data::Sah::Normalize qw(
                         $type_re
                         $clause_name_re
                         $clause_re
                         $attr_re
                         $funcset_re
                         $compiler_re
                         );
  
  require Exporter;
  our @ISA       = qw(Exporter);
  our @EXPORT_OK = qw(normalize_schema gen_validator);
  
  has compilers    => (is => 'rw', default => sub { {} });
  
  has _merger      => (
      is      => 'rw',
      lazy    => 1,
      default => sub {
          require Data::ModeMerge;
          my $mm = Data::ModeMerge->new(config => {
              recurse_array => 1,
          });
          $mm->modes->{NORMAL}  ->prefix   ('merge.normal.');
          $mm->modes->{NORMAL}  ->prefix_re(qr/\Amerge\.normal\./);
          $mm->modes->{ADD}     ->prefix   ('merge.add.');
          $mm->modes->{ADD}     ->prefix_re(qr/\Amerge\.add\./);
          $mm->modes->{CONCAT}  ->prefix   ('merge.concat.');
          $mm->modes->{CONCAT}  ->prefix_re(qr/\Amerge\.concat\./);
          $mm->modes->{SUBTRACT}->prefix   ('merge.subtract.');
          $mm->modes->{SUBTRACT}->prefix_re(qr/\Amerge\.subtract\./);
          $mm->modes->{DELETE}  ->prefix   ('merge.delete.');
          $mm->modes->{DELETE}  ->prefix_re(qr/\Amerge\.delete\./);
          $mm->modes->{KEEP}    ->prefix   ('merge.keep.');
          $mm->modes->{KEEP}    ->prefix_re(qr/\Amerge\.keep\./);
          $mm;
      },
  );
  
  has _var_enumer  => (
      is      => 'rw',
      lazy    => 1,
      default => sub {
          require Language::Expr::Interpreter::VarEnumer;
          Language::Expr::Interpreter::VarEnumer->new;
      },
  );
  
  sub normalize_clset {
      require Scalar::Util;
  
      my $self;
      if (Scalar::Util::blessed($_[0])) {
          $self = shift;
      } else {
          $self = __PACKAGE__->new;
      }
  
      Data::Sah::Normalize::normalize_clset(@_);
  }
  
  sub normalize_schema {
      require Scalar::Util;
  
      my $self;
      if (Scalar::Util::blessed($_[0])) {
          $self = shift;
      } else {
          $self = __PACKAGE__->new;
      }
      my ($s) = @_;
  
      Data::Sah::Normalize::normalize_schema(@_);
  }
  
  sub gen_validator {
      require Scalar::Util;
  
      my $self;
      if (Scalar::Util::blessed($_[0])) {
          $self = shift;
      } else {
          $self = __PACKAGE__->new;
      }
      my ($schema, $opts) = @_;
      my %args = (schema => $schema, %{$opts // {}});
      my $opt_source = delete $args{source};
  
      $args{log_result} = 1 if $Log_Validator_Code;
  
      my $pl = $self->get_compiler("perl");
      my $code = $pl->expr_validator_sub(%args);
      return $code if $opt_source;
  
      my $res = eval $code;
      die "Can't compile validator: $@" if $@;
      $res;
  }
  
  sub _merge_clause_sets {
      my ($self, @clause_sets) = @_;
      my @merged;
  
      my $mm = $self->_merger;
  
      my @c;
      for (@clause_sets) {
          push @c, {cs=>$_, has_prefix=>$mm->check_prefix_on_hash($_)};
      }
      for (reverse @c) {
          if ($_->{has_prefix}) { $_->{last_with_prefix} = 1; last }
      }
  
      my $i = -1;
      for my $c (@c) {
          $i++;
          if (!$i || !$c->{has_prefix} && !$c[$i-1]{has_prefix}) {
              push @merged, $c->{cs};
              next;
          }
          $mm->config->readd_prefix(
              ($c->{last_with_prefix} || $c[$i-1]{last_with_prefix}) ? 0 : 1);
          my $mres = $mm->merge($merged[-1], $c->{cs});
          die "Can't merge clause sets: $mres->{error}" unless $mres->{success};
          $merged[-1] = $mres->{result};
      }
      \@merged;
  }
  
  sub get_compiler {
      my ($self, $name) = @_;
      return $self->compilers->{$name} if $self->compilers->{$name};
  
      die "Invalid compiler name `$name`" unless $name =~ $compiler_re;
      my $module = "Data::Sah::Compiler::$name";
      if (!eval "require $module; 1") {
          die "Can't load compiler module $module".($@ ? ": $@" : "");
      }
  
      my $obj = $module->new(main => $self);
      $self->compilers->{$name} = $obj;
  
      return $obj;
  }
  
  sub normalize_var {
      my ($self, $var, $curpath) = @_;
      die "Not yet implemented";
  }
  
  1;
  
  __END__
  
DATA_SAH

$fatpacked{"Data/Sah/Compiler.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'DATA_SAH_COMPILER';
  package Data::Sah::Compiler;
  
  our $DATE = '2015-04-14'; 
  our $VERSION = '0.51'; 
  
  use 5.010;
  use strict;
  use warnings;
  
  use Mo qw(default);
  use Role::Tiny::With;
  use Log::Any::IfLOG qw($log);
  
  with 'Data::Sah::Compiler::TextResultRole';
  
  use Scalar::Util qw(blessed);
  
  has main => (is => 'rw');
  
  has expr_compiler => (
      is => 'rw',
      lazy => 1,
      default => sub {
          require Language::Expr;
          Language::Expr->new;
      },
  );
  
  sub name {
      die "BUG: Please override name()";
  }
  
  sub literal {
      die "BUG: Please override literal()";
  }
  
  sub expr {
      die "BUG: Please override expr()";
  }
  
  sub _die {
      my ($self, $cd, $msg) = @_;
      die join(
          "",
          "Sah ". $self->name . " compiler: ",
          "at schema:/", join("/", @{$cd->{spath} // []}), ": ",
          $msg,
      );
  }
  
  sub _form_deps {
      require Algorithm::Dependency::Ordered;
      require Algorithm::Dependency::Source::HoA;
      require Language::Expr::Interpreter::VarEnumer;
  
      my ($self, $cd, $ctbl) = @_;
      my $main = $self->main;
  
      my %depends;
      for my $crec (values %$ctbl) {
          my $cn = $crec->{name};
          my $expr = defined($crec->{expr}) ? $crec->{value} :
              $crec->{attrs}{expr};
          if (defined $expr) {
              my $vars = $main->_var_enumer->eval($expr);
              for (@$vars) {
                  /^\w+$/ or $self->_die($cd,
                      "Invalid variable syntax '$_', ".
                          "currently only the form \$abc is supported");
                  $ctbl->{$_} or $self->_die($cd,
                      "Unhandled clause specified in variable '$_'");
              }
              $depends{$cn} = $vars;
              for (@$vars) {
                  push @{ $ctbl->{$_}{depended_by} }, $cn;
              }
          } else {
              $depends{$cn} = [];
          }
      }
      my $ds = Algorithm::Dependency::Source::HoA->new(\%depends);
      my $ad = Algorithm::Dependency::Ordered->new(source => $ds)
          or die "Failed to set up dependency algorithm";
      my $sched = $ad->schedule_all
          or die "Can't resolve dependencies, please check your expressions";
      my %rsched = map
          {@{ $depends{$sched->[$_]} } ? ($sched->[$_] => $_) : ()}
              0..@$sched-1;
      \%rsched;
  }
  
  sub _resolve_base_type {
      require Scalar::Util;
  
      my ($self, %args) = @_;
      my $ns   = $args{schema};
      my $t    = $ns->[0];
      my $cd   = $args{cd};
      my $th   = $self->get_th(name=>$t, cd=>$cd);
      my $seen = $args{seen} // {};
      my $res  = $args{res} // [$t, [], []];
  
      $self->_die($cd, "Recursive dependency on type '$t'") if $seen->{$t}++;
  
      $res->[0] = $t;
      unshift @{$res->[1]}, $ns->[1] if keys(%{$ns->[1]});
      unshift @{$res->[2]}, $ns->[2] if $ns->[2];
      if (Scalar::Util::blessed $th) {
          $res->[1] = $self->main->_merge_clause_sets(@{$res->[1]}) if @{$res->[1]} > 1;
          $res->[2] = $self->main->_merge_clause_sets(@{$res->[2]}) if @{$res->[2]} > 1;
      } else {
          $self->_resolve_base_type(schema=>$th, cd=>$cd, seen=>$seen, res=>$res);
      }
      $res;
  }
  
  sub _get_clauses_from_clsets {
      my ($self, $cd, $clsets) = @_;
      my $tn = $cd->{type};
      my $th = $cd->{th};
  
      my $deps;
  
      my $sorter = sub {
          my ($ia, $ca) = @$a;
          my ($ib, $cb) = @$b;
          my $res;
  
  
          my ($metaa, $metab);
          eval {
              $metaa = "Data::Sah::Type::$tn"->${\("clausemeta_$ca")};
          };
          if ($@) {
              for ($cd->{args}{on_unhandled_clause}) {
                  my $msg = "Unhandled clause for type $tn: $ca ($@)";
                  next if $_ eq 'ignore';
                  next if $_ eq 'warn'; 
                  $self->_die($cd, $msg);
              }
          }
          $metaa //= {prio=>50};
          eval {
              $metab = "Data::Sah::Type::$tn"->${\("clausemeta_$cb")};
          };
          if ($@) {
              for ($cd->{args}{on_unhandled_clause}) {
                  my $msg = "Unhandled clause for type $tn: $cb";
                  next if $_ eq 'ignore';
                  next if $_ eq 'warn'; 
                  $self->_die($cd, $msg);
              }
          }
          $metab //= {prio=>50};
  
          {
              $res = $metaa->{prio} <=> $metab->{prio};
              last if $res;
  
              my $sprioa = $clsets->[$ia]{"$ca.prio"} // 50;
              my $spriob = $clsets->[$ib]{"$cb.prio"} // 50;
              $res = $sprioa <=> $spriob;
              last if $res;
  
              $res = $ca cmp $cb;
              last if $res;
  
              $res = $ia <=> $ib;
              last if $res;
  
              $res = 0;
          }
  
          $res;
      };
  
      my @clauses;
      for my $i (0..@$clsets-1) {
          push @clauses, map {[$i, $_]}
              grep {!/\A_/ && !/\./} keys %{$clsets->[$i]};
      }
  
      my $res = [sort $sorter @clauses];
      $res;
  }
  
  sub get_th {
      my ($self, %args) = @_;
      my $cd    = $args{cd};
      my $name  = $args{name};
  
      my $th_map = $cd->{th_map};
      return $th_map->{$name} if $th_map->{$name};
  
      if ($args{load} // 1) {
          no warnings;
          $self->_die($cd, "Invalid syntax for type name '$name', please use ".
                          "letters/numbers/underscores only")
              unless $name =~ $Data::Sah::type_re;
          my $main = $self->main;
          my $module = ref($self) . "::TH::$name";
          if (!eval "require $module; 1") {
              $self->_die($cd, "Can't load type handler $module".
                              ($@ ? ": $@" : ""));
          }
  
          my $obj = $module->new(compiler=>$self);
          $th_map->{$name} = $obj;
      }
      use experimental 'smartmatch';
  
      return $th_map->{$name};
  }
  
  sub get_fsh {
      my ($self, %args) = @_;
      my $cd    = $args{cd};
      my $name  = $args{name};
  
      my $fsh_table = $cd->{fsh_table};
      return $fsh_table->{$name} if $fsh_table->{$name};
  
      if ($args{load} // 1) {
          no warnings;
          $self->_die($cd, "Invalid syntax for func set name '$name', ".
                          "please use letters/numbers/underscores")
              unless $name =~ $Data::Sah::funcset_re;
          my $module = ref($self) . "::FSH::$name";
          if (!eval "require $module; 1") {
              $self->_die($cd, "Can't load func set handler $module".
                              ($@ ? ": $@" : ""));
          }
  
          my $obj = $module->new();
          $fsh_table->{$name} = $obj;
      }
      use experimental 'smartmatch';
  
      return $fsh_table->{$name};
  }
  
  sub init_cd {
      require Time::HiRes;
  
      my ($self, %args) = @_;
  
      my $cd = {};
      $cd->{args} = \%args;
  
      if (my $ocd = $args{outer_cd}) {
          $cd->{_inner}       = 1;
  
          $cd->{outer_cd}     = $ocd;
          $cd->{indent_level} = $ocd->{indent_level};
          $cd->{th_map}       = { %{ $ocd->{th_map}  } };
          $cd->{fsh_map}      = { %{ $ocd->{fsh_map} } };
          $cd->{default_lang} = $ocd->{default_lang};
          $cd->{spath}        = [@{ $ocd->{spath} }];
      } else {
          $cd->{indent_level} = $cd->{args}{indent_level} // 0;
          $cd->{th_map}       = {};
          $cd->{fsh_map}      = {};
          $cd->{default_lang} = $ENV{LANG} || "en_US";
          $cd->{default_lang} =~ s/\..+//; 
          $cd->{spath}        = [];
      }
      $cd->{_id} = Time::HiRes::gettimeofday(); 
      $cd->{ccls} = [];
  
      $cd;
  }
  
  sub check_compile_args {
      my ($self, $args) = @_;
  
      return if $args->{_args_checked}++;
  
      $args->{data_name} //= 'data';
      $args->{data_name} =~ /\A[A-Za-z_]\w*\z/ or $self->_die(
          {}, "Invalid syntax in data_name '$args->{data_name}', ".
              "please use letters/nums only");
      $args->{allow_expr} //= 1;
      $args->{on_unhandled_attr}   //= 'die';
      $args->{on_unhandled_clause} //= 'die';
      $args->{skip_clause}         //= [];
      $args->{mark_missing_translation} //= 1;
      for ($args->{lang}) {
          $_ //= $ENV{LANG} || $ENV{LANGUAGE} || "en_US";
          s/\W.*//; 
      }
  }
  
  sub _process_clause {
      use experimental 'smartmatch';
  
      my ($self, $cd, $clset_num, $clause) = @_;
  
      my $th = $cd->{th};
      my $tn = $cd->{type};
      my $clsets = $cd->{clsets};
  
      my $clset = $clsets->[$clset_num];
      local $cd->{spath}       = [@{$cd->{spath}}, $clause];
      local $cd->{clset}       = $clset;
      local $cd->{clset_num}   = $clset_num;
      local $cd->{uclset}      = $cd->{uclsets}[$clset_num];
      local $cd->{clset_dlang} = $cd->{_clset_dlangs}[$clset_num];
  
      delete $cd->{uclset}{$clause};
      delete $cd->{uclset}{"$clause.prio"};
  
      if ($clause ~~ @{ $cd->{args}{skip_clause} }) {
          delete $cd->{uclset}{$_}
              for grep /^\Q$clause\E(\.|\z)/, keys(%{$cd->{uclset}});
          return;
      }
  
      my $meth  = "clause_$clause";
      my $mmeth = "clausemeta_$clause";
      unless ($th->can($meth)) {
          for ($cd->{args}{on_unhandled_clause}) {
              next if $_ eq 'ignore';
              do { warn "Can't handle clause $clause"; next }
                  if $_ eq 'warn';
              $self->_die($cd, "Can't handle clause $clause");
          }
      }
  
  
      my $meta;
      if ($th->can($mmeth)) {
          $meta = $th->$mmeth;
      } else {
          $meta = {};
      }
      local $cd->{cl_meta} = $meta;
      $self->_die($cd, "Clause $clause doesn't allow expression")
          if $clset->{"$clause.is_expr"} && !$meta->{allow_expr};
      for my $a (keys %{ $meta->{attrs} }) {
          my $av = $meta->{attrs}{$a};
          $self->_die($cd, "Attribute $clause.$a doesn't allow ".
                          "expression")
              if $clset->{"$clause.$a.is_expr"} && !$av->{allow_expr};
      }
      local $cd->{clause} = $clause;
      my $cv = $clset->{$clause};
      my $ie = $clset->{"$clause.is_expr"};
      my $op = $clset->{"$clause.op"};
      local $cd->{cl_value}   = $cv;
      local $cd->{cl_term}    = $ie ? $self->expr($cv) : $self->literal($cv);
      local $cd->{cl_is_expr} = $ie;
      local $cd->{cl_op}      = $op;
      delete $cd->{uclset}{"$clause.is_expr"};
      delete $cd->{uclset}{"$clause.op"};
  
      if ($self->can("before_clause")) {
          $self->before_clause($cd);
      }
      if ($th->can("before_clause")) {
          $th->before_clause($cd);
      }
      my $tmpnam = "before_clause_$clause";
      if ($th->can($tmpnam)) {
          $th->$tmpnam($cd);
      }
  
      my $is_multi;
      if (defined($op) && !$ie) {
          if ($op =~ /\A(and|or|none)\z/) {
              $is_multi = 1;
          } elsif ($op eq 'not') {
              $is_multi = 0;
          } else {
              $self->_die($cd, "Invalid value for $clause.op, ".
                              "must be one of and/or/not/none");
          }
      }
      $self->_die($cd, "'$clause.op' attribute set to $op, ".
                      "but value of '$clause' clause not an array")
          if $is_multi && ref($cv) ne 'ARRAY';
      if (!$th->can($meth)) {
      } elsif ($cd->{CLAUSE_DO_MULTI} || !$is_multi) {
          local $cd->{cl_is_multi} = 1 if $is_multi;
          $th->$meth($cd);
      } else {
          my $i = 0;
          for my $cv2 (@$cv) {
              local $cd->{spath} = [@{ $cd->{spath} }, $i];
              local $cd->{cl_value} = $cv2;
              local $cd->{cl_term}  = $self->literal($cv2);
              local $cd->{_debug_ccl_note} = "" if $i;
              $i++;
              $th->$meth($cd);
          }
      }
  
      $tmpnam = "after_clause_$clause";
      if ($th->can($tmpnam)) {
          $th->$tmpnam($cd);
      }
      if ($th->can("after_clause")) {
          $th->after_clause($cd);
      }
      if ($self->can("after_clause")) {
          $self->after_clause($cd);
      }
  
      delete $cd->{uclset}{"$clause.err_msg"};
      delete $cd->{uclset}{"$clause.err_level"};
      delete $cd->{uclset}{$_} for
          grep /\A\Q$clause\E\.human(\..+)?\z/, keys(%{$cd->{uclset}});
  }
  
  sub _process_clsets {
      my ($self, $cd, $which) = @_;
  
  
      my $th = $cd->{th};
      my $tn = $cd->{type};
      my $clsets = $cd->{clsets};
  
      my $cname = $self->name;
      local $cd->{uclsets} = [];
      $cd->{_clset_dlangs} = []; 
      for my $clset (@$clsets) {
          for (keys %$clset) {
              if (!$cd->{args}{allow_expr} && /\.is_expr\z/ && $clset->{$_}) {
                  $self->_die($cd, "Expression not allowed: $_");
              }
          }
          push @{ $cd->{uclsets} }, {
              map {$_=>$clset->{$_}}
                  grep {
                      !/\A_|\._/ && (!/\Ac\./ || /\Ac\.\Q$cname\E\./)
                  } keys %$clset
          };
          my $dl = $clset->{default_lang} // $cd->{outer_cd}{clset_dlang} //
              "en_US";
          push @{ $cd->{_clset_dlangs} }, $dl;
      }
  
      my $clauses = $self->_get_clauses_from_clsets($cd, $clsets);
  
      if ($which) {
          if ($self->can("before_clause_sets")) {
              $self->before_clause_sets($cd);
          }
          if ($th->can("before_clause_sets")) {
              $th->before_clause_sets($cd);
          }
      } else {
          if ($self->can("before_handle_type")) {
              $self->before_handle_type($cd);
          }
  
          $th->handle_type($cd);
  
          if ($self->can("before_all_clauses")) {
              $self->before_all_clauses($cd);
          }
          if ($th->can("before_all_clauses")) {
              $th->before_all_clauses($cd);
          }
      }
  
      for my $clause0 (@$clauses) {
          my ($clset_num, $clause) = @$clause0;
          $self->_process_clause($cd, $clset_num, $clause);
      } 
  
      for my $uclset (@{ $cd->{uclsets} }) {
          if (keys %$uclset) {
              for ($cd->{args}{on_unhandled_attr}) {
                  my $msg = "Unhandled attribute(s) for type $tn: ".
                      join(", ", keys %$uclset);
                  next if $_ eq 'ignore';
                  do { warn $msg; next } if $_ eq 'warn';
                  $self->_die($cd, $msg);
              }
          }
      }
  
      if ($which) {
          if ($th->can("after_clause_sets")) {
              $th->after_clause_sets($cd);
          }
          if ($self->can("after_clause_sets")) {
              $self->after_clause_sets($cd);
          }
      } else {
          if ($th->can("after_all_clauses")) {
              $th->after_all_clauses($cd);
          }
          if ($self->can("after_all_clauses")) {
              $self->after_all_clauses($cd);
          }
      }
  }
  
  sub compile {
      my ($self, %args) = @_;
  
      $self->check_compile_args(\%args);
  
      my $main   = $self->main;
      my $cd     = $self->init_cd(%args);
  
      if ($self->can("before_compile")) {
          $self->before_compile($cd);
      }
  
      my $schema0 = $args{schema} or $self->_die($cd, "No schema");
      my $nschema;
      if ($args{schema_is_normalized}) {
          $nschema = $schema0;
      } else {
          $nschema = $main->normalize_schema($schema0);
      }
      $cd->{nschema} = $nschema;
      local $cd->{schema} = $nschema;
  
      {
          my $defs = $nschema->[2]{def};
          if ($defs) {
              for my $name (sort keys %$defs) {
                  my $def = $defs->{$name};
                  my $opt = $name =~ s/[?]\z//;
                  local $cd->{def_optional} = $opt;
                  local $cd->{def_name}     = $name;
                  $self->_die($cd, "Invalid name syntax in def: '$name'")
                      unless $name =~ $Data::Sah::type_re;
                  local $cd->{def_def}      = $def;
                  $self->def($cd);
              }
          }
      }
  
      my $res       = $self->_resolve_base_type(schema=>$nschema, cd=>$cd);
      my $tn        = $res->[0];
      my $th        = $self->get_th(name=>$tn, cd=>$cd);
      my $clsets    = $res->[1];
      $cd->{th}     = $th;
      $cd->{type}   = $tn;
      $cd->{clsets} = $clsets;
  
      $self->_process_clsets($cd);
  
      if ($self->can("after_compile")) {
          $self->after_compile($cd);
      }
  
      if ($args{log_result}) {
          require String::LineNumber;
          $log->tracef(
              "Schema compilation result:\n%s",
              !ref($cd->{result}) && ($ENV{LINENUM} // 1) ?
                  String::LineNumber::linenum($cd->{result}) :
                        $cd->{result}
                    );
      }
      return $cd;
  }
  
  sub def {
      my ($self, $cd) = @_;
      my $name = $cd->{def_name};
      my $def  = $cd->{def_def};
      my $opt  = $cd->{def_optional};
  
      my $th = $self->get_th(cd=>$cd, name=>$name, load=>0);
      if ($th) {
          if ($opt) {
              return;
          }
          $self->_die($cd, "Redefining existing type ($name) not allowed");
      }
  
      my $nschema = $self->main->normalize_schema($def);
      $cd->{th_map}{$name} = $nschema;
  }
  
  sub _ignore_clause {
      my ($self, $cd) = @_;
      my $cl = $cd->{clause};
      delete $cd->{uclset}{$cl};
  }
  
  sub _ignore_clause_and_attrs {
      my ($self, $cd) = @_;
      my $cl = $cd->{clause};
      delete $cd->{uclset}{$cl};
      delete $cd->{uclset}{$_} for grep /\A\Q$cl\E\./, keys %{$cd->{uclset}};
  }
  
  sub _die_unimplemented_clause {
      my ($self, $cd, $note) = @_;
  
      $self->_die($cd, "Clause '$cd->{clause}' for type '$cd->{type}' ".
                      ($note ? "($note) " : "") .
                          "is currently unimplemented");
  }
  
  1;
  
  __END__
  
DATA_SAH_COMPILER

$fatpacked{"Data/Sah/Compiler/Prog.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'DATA_SAH_COMPILER_PROG';
  package Data::Sah::Compiler::Prog;
  
  our $DATE = '2015-04-14'; 
  our $VERSION = '0.51'; 
  
  use 5.010;
  use strict;
  use warnings;
  use Log::Any::IfLOG qw($log);
  
  use Mo qw(build default);
  extends 'Data::Sah::Compiler';
  
  
  has hc => (is => 'rw');
  
  has comment_style => (is => 'rw');
  
  has var_sigil => (is => 'rw');
  
  has concat_op => (is => 'rw');
  
  has logical_and_op => (is => 'rw', default => sub {'&&'});
  
  has logical_not_op => (is => 'rw', default => sub {'!'});
  
  
  sub init_cd {
      my ($self, %args) = @_;
  
      my $cd = $self->SUPER::init_cd(%args);
      $cd->{vars} = {};
  
      my $hc = $self->hc;
      if (!$hc) {
          $hc = $self->main->get_compiler("human");
          $self->hc($hc);
      }
  
      if (my $ocd = $cd->{outer_cd}) {
          $cd->{vars}    = $ocd->{vars};
          $cd->{modules} = $ocd->{modules};
          $cd->{_hc}     = $ocd->{_hc};
          $cd->{_hcd}    = $ocd->{_hcd};
          $cd->{_subdata_level} = $ocd->{_subdata_level};
      } else {
          $cd->{vars}    = {};
          $cd->{modules} = [];
          $cd->{_hc}     = $hc;
          $cd->{_subdata_level} = 0;
      }
  
      $cd;
  }
  
  sub check_compile_args {
      my ($self, $args) = @_;
  
      return if $args->{_args_checked_Prog}++;
  
      $self->SUPER::check_compile_args($args);
  
      my $ct = ($args->{code_type} //= 'validator');
      if ($ct ne 'validator') {
          $self->_die({}, "code_type currently can only be 'validator'");
      }
      my $rt = ($args->{return_type} //= 'bool');
      if ($rt !~ /\A(bool|str|full)\z/) {
          $self->_die({}, "Invalid value for return_type, ".
                          "use bool|str|full");
      }
      $args->{var_prefix} //= "_sahv_";
      $args->{sub_prefix} //= "_sahs_";
      $args->{data_term}  //= $self->var_sigil . $args->{data_name};
      $args->{data_term_is_lvalue} //= 1;
      $args->{tmp_data_name} //= "tmp_$args->{data_name}";
      $args->{tmp_data_term} //= $self->var_sigil . $args->{tmp_data_name};
      $args->{comment}    //= 1;
      $args->{err_term}   //= $self->var_sigil . "err_$args->{data_name}";
  }
  
  sub comment {
      my ($self, $cd, @args) = @_;
      return '' unless $cd->{args}{comment};
  
      my $content = join("", @args);
      $content =~ s/\n+/ /g;
  
      my $style = $self->comment_style;
      if ($style eq 'shell') {
          return join("", "# ", $content, "\n");
      } elsif ($style eq 'shell2') {
          return join("", "## ", $content, "\n");
      } elsif ($style eq 'cpp') {
          return join("", "// ", $content, "\n");
      } elsif ($style eq 'c') {
          return join("", "/* ", $content, '*/');
      } elsif ($style eq 'ini') {
          return join("", "; ", $content, "\n");
      } else {
          $self->_die($cd, "BUG: Unknown comment style: $style");
      }
  }
  
  sub enclose_paren {
      my ($self, $expr, $force) = @_;
      if ($expr =~ /\A(\s*)(\(.+\)\s*)\z/os) {
          return $expr if !$force;
          return "$1($2)";
      } else {
          $expr =~ /\A(\s*)(.*)/os;
          return "$1($2)";
      }
  }
  
  sub add_module {
      use experimental 'smartmatch';
  
      my ($self, $cd, $name) = @_;
  
      return 0 if $name ~~ @{ $cd->{modules} };
      push @{ $cd->{modules} }, $name;
      1;
  }
  
  sub add_var {
      my ($self, $cd, $name, $value) = @_;
  
      return if exists $cd->{vars}{$name};
      $cd->{vars}{$name} = $value;
  }
  
  
  sub expr_assign {
      my ($self, $v, $t) = @_;
      "$v = $t";
  }
  
  sub _xlt {
      my ($self, $cd, $text) = @_;
  
      my $hc  = $cd->{_hc};
      my $hcd = $cd->{_hcd};
      $hc->_xlt($hcd, $text);
  }
  
  sub expr_concat {
      my ($self, @t) = @_;
      join(" " . $self->concat_op . " ", @t);
  }
  
  sub expr_var {
      my ($self, $v) = @_;
      $self->var_sigil. $v;
  }
  
  sub expr_preinc {
      my ($self, $t) = @_;
      "++$t";
  }
  
  sub expr_preinc_var {
      my ($self, $v) = @_;
      "++" . $self->var_sigil. $v;
  }
  
  
  sub expr_validator_sub {
      my ($self, %args) = @_;
  
      my $log_result = delete $args{log_result};
      my $dt         = $args{data_term};
      my $vt         = delete($args{var_term}) // $dt;
      my $do_log     = $args{debug_log} // $args{debug};
      my $rt         = $args{return_type} // 'bool';
  
      $args{indent_level} = 1;
  
      my $cd = $self->compile(%args);
      my $et = $cd->{args}{err_term};
  
      if ($rt ne 'bool') {
          my ($ev) = $et =~ /(\w+)/; 
          $self->add_var($cd, $ev, $rt eq 'str' ? undef : {});
      }
      my $resv = '_sahv_res';
      my $rest = $self->var_sigil . $resv;
  
      my $needs_expr_block = @{ $cd->{modules} } || $do_log;
  
      my $code = join(
          "",
          ($self->stmt_require_log_module."\n") x !!$do_log,
          (map { $self->stmt_require_module($_, $cd)."\n" } @{ $cd->{modules} }),
          $self->expr_anon_sub(
              [$vt],
              join(
                  "",
                  (map {$self->stmt_declare_local_var(
                      $_, $self->literal($cd->{vars}{$_}))."\n"}
                       sort keys %{ $cd->{vars} }),
                  $self->stmt_declare_local_var($resv, "\n\n" . $cd->{result})."\n\n",
  
                  ($self->stmt_return($rest)."\n")
                      x !!($rt eq 'bool'),
  
                  ($self->expr_set_err_str($et, $self->literal('')).";",
                   "\n\n".$self->stmt_return($et)."\n")
                      x !!($rt eq 'str'),
  
                  ($self->stmt_return($et)."\n")
                      x !!($rt eq 'full'),
              )
          ),
      );
  
      if ($needs_expr_block) {
          $code = $self->expr_block($code);
      }
  
      if ($log_result && $log->is_trace) {
          require String::LineNumber;
          $log->tracef("validator code:\n%s",
                       ($ENV{LINENUM} // 1) ?
                           String::LineNumber::linenum($code) :
                                 $code);
      }
  
      $code;
  }
  
  sub add_ccl {
      my ($self, $cd, $ccl, $opts) = @_;
      $opts //= {};
      my $clause = $cd->{clause} // "";
      my $op     = $cd->{cl_op} // "";
  
      my $use_dpath = $cd->{args}{return_type} ne 'bool';
  
      my $el = $opts->{err_level} // $cd->{clset}{"$clause.err_level"} // "error";
      my $err_expr = $opts->{err_expr};
      my $err_msg  = $opts->{err_msg};
  
      if (defined $err_expr) {
          $self->add_var($cd, '_sahv_dpath', []) if $use_dpath;
          $err_expr = $self->expr_prefix_dpath($err_expr) if $use_dpath;
      } else {
          unless (defined $err_msg) { $err_msg = $cd->{clset}{"$clause.err_msg"} }
          unless (defined $err_msg) {
  
              my @msgpath = @{$cd->{spath}};
              my $msgpath;
              my $hc  = $cd->{_hc};
              my $hcd = $cd->{_hcd};
              while (1) {
                  last unless @msgpath;
                  $msgpath = join("/", @msgpath);
                  my $ccls = $hcd->{result}{$msgpath};
                  pop @msgpath;
                  if ($ccls) {
                      local $hcd->{args}{format} = 'inline_err_text';
                      $err_msg = $hc->format_ccls($hcd, $ccls);
                      $err_msg = "(msgpath=$msgpath) $err_msg"
                          if $cd->{args}{debug};
                      last;
                  }
              }
              if (!$err_msg) {
                  $err_msg = "ERR (clause=".($cd->{clause} // "").")";
              } else {
                  $err_msg = ucfirst($err_msg);
              }
          }
          if ($err_msg) {
              $self->add_var($cd, '_sahv_dpath', []) if $use_dpath;
              $err_expr = $self->literal($err_msg);
              $err_expr = $self->expr_prefix_dpath($err_expr) if $use_dpath;
          }
      }
  
      my $rt = $cd->{args}{return_type};
      my $et = $cd->{args}{err_term};
      my $err_code;
      if ($rt eq 'full') {
          $self->add_var($cd, '_sahv_dpath', []) if $use_dpath;
          my $k = $el eq 'warn' ? 'warnings' : 'errors';
          $err_code = $self->expr_set_err_full($et, $k, $err_expr) if $err_expr;
      } elsif ($rt eq 'str') {
          if ($el ne 'warn') {
              $err_code = $self->expr_set_err_str($et, $err_expr) if $err_expr;
          }
      }
  
      my $res = {
          ccl             => $ccl,
          err_level       => $el,
          err_code        => $err_code,
          (_debug_ccl_note => $cd->{_debug_ccl_note}) x !!$cd->{_debug_ccl_note},
          subdata         => $opts->{subdata},
      };
      push @{ $cd->{ccls} }, $res;
      delete $cd->{uclset}{"$clause.err_level"};
      delete $cd->{uclset}{"$clause.err_msg"};
  }
  
  sub join_ccls {
      my ($self, $cd, $ccls, $opts) = @_;
      $opts //= {};
      my $op = $opts->{op} // "and";
  
      my ($min_ok, $max_ok, $min_nok, $max_nok);
      if ($op eq 'and') {
          $max_nok = 0;
      } elsif ($op eq 'or') {
          $min_ok = 1;
      } elsif ($op eq 'none') {
          $max_ok = 0;
      } elsif ($op eq 'not') {
  
      }
      my $dmin_ok  = defined($min_ok);
      my $dmax_ok  = defined($max_ok);
      my $dmin_nok = defined($min_nok);
      my $dmax_nok = defined($max_nok);
  
      return "" unless @$ccls;
  
      my $rt      = $cd->{args}{return_type};
      my $vp      = $cd->{args}{var_prefix};
  
      my $aop = $self->logical_and_op;
      my $nop = $self->logical_not_op;
  
      my $true = $self->true;
  
      my $_ice = sub {
          my ($ccl, $which) = @_;
  
          return $self->enclose_paren($ccl->{ccl}) if $ccl->{assert};
  
          my $res = "";
  
          if ($ccl->{_debug_ccl_note}) {
              if ($cd->{args}{debug_log} // $cd->{args}{debug}) {
                  $res .= $self->expr_log(
                      $cd, $self->literal($ccl->{_debug_ccl_note})) . " $aop\n";
              } else {
                  $res .= $self->comment($cd, $ccl->{_debug_ccl_note});
              }
          }
  
          $which //= 0;
          my $cc = ($which == 1 ? $nop:"") . $self->enclose_paren($ccl->{ccl});
          my ($ec, $oec);
          my ($ret, $oret);
          if ($which >= 2) {
              my @chk;
              if ($ccl->{err_level} eq 'warn') {
                  $oret = 1;
                  $ret  = 1;
              } elsif ($ccl->{err_level} eq 'fatal') {
                  $oret = 1;
                  $ret  = 0;
              } else {
                  $oret = $self->expr_preinc_var("${vp}ok");
                  $ret  = $self->expr_preinc_var("${vp}nok");
                  push @chk, $self->expr_var("${vp}ok"). " <= $max_ok"
                      if $dmax_ok;
                  push @chk, $self->expr_var("${vp}nok")." <= $max_nok"
                      if $dmax_nok;
                  if ($which == 3) {
                      push @chk, $self->expr_var("${vp}ok"). " >= $min_ok"
                          if $dmin_ok;
                      push @chk, $self->expr_var("${vp}nok")." >= $min_nok"
                          if $dmin_nok;
  
                      if ($rt ne 'bool') {
                          my $et = $cd->{args}{err_term};
                          my $clerrc;
                          if ($rt eq 'full') {
                              $clerrc = $self->expr_reset_err_full($et);
                          } else {
                              $clerrc = $self->expr_reset_err_str($et);
                          }
                          push @chk, $clerrc;
                      }
                  }
              }
              $res .= "($cc ? $oret : $ret)";
              $res .= " $aop " . join(" $aop ", @chk) if @chk;
          } else {
              $ec = $ccl->{err_code};
              $ret =
                  $ccl->{err_level} eq 'fatal' ? 0 :
                          $ccl->{err_level} eq 'warn' ? 1 : 0;
              if ($rt eq 'bool' && $ret) {
                  $res .= $true;
              } elsif ($rt eq 'bool' || !$ec) {
                  $res .= $self->enclose_paren($cc);
              } else {
                  $res .= $self->enclose_paren(
                      $self->enclose_paren($cc). " ? $true : ($ec,$ret)",
                      "force");
              }
          }
  
          my $use_dpath = $rt ne 'bool' && $ccl->{subdata};
          $res = $self->expr_push_and_pop_dpath_between_expr($res) if $use_dpath;
          $res;
  
      };
  
      my $j = "\n\n$aop\n\n";
      if ($op eq 'not') {
          return $_ice->($ccls->[0], 1);
      } elsif ($op eq 'and') {
          return join $j, map { $_ice->($_) } @$ccls;
      } elsif ($op eq 'none') {
          return join $j, map { $_ice->($_, 1) } @$ccls;
      } else {
          my $jccl = join $j, map {$_ice->($ccls->[$_], $_ == @$ccls-1 ? 3:2)}
              0..@$ccls-1;
          {
              local $cd->{ccls} = [];
              local $cd->{_debug_ccl_note} = "op=$op";
              $self->add_ccl(
                  $cd,
                  $self->expr_block(
                      join(
                          "",
                          $self->stmt_declare_local_var("${vp}ok" , "0"), "\n",
                          $self->stmt_declare_local_var("${vp}nok", "0"), "\n",
                          "\n",
                          $self->block_uses_sub ?
                              $self->stmt_return($jccl) : $jccl,
                      )
                  ),
              );
              $_ice->($cd->{ccls}[0]);
          }
      }
  }
  
  sub before_compile {
      my ($self, $cd) = @_;
  
      if ($cd->{args}{data_term_is_lvalue}) {
          $cd->{data_term} = $cd->{args}{data_term};
      } else {
          my $v = $cd->{args}{var_prefix} . $cd->{args}{data_name};
          push @{ $cd->{vars} }, $v; 
          $cd->{data_term} = $self->var_sigil . $v;
          push @{ $cd->{ccls} }, ["(local($cd->{data_term} = $cd->{args}{data_term}), 1)"];
      }
  }
  
  sub before_handle_type {
      my ($self, $cd) = @_;
  
  
      unless ($cd->{_inner}) {
          my $hc = $cd->{_hc};
          my %hargs = %{$cd->{args}};
          $hargs{format}               = 'msg_catalog';
          $hargs{schema_is_normalized} = 1;
          $hargs{schema}               = $cd->{nschema};
          $hargs{on_unhandled_clause}  = 'ignore';
          $hargs{on_unhandled_attr}    = 'ignore';
          $cd->{_hcd} = $hc->compile(%hargs);
      }
  }
  
  sub before_all_clauses {
      my ($self, $cd) = @_;
  
  
      my $dt     = $cd->{data_term};
      my $clsets = $cd->{clsets};
  
      for my $i (0..@$clsets-1) {
          my $clset  = $clsets->[$i];
          next unless exists $clset->{ok};
          my $op = $clset->{"ok.op"} // "";
          if ($op && $op ne 'not') {
              $self->_die($cd, "ok can only be combined with .op=not");
          }
          if ($op eq 'not') {
              local $cd->{_debug_ccl_note} = "!ok #$i";
              $self->add_ccl($cd, $self->false);
          } else {
              local $cd->{_debug_ccl_note} = "ok #$i";
              $self->add_ccl($cd, $self->true);
          }
          delete $cd->{uclsets}[$i]{"ok"};
          delete $cd->{uclsets}[$i]{"ok.is_expr"};
      }
  
      for my $i (0..@$clsets-1) {
          my $clset  = $clsets->[$i];
          my $def    = $clset->{default};
          my $defie  = $clset->{"default.is_expr"};
          if (defined $def) {
              local $cd->{_debug_ccl_note} = "default #$i";
              my $ct = $defie ?
                  $self->expr($def) : $self->literal($def);
              $self->add_ccl(
                  $cd,
                  "(".$self->expr_setif($dt, $ct).", ".$self->true.")",
                  {err_msg => ""},
              );
          }
          delete $cd->{uclsets}[$i]{"default"};
          delete $cd->{uclsets}[$i]{"default.is_expr"};
      }
  
  
      my $has_req;
      for my $i (0..@$clsets-1) {
          my $clset  = $clsets->[$i];
          my $req    = $clset->{req};
          my $reqie  = $clset->{"req.is_expr"};
          my $req_err_msg = $self->_xlt($cd, "Required but not specified");
          local $cd->{_debug_ccl_note} = "req #$i";
          if ($req && !$reqie) {
              $has_req++;
              $self->add_ccl(
                  $cd, $self->expr_defined($dt),
                  {
                      err_msg   => $req_err_msg,
                      err_level => 'fatal',
                  },
              );
          } elsif ($reqie) {
              $has_req++;
              my $ct = $self->expr($req);
              $self->add_ccl(
                  $cd, "!($ct) || ".$self->expr_defined($dt),
                  {
                      err_msg   => $req_err_msg,
                      err_level => 'fatal',
                  },
              );
          }
          delete $cd->{uclsets}[$i]{"req"};
          delete $cd->{uclsets}[$i]{"req.is_expr"};
      }
  
      my $has_fbd;
      for my $i (0..@$clsets-1) {
          my $clset  = $clsets->[$i];
          my $fbd    = $clset->{forbidden};
          my $fbdie  = $clset->{"forbidden.is_expr"};
          my $fbd_err_msg = $self->_xlt($cd, "Forbidden but specified");
          local $cd->{_debug_ccl_note} = "forbidden #$i";
          if ($fbd && !$fbdie) {
              $has_fbd++;
              $self->add_ccl(
                  $cd, "!".$self->expr_defined($dt),
                  {
                      err_msg   => $fbd_err_msg,
                      err_level => 'fatal',
                  },
              );
          } elsif ($fbdie) {
              $has_fbd++;
              my $ct = $self->expr($fbd);
              $self->add_ccl(
                  $cd, "!($ct) || !".$self->expr_defined($dt),
                  {
                      err_msg   => $fbd_err_msg,
                      err_level => 'fatal',
                  },
              );
          }
          delete $cd->{uclsets}[$i]{"forbidden"};
          delete $cd->{uclsets}[$i]{"forbidden.is_expr"};
      }
  
      if (!$has_req && !$has_fbd) {
          $cd->{_skip_undef} = 1;
          $cd->{_ccls_idx1} = @{$cd->{ccls}};
      }
  
  
      $self->_die($cd, "BUG: type handler did not produce _ccl_check_type")
          unless defined($cd->{_ccl_check_type});
      local $cd->{_debug_ccl_note} = "check type '$cd->{type}'";
      $self->add_ccl(
          $cd, $cd->{_ccl_check_type},
          {
              err_msg   => sprintf(
                  $self->_xlt($cd, "Not of type %s"),
                  $self->_xlt(
                      $cd,
                      $cd->{_hc}->get_th(name=>$cd->{type})->name //
                          $cd->{type}
                      ),
              ),
              err_level => 'fatal',
          },
      );
  }
  
  sub before_clause {
      my ($self, $cd) = @_;
  
      $self->_die($cd, "Sorry, .op + .is_expr not yet supported ".
                      "(found in clause $cd->{clause})")
          if $cd->{cl_is_expr} && $cd->{cl_op};
  
      if ($cd->{args}{debug}) {
          state $json = do {
              require JSON;
              JSON->new->allow_nonref;
          };
          my $clset = $cd->{clset};
          my $cl    = $cd->{clause};
          my $res   = $json->encode({
              map { $_ => $clset->{$_}}
                  grep {/\A\Q$cl\E(?:\.|\z)/}
                      keys %$clset });
          $res =~ s/\n+/ /g;
          $cd->{_debug_ccl_note} = "clause: $res";
      } else {
          $cd->{_debug_ccl_note} = "clause: $cd->{clause}";
      }
  
  
      push @{ $cd->{_save_ccls} }, $cd->{ccls};
      $cd->{ccls} = [];
  }
  
  sub after_clause {
      my ($self, $cd) = @_;
  
      if ($cd->{args}{debug}) {
          delete $cd->{_debug_ccl_note};
      }
  
      my $save = pop @{ $cd->{_save_ccls} };
      if (@{ $cd->{ccls} }) {
          push @$save, {
              ccl       => $self->join_ccls($cd, $cd->{ccls}, {op=>$cd->{cl_op}}),
              err_level => $cd->{clset}{"$cd->{clause}.err_level"} // "error",
          }
      }
      $cd->{ccls} = $save;
  }
  
  sub after_clause_sets {
      my ($self, $cd) = @_;
  
      $cd->{result} = $self->indent(
          $cd,
          $self->join_ccls($cd, $cd->{ccls}, {err_msg => ''}),
      );
  }
  
  sub after_all_clauses {
      my ($self, $cd) = @_;
  
      if (delete $cd->{_skip_undef}) {
          my $jccl = $self->join_ccls(
              $cd,
              [splice(@{ $cd->{ccls} }, $cd->{_ccls_idx1})],
          );
          local $cd->{_debug_ccl_note} = "skip if undef";
          $self->add_ccl(
              $cd,
              "!".$self->expr_defined($cd->{data_term})." ? ".$self->true." : \n\n".
                  $self->enclose_paren($jccl),
              {err_msg => ''},
          );
      }
  
      $cd->{result} = $self->indent(
          $cd,
          $self->join_ccls($cd, $cd->{ccls}, {err_msg => ''}),
      );
  }
  
  1;
  
  __END__
  
DATA_SAH_COMPILER_PROG

$fatpacked{"Data/Sah/Compiler/Prog/TH.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'DATA_SAH_COMPILER_PROG_TH';
  package Data::Sah::Compiler::Prog::TH;
  
  our $DATE = '2015-04-14'; 
  our $VERSION = '0.51'; 
  
  use 5.010;
  use strict;
  use warnings;
  
  use Mo qw(build default);
  
  extends 'Data::Sah::Compiler::TH';
  
  
  sub clause_default {}
  sub clause_ok {}
  sub clause_req {}
  sub clause_forbidden {}
  sub clause_prefilters {}
  
  
  
  sub clause_name {
      my ($self, $cd) = @_;
      $self->compiler->_ignore_clause_and_attrs($cd);
  }
  
  sub clause_summary {
      my ($self, $cd) = @_;
      $self->compiler->_ignore_clause_and_attrs($cd);
  }
  
  sub clause_description {
      my ($self, $cd) = @_;
      $self->compiler->_ignore_clause_and_attrs($cd);
  }
  
  sub clause_comment {
      my ($self, $cd) = @_;
      $self->compiler->_ignore_clause($cd);
  }
  
  sub clause_tags {
      my ($self, $cd) = @_;
      $self->compiler->_ignore_clause($cd);
  }
  
  sub clause_defhash_v {
      my ($self, $cd) = @_;
      $self->compiler->_ignore_clause($cd);
  }
  
  sub clause_v {
      my ($self, $cd) = @_;
      $self->compiler->_ignore_clause($cd);
  }
  
  sub set_tmp_data_term {
      my ($self, $cd, $expr) = @_;
      my $c = $self->compiler;
  
      my $tdn = $cd->{args}{tmp_data_name};
      my $tdt = $cd->{args}{tmp_data_term};
      my $t = $c->expr_array_subscript($tdt, $cd->{_subdata_level});
      unless ($cd->{_save_data_term}) {
          $c->add_var($cd, $tdn, []);
          $cd->{_save_data_term} = $cd->{data_term};
          $cd->{data_term} = $t;
      }
      local $cd->{_debug_ccl_note} = 'set temporary data term';
      $c->add_ccl($cd, "(".$c->expr_assign($t, $expr). ", ".$c->true.")");
  }
  
  sub restore_data_term {
      my ($self, $cd) = @_;
      my $c = $self->compiler;
  
      my $tdt = $cd->{args}{tmp_data_term};
      if ($cd->{_save_data_term}) {
          $cd->{data_term} = delete($cd->{_save_data_term});
          local $cd->{_debug_ccl_note} = 'restore original data term';
          $c->add_ccl($cd, "(".$c->expr_pop($tdt). ", ".$c->true.")");
      }
  }
  
  sub gen_any_or_all_of {
      my ($self, $which, $cd) = @_;
      my $c  = $self->compiler;
      my $cv = $cd->{cl_value};
      my $dt = $cd->{data_term};
  
      my $jccl;
      {
          local $cd->{ccls} = [];
          for my $i (0..@$cv-1) {
              local $cd->{spath} = [@{ $cd->{spath} }, $i];
              my $sch  = $cv->[$i];
              my %iargs = %{$cd->{args}};
              $iargs{outer_cd}             = $cd;
              $iargs{schema}               = $sch;
              $iargs{schema_is_normalized} = 0;
              $iargs{indent_level}++;
              my $icd  = $c->compile(%iargs);
              my @code = (
                  $icd->{result},
              );
              $c->add_ccl($cd, join("", @code));
          }
          if ($which eq 'all') {
              $jccl = $c->join_ccls(
                  $cd, $cd->{ccls}, {err_msg=>''});
          } else {
              $jccl = $c->join_ccls(
                  $cd, $cd->{ccls}, {err_msg=>'', op=>'or'});
          }
      }
      $c->add_ccl($cd, $jccl);
  }
  
  1;
  
  __END__
  
DATA_SAH_COMPILER_PROG_TH

$fatpacked{"Data/Sah/Compiler/Prog/TH/all.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'DATA_SAH_COMPILER_PROG_TH_ALL';
  package Data::Sah::Compiler::Prog::TH::all;
  
  our $DATE = '2015-04-14'; 
  our $VERSION = '0.51'; 
  
  use 5.010;
  use strict;
  use warnings;
  
  use Mo qw(build default);
  use Role::Tiny::With;
  
  extends 'Data::Sah::Compiler::Prog::TH';
  with 'Data::Sah::Type::all';
  
  sub handle_type {
      my ($self, $cd) = @_;
      my $c = $self->compiler;
  
      my $dt = $cd->{data_term};
      $cd->{_ccl_check_type} = $c->true;
  }
  
  sub clause_of {
      my ($self, $cd) = @_;
      $self->gen_any_or_all_of("all", $cd);
  }
  
  1;
  
  __END__
  
DATA_SAH_COMPILER_PROG_TH_ALL

$fatpacked{"Data/Sah/Compiler/Prog/TH/any.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'DATA_SAH_COMPILER_PROG_TH_ANY';
  package Data::Sah::Compiler::Prog::TH::any;
  
  our $DATE = '2015-04-14'; 
  our $VERSION = '0.51'; 
  
  use 5.010;
  use strict;
  use warnings;
  
  use Mo qw(build default);
  use Role::Tiny::With;
  
  extends 'Data::Sah::Compiler::js::TH';
  with 'Data::Sah::Type::any';
  
  sub handle_type {
      my ($self, $cd) = @_;
      my $c = $self->compiler;
  
      my $dt = $cd->{data_term};
      $cd->{_ccl_check_type} = $c->true;
  }
  
  sub clause_of {
      my ($self, $cd) = @_;
      $self->gen_any_or_all_of("any", $cd);
  }
  
  1;
  
  __END__
  
DATA_SAH_COMPILER_PROG_TH_ANY

$fatpacked{"Data/Sah/Compiler/TH.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'DATA_SAH_COMPILER_TH';
  package Data::Sah::Compiler::TH;
  
  our $DATE = '2015-04-14'; 
  our $VERSION = '0.51'; 
  
  use 5.010;
  use strict;
  use warnings;
  use Mo qw(build default);
  
  has compiler => (is => 'rw');
  
  sub clause_v {
      my ($self, $cd) = @_;
      $self->compiler->_ignore_clause($cd);
  }
  
  sub clause_default_lang {
      my ($self, $cd) = @_;
      $self->compiler->_ignore_clause($cd);
  }
  
  sub clause_clause {
      my ($self, $cd) = @_;
      my $c  = $self->compiler;
      my $cv = $cd->{cl_value};
  
      my ($clause, $clv) = @$cv;
      my $meth   = "clause_$clause";
      my $mmeth  = "clausemeta_$clause";
  
      my $clsets = [{$clause => $clv}];
      local $cd->{clsets} = $clsets;
  
      $c->_process_clause($cd, 0, $clause);
  }
  
  
  sub clause_clset {
      my ($self, $cd) = @_;
      my $c  = $self->compiler;
      my $cv = $cd->{cl_value};
  
      local $cd->{clsets} = [$cv];
      $c->_process_clsets($cd, 'from clause_clset');
  }
  
  1;
  
  __END__
  
DATA_SAH_COMPILER_TH

$fatpacked{"Data/Sah/Compiler/TextResultRole.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'DATA_SAH_COMPILER_TEXTRESULTROLE';
  package Data::Sah::Compiler::TextResultRole;
  
  our $DATE = '2015-04-14'; 
  our $VERSION = '0.51'; 
  
  use 5.010;
  use strict;
  use warnings;
  
  use Mo qw(default);
  use Role::Tiny;
  
  use String::Indent ();
  
  has indent_character => (is => 'rw', default => sub {''});
  
  sub add_result {
      my ($self, $cd, @args) = @_;
  
      $cd->{result} //= [];
      push @{ $cd->{result} }, $self->indent($cd, join("", @args));
      $self;
  }
  
  sub indent {
      my ($self, $cd, $str) = @_;
      String::Indent::indent(
          $self->indent_character x $cd->{indent_level},
          $str,
      );
  }
  
  sub inc_indent {
      my ($self, $cd) = @_;
      $cd->{indent_level}++;
  }
  
  sub dec_indent {
      my ($self, $cd) = @_;
      $cd->{indent_level}--;
  }
  
  sub indent_str {
      my ($self, $cd) = @_;
      $self->indent_character x $cd->{indent_level};
  }
  
  1;
  
  __END__
  
DATA_SAH_COMPILER_TEXTRESULTROLE

$fatpacked{"Data/Sah/Compiler/human.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'DATA_SAH_COMPILER_HUMAN';
  package Data::Sah::Compiler::human;
  
  our $DATE = '2015-04-14'; 
  our $VERSION = '0.51'; 
  
  use 5.010;
  use strict;
  use warnings;
  
  use Data::Dmp qw(dmp);
  use Mo qw(build default);
  use POSIX qw(locale_h);
  use Text::sprintfn;
  
  extends 'Data::Sah::Compiler';
  
  our %typex; 
  
  sub name { "human" }
  
  sub _add_msg_catalog {
      my ($self, $cd, $msg) = @_;
      return unless $cd->{args}{format} eq 'msg_catalog';
  
      my $spath = join("/", @{ $cd->{spath} });
      $cd->{_msg_catalog}{$spath} = $msg;
  }
  
  sub check_compile_args {
      use experimental 'smartmatch';
  
      my ($self, $args) = @_;
  
      $self->SUPER::check_compile_args($args);
  
      my @fmts = ('inline_text', 'inline_err_text', 'markdown', 'msg_catalog');
      $args->{format} //= $fmts[0];
      unless ($args->{format} ~~ @fmts) {
          $self->_die({}, "Unsupported format, use one of: ".join(", ", @fmts));
      }
  }
  
  sub init_cd {
      my ($self, %args) = @_;
  
      my $cd = $self->SUPER::init_cd(%args);
      if ($cd->{args}{format} eq 'msg_catalog') {
          $cd->{_msg_catalog} //= $cd->{outer_cd}{_msg_catalog};
          $cd->{_msg_catalog} //= {};
      }
      $cd;
  }
  
  sub expr {
      my ($self, $cd, $expr) = @_;
  
  
      $expr;
  }
  
  sub literal {
      my ($self, $val) = @_;
  
      return $val unless ref($val);
      dmp($val);
  }
  
  sub _xlt {
      my ($self, $cd, $text) = @_;
  
      my $lang = $cd->{args}{lang};
  
  
      return $text if $lang eq 'en_US';
      my $translations;
      {
          no strict 'refs';
          $translations = \%{"Data::Sah::Lang::$lang\::translations"};
      }
      return $translations->{$text} if defined($translations->{$text});
      if ($cd->{args}{mark_missing_translation}) {
          return "(no $lang text:$text)";
      } else {
          return $text;
      }
  }
  
  sub _ordinate {
      my ($self, $cd, $n, $noun) = @_;
  
      my $lang = $cd->{args}{lang};
  
  
      if ($lang eq 'en_US') {
          require Lingua::EN::Numbers::Ordinate;
          return Lingua::EN::Numbers::Ordinate::ordinate($n) . " $noun";
      } else {
          no strict 'refs';
          return "Data::Sah::Lang::$lang\::ordinate"->($n, $noun);
      }
  }
  
  sub add_ccl {
      use experimental 'smartmatch';
  
      my ($self, $cd, $ccl) = @_;
  
      $ccl->{xlt} //= 1;
  
      my $clause = $cd->{clause} // "";
      $ccl->{type} //= "clause";
  
      my $do_xlt = 1;
  
      my $hvals = {
          modal_verb     => $self->_xlt($cd, "must"),,
          modal_verb_neg => $self->_xlt($cd, "must not"),
      };
      my $mod="";
  
  
      {
          my $lang   = $cd->{args}{lang};
          my $dlang  = $cd->{clset_dlang} // "en_US"; 
          my $suffix = $lang eq $dlang ? "" : ".alt.lang.$lang";
          if ($clause) {
              delete $cd->{uclset}{$_} for
                  grep /\A\Q$clause.human\E(\.|\z)/, keys %{$cd->{uclset}};
              if (defined $cd->{clset}{"$clause.human$suffix"}) {
                  $ccl->{type} = 'clause';
                  $ccl->{fmt}  = $cd->{clset}{"$clause.human$suffix"};
                  goto FILL_FORMAT;
              }
          } else {
              delete $cd->{uclset}{$_} for
                  grep /\A\.name(\.|\z)/, keys %{$cd->{uclset}};
              if (defined $cd->{clset}{".name$suffix"}) {
                  $ccl->{type} = 'noun';
                  $ccl->{fmt}  = $cd->{clset}{".name$suffix"};
                  $ccl->{vals} = undef;
                  goto FILL_FORMAT;
              }
          }
      }
  
      goto TRANSLATE unless $clause;
  
      my $ie   = $cd->{cl_is_expr};
      my $im   = $cd->{cl_is_multi};
      my $op   = $cd->{cl_op} // "";
      my $cv   = $cd->{clset}{$clause};
      my $vals = $ccl->{vals} // [$cv];
  
  
      if ($ie) {
          if (!$ccl->{expr}) {
              $ccl->{fmt} = "($clause -> %s" . ($op ? " op=$op" : "") . ")";
              $do_xlt = 0;
              $vals = [$self->expr($cd, $vals)];
          }
          goto ERR_LEVEL;
      }
  
  
      if ($op eq 'not') {
          ($hvals->{modal_verb}, $hvals->{modal_verb_neg}) =
              ($hvals->{modal_verb_neg}, $hvals->{modal_verb});
      } elsif ($im && $op eq 'and') {
          if (@$cv == 2) {
              $vals = [sprintf($self->_xlt($cd, "%s and %s"),
                               $self->literal($cv->[0]),
                               $self->literal($cv->[1]))];
          } else {
              $vals = [sprintf($self->_xlt($cd, "all of %s"),
                               $self->literal($cv))];
          }
      } elsif ($im && $op eq 'or') {
          if (@$cv == 2) {
              $vals = [sprintf($self->_xlt($cd, "%s or %s"),
                               $self->literal($cv->[0]),
                               $self->literal($cv->[1]))];
          } else {
              $vals = [sprintf($self->_xlt($cd, "one of %s"),
                               $self->literal($cv))];
          }
      } elsif ($im && $op eq 'none') {
          ($hvals->{modal_verb}, $hvals->{modal_verbneg}) =
              ($hvals->{modal_verb_neg}, $hvals->{modal_verb});
          if (@$cv == 2) {
              $vals = [sprintf($self->_xlt($cd, "%s nor %s"),
                               $self->literal($cv->[0]),
                               $self->literal($cv->[1]))];
          } else {
              $vals = [sprintf($self->_xlt($cd, "any of %s"),
                               $self->literal($cv))];
          }
      } else {
          $vals = [map {$self->literal($_)} @$vals];
      }
  
    ERR_LEVEL:
  
      if ($ccl->{type} eq 'clause' && 'constraint' ~~ $cd->{cl_meta}{tags}) {
          if (($cd->{clset}{"$clause.err_level"}//'error') eq 'warn') {
              if ($op eq 'not') {
                  $hvals->{modal_verb}     = $self->_xlt($cd, "should not");
                  $hvals->{modal_verb_neg} = $self->_xlt($cd, "should");
              } else {
                  $hvals->{modal_verb}     = $self->_xlt($cd, "should");
                  $hvals->{modal_verb_neg} = $self->_xlt($cd, "should not");
              }
          }
      }
      delete $cd->{uclset}{"$clause.err_level"};
  
    TRANSLATE:
  
      if ($ccl->{xlt}) {
          if (ref($ccl->{fmt}) eq 'ARRAY') {
              $ccl->{fmt}  = [map {$self->_xlt($cd, $_)} @{$ccl->{fmt}}];
          } elsif (!ref($ccl->{fmt})) {
              $ccl->{fmt}  = $self->_xlt($cd, $ccl->{fmt});
          }
      }
  
    FILL_FORMAT:
  
      if (ref($ccl->{fmt}) eq 'ARRAY') {
          $ccl->{text} = [map {sprintfn($_, (map {$_//""} ($hvals, @$vals)))}
                              @{$ccl->{fmt}}];
      } elsif (!ref($ccl->{fmt})) {
          $ccl->{text} = sprintfn($ccl->{fmt}, (map {$_//""} ($hvals, @$vals)));
      }
      delete $ccl->{fmt} unless $cd->{args}{debug};
  
      push @{$cd->{ccls}}, $ccl;
  
      $self->_add_msg_catalog($cd, $ccl);
  }
  
  sub format_ccls {
      my ($self, $cd, $ccls) = @_;
  
      local $cd->{_fmt_noun_count} = 0;
      local $cd->{_fmt_etc_count} = 0;
  
      my $f = $cd->{args}{format};
      my $res;
      if ($f eq 'inline_text' || $f eq 'inline_err_text' || $f eq 'msg_catalog') {
          $res = $self->_format_ccls_itext($cd, $ccls);
          if ($f eq 'inline_err_text') {
              if ($cd->{_fmt_noun_count} == 1 && $cd->{_fmt_etc_count} == 0) {
                  $res = sprintf(
                      $self->_xlt($cd, "Not of type %s"),
                      $res
                  );
              } elsif (!$cd->{_fmt_noun_count}) {
              } else {
                  $res = sprintf(
                      $self->_xlt(
                          $cd, "Does not satisfy the following schema: %s"),
                      $res
                  );
              }
          }
      } else {
          $res = $self->_format_ccls_markdown($cd, $ccls);
      }
      $res;
  }
  
  sub _format_ccls_itext {
      my ($self, $cd, $ccls) = @_;
  
      local $cd->{args}{mark_missing_translation} = 0;
      my $c_comma = $self->_xlt($cd, ", ");
  
      if (ref($ccls) eq 'HASH' && $ccls->{type} =~ /^(noun|clause)$/) {
          if ($ccls->{type} eq 'noun') {
              $cd->{_fmt_noun_count}++;
          } else {
              $cd->{_fmt_etc_count}++;
          }
          my $ccl = $ccls;
          return ref($ccl->{text}) eq 'ARRAY' ? $ccl->{text}[0] : $ccl->{text};
      } elsif (ref($ccls) eq 'HASH' && $ccls->{type} eq 'list') {
          my $c_openpar  = $self->_xlt($cd, "(");
          my $c_closepar = $self->_xlt($cd, ")");
          my $c_colon    = $self->_xlt($cd, ": ");
          my $ccl = $ccls;
  
          my $txt = $ccl->{text}; $txt =~ s/\s+$//;
          my @t = ($txt, $c_colon);
          my $i = 0;
          for (@{ $ccl->{items} }) {
              push @t, $c_comma if $i;
              my $it = $self->_format_ccls_itext($cd, $_);
              if ($it =~ /\Q$c_comma/) {
                  push @t, $c_openpar, $it, $c_closepar;
              } else {
                  push @t, $it;
              }
              $i++;
          }
          return join("", @t);
      } elsif (ref($ccls) eq 'ARRAY') {
          return join($c_comma, map {$self->_format_ccls_itext($cd, $_)} @$ccls);
      } else {
          $self->_die($cd, "Can't format $ccls");
      }
  }
  
  sub _format_ccls_markdown {
      my ($self, $cd, $ccls) = @_;
  
      $self->_die($cd, "Sorry, markdown not yet implemented");
  }
  
  sub _load_lang_modules {
      my ($self, $cd) = @_;
  
      my $lang = $cd->{args}{lang};
      die "Invalid language '$lang', please use letters only"
          unless $lang =~ /\A\w+\z/;
  
      my @modp;
      unless ($lang eq 'en_US') {
          push @modp, "Data/Sah/Lang/$lang.pm";
          for my $cl (@{ $typex{$cd->{type}} // []}) {
              my $modp = "Data/Sah/Lang/$lang/TypeX/$cd->{type}/$cl.pm";
              $modp =~ s!::!/!g; 
              push @modp, $modp;
          }
      }
      my $i;
      for my $modp (@modp) {
          $i++;
          unless (exists $INC{$modp}) {
              if ($i == 1) {
                  require Module::Path::More;
                  my $mod = $modp; $mod =~ s/\.pm$//;
                  if (!Module::Path::More::module_path(module=>$modp)) {
                      $cd->{args}{lang} = 'en_US';
                      last;
                  }
              }
              require $modp;
  
              $INC{$modp} = undef;
          }
      }
  }
  
  sub before_compile {
      my ($self, $cd) = @_;
  
      $cd->{_orig_locale} = setlocale(LC_ALL);
  
      my $res = setlocale(LC_ALL, $cd->{args}{locale} // $cd->{args}{lang});
      warn "Unsupported locale $cd->{args}{lang}"
          if $cd->{args}{debug} && !defined($res);
  }
  
  sub before_handle_type {
      my ($self, $cd) = @_;
  
      $self->_load_lang_modules($cd);
  }
  
  sub before_clause {
      my ($self, $cd) = @_;
  
      $cd->{CLAUSE_DO_MULTI} = 1;
  }
  
  sub after_clause {
      my ($self, $cd) = @_;
  
      delete $cd->{CLAUSE_DO_MULTI};
  }
  
  sub after_all_clauses {
      use experimental 'smartmatch';
  
      my ($self, $cd) = @_;
  
  
  
      $cd->{result} = $self->format_ccls($cd, $cd->{ccls});
  }
  
  sub after_compile {
      my ($self, $cd) = @_;
  
      setlocale(LC_ALL, $cd->{_orig_locale});
  
      if ($cd->{args}{format} eq 'msg_catalog') {
          $cd->{result} = $cd->{_msg_catalog};
      }
  }
  
  1;
  
  __END__
  
DATA_SAH_COMPILER_HUMAN

$fatpacked{"Data/Sah/Compiler/human/TH.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'DATA_SAH_COMPILER_HUMAN_TH';
  package Data::Sah::Compiler::human::TH;
  
  our $DATE = '2015-04-14'; 
  our $VERSION = '0.51'; 
  
  use 5.010;
  use strict;
  use warnings;
  
  use Mo qw(build default);
  use Role::Tiny::With;
  
  extends 'Data::Sah::Compiler::TH';
  
  sub name { undef }
  
  sub handle_type {
      my ($self, $cd) = @_;
      my $c = $self->compiler;
  
      my $pkg = ref($self);
      $pkg =~ s/^Data::Sah::Compiler::human::TH:://;
  
      $c->add_ccl($cd, {type=>'noun', fmt=>$pkg});
  }
  
  
  sub clause_name {}
  sub clause_summary {}
  sub clause_description {}
  sub clause_comment {}
  sub clause_tags {}
  
  sub clause_prefilters {}
  sub clause_postfilters {}
  
  
  sub clause_ok {}
  
  
  sub clause_req {}
  sub clause_forbidden {}
  
  
  sub clause_default {
      my ($self, $cd) = @_;
      my $c = $self->compiler;
  
      $c->add_ccl($cd, {expr=>1,
                        fmt => 'default value %s'});
  }
  
  sub before_clause_clause {
      my ($self, $cd) = @_;
      $cd->{CLAUSE_DO_MULTI} = 0;
  }
  
  sub before_clause_clset {
      my ($self, $cd) = @_;
      $cd->{CLAUSE_DO_MULTI} = 0;
  }
  
  1;
  
  __END__
  
DATA_SAH_COMPILER_HUMAN_TH

$fatpacked{"Data/Sah/Compiler/human/TH/Comparable.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'DATA_SAH_COMPILER_HUMAN_TH_COMPARABLE';
  package Data::Sah::Compiler::human::TH::Comparable;
  
  our $DATE = '2015-04-14'; 
  our $VERSION = '0.51'; 
  
  use 5.010;
  use strict;
  use warnings;
  
  use Mo qw(build default);
  use Role::Tiny;
  use Role::Tiny::With;
  
  with 'Data::Sah::Type::Comparable';
  
  sub superclause_comparable {
      my ($self, $which, $cd) = @_;
      my $c = $self->compiler;
  
      my $fmt;
      if ($which eq 'is') {
          $c->add_ccl($cd, {expr=>1, multi=>1,
                            fmt => '%(modal_verb)s have the value %s'});
      } elsif ($which eq 'in') {
          $c->add_ccl($cd, {expr=>1, multi=>1,
                            fmt => '%(modal_verb)s be one of %s'});
      }
  }
  1;
  
  __END__
  
DATA_SAH_COMPILER_HUMAN_TH_COMPARABLE

$fatpacked{"Data/Sah/Compiler/human/TH/HasElems.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'DATA_SAH_COMPILER_HUMAN_TH_HASELEMS';
  package Data::Sah::Compiler::human::TH::HasElems;
  
  our $DATE = '2015-04-14'; 
  our $VERSION = '0.51'; 
  
  use 5.010;
  use strict;
  use warnings;
  
  use Mo qw(build default);
  use Role::Tiny;
  use Role::Tiny::With;
  
  with 'Data::Sah::Type::HasElems';
  
  sub before_clause {
      my ($self_th, $which, $cd) = @_;
  }
  
  sub before_clause_len_between {
      my ($self, $cd) = @_;
      $cd->{CLAUSE_DO_MULTI} = 0;
  }
  
  sub superclause_has_elems {
      my ($self_th, $which, $cd) = @_;
      my $c  = $self_th->compiler;
      my $cv = $cd->{cl_value};
  
      if ($which eq 'len') {
          $c->add_ccl($cd, {
              expr  => 1,
              fmt   => q[length %(modal_verb)s be %s],
          });
      } elsif ($which eq 'min_len') {
          $c->add_ccl($cd, {
              expr  => 1,
              fmt   => q[length %(modal_verb)s be at least %s],
          });
      } elsif ($which eq 'max_len') {
          $c->add_ccl($cd, {
              expr  => 1,
              fmt   => q[length %(modal_verb)s be at most %s],
          });
      } elsif ($which eq 'len_between') {
          $c->add_ccl($cd, {
              fmt   => q[length %(modal_verb)s be between %s and %s],
              vals  => $cv,
          });
      } elsif ($which eq 'has') {
          $c->add_ccl($cd, {
              expr=>1, multi=>1,
              fmt => "%(modal_verb)s have %s in its elements"});
      } elsif ($which eq 'each_index') {
          $self_th->clause_each_index($cd);
      } elsif ($which eq 'each_elem') {
          $self_th->clause_each_elem($cd);
      } elsif ($which eq 'check_each_index') {
          $self_th->compiler->_die_unimplemented_clause($cd);
      } elsif ($which eq 'check_each_elem') {
          $self_th->compiler->_die_unimplemented_clause($cd);
      } elsif ($which eq 'uniq') {
          $self_th->compiler->_die_unimplemented_clause($cd);
      } elsif ($which eq 'exists') {
          $self_th->compiler->_die_unimplemented_clause($cd);
      }
  }
  
  1;
  
  __END__
  
DATA_SAH_COMPILER_HUMAN_TH_HASELEMS

$fatpacked{"Data/Sah/Compiler/human/TH/Sortable.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'DATA_SAH_COMPILER_HUMAN_TH_SORTABLE';
  package Data::Sah::Compiler::human::TH::Sortable;
  
  our $DATE = '2015-04-14'; 
  our $VERSION = '0.51'; 
  
  use 5.010;
  use strict;
  use warnings;
  
  use Mo qw(build default);
  use Role::Tiny;
  use Role::Tiny::With;
  
  with 'Data::Sah::Type::Sortable';
  
  sub before_clause_between {
      my ($self, $cd) = @_;
      $cd->{CLAUSE_DO_MULTI} = 0;
  }
  
  sub before_clause_xbetween {
      my ($self, $cd) = @_;
      $cd->{CLAUSE_DO_MULTI} = 0;
  }
  
  sub superclause_sortable {
      my ($self, $which, $cd) = @_;
      my $c = $self->compiler;
      my $cv = $cd->{cl_value};
  
      if ($which eq 'min') {
          $c->add_ccl($cd, {
              expr=>1,
              fmt => '%(modal_verb)s be at least %s',
          });
      } elsif ($which eq 'xmin') {
          $c->add_ccl($cd, {
              expr=>1,
              fmt => '%(modal_verb)s be larger than %s',
          });
      } elsif ($which eq 'max') {
          $c->add_ccl($cd, {
              expr=>1,
              fmt => '%(modal_verb)s be at most %s',
          });
      } elsif ($which eq 'xmax') {
          $c->add_ccl($cd, {
              expr=>1,
              fmt => '%(modal_verb)s be smaller than %s',
          });
      } elsif ($which eq 'between') {
          $c->add_ccl($cd, {
              fmt => '%(modal_verb)s be between %s and %s',
              vals => $cv,
          });
      } elsif ($which eq 'xbetween') {
          $c->add_ccl($cd, {
              fmt => '%(modal_verb)s be larger than %s and smaller than %s',
              vals => $cv,
          });
      }
  }
  
  1;
  
  __END__
  
DATA_SAH_COMPILER_HUMAN_TH_SORTABLE

$fatpacked{"Data/Sah/Compiler/human/TH/all.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'DATA_SAH_COMPILER_HUMAN_TH_ALL';
  package Data::Sah::Compiler::human::TH::all;
  
  our $DATE = '2015-04-14'; 
  our $VERSION = '0.51'; 
  
  use 5.010;
  use strict;
  use warnings;
  
  use Mo qw(build default);
  use Role::Tiny::With;
  
  extends 'Data::Sah::Compiler::human::TH';
  with 'Data::Sah::Type::all';
  
  sub handle_type {
  }
  
  sub clause_of {
      my ($self, $cd) = @_;
      my $c  = $self->compiler;
      my $cv = $cd->{cl_value};
  
      my @result;
      my $i = 0;
      for my $cv2 (@$cv) {
          local $cd->{spath} = [@{$cd->{spath}}, $i];
          my %iargs = %{$cd->{args}};
          $iargs{outer_cd}             = $cd;
          $iargs{schema}               = $cv2;
          $iargs{schema_is_normalized} = 0;
          my $icd = $c->compile(%iargs);
          push @result, $icd->{ccls};
          $c->_add_msg_catalog($cd, $icd->{ccls});
          $i++;
      }
  
      my $can = 1;
      for my $r (@result) {
          unless (@$r == 1 && $r->[0]{type} eq 'noun') {
              $can = 0;
              last;
          }
      }
  
      my $vals;
      if ($can) {
          my $c0  = $c->_xlt($cd, '%(modal_verb)s be %s');
          my $awa = $c->_xlt($cd, 'as well as %s');
          my $wb  = $c->_xlt($cd, ' ');
          my $fmt;
          my $i = 0;
          for my $r (@result) {
              $fmt .= $i ? $wb . $awa : $c0;
              push @$vals, ref($r->[0]{text}) eq 'ARRAY' ?
                  $r->[0]{text}[0] : $r->[0]{text};
              $i++;
          }
          $c->add_ccl($cd, {
              fmt  => $fmt,
              vals => $vals,
              xlt  => 0,
              type => 'noun',
          });
      } else {
          $c->add_ccl($cd, {
              type  => 'list',
              fmt   => '%(modal_verb)s be all of the following',
              items => [
                  @result,
              ],
              vals  => [],
          });
      }
  }
  
  1;
  
  __END__
  
DATA_SAH_COMPILER_HUMAN_TH_ALL

$fatpacked{"Data/Sah/Compiler/human/TH/any.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'DATA_SAH_COMPILER_HUMAN_TH_ANY';
  package Data::Sah::Compiler::human::TH::any;
  
  our $DATE = '2015-04-14'; 
  our $VERSION = '0.51'; 
  
  use 5.010;
  use strict;
  use warnings;
  
  use Mo qw(build default);
  use Role::Tiny::With;
  
  extends 'Data::Sah::Compiler::human::TH';
  with 'Data::Sah::Type::any';
  
  sub handle_type {
  }
  
  sub clause_of {
      my ($self, $cd) = @_;
      my $c  = $self->compiler;
      my $cv = $cd->{cl_value};
  
      my @result;
      my $i = 0;
      for my $cv2 (@$cv) {
          local $cd->{spath} = [@{$cd->{spath}}, $i];
          my %iargs = %{$cd->{args}};
          $iargs{outer_cd}             = $cd;
          $iargs{schema}               = $cv2;
          $iargs{schema_is_normalized} = 0;
          my $icd = $c->compile(%iargs);
          push @result, $icd->{ccls};
          $i++;
      }
  
      my $can = 1;
      for my $r (@result) {
          unless (@$r == 1 && $r->[0]{type} eq 'noun') {
              $can = 0;
              last;
          }
      }
  
      my $vals;
      if ($can) {
          my $c0  = $c->_xlt($cd, '%(modal_verb)s be either %s');
          my $awa = $c->_xlt($cd, 'or %s');
          my $wb  = $c->_xlt($cd, ' ');
          my $fmt;
          my $i = 0;
          for my $r (@result) {
              $fmt .= $i ? $wb . $awa : $c0;
              push @$vals, ref($r->[0]{text}) eq 'ARRAY' ?
                  $r->[0]{text}[0] : $r->[0]{text};
              $i++;
          }
          $c->add_ccl($cd, {
              fmt  => $fmt,
              vals => $vals,
              xlt  => 0,
              type => 'noun',
          });
      } else {
          $c->add_ccl($cd, {
              type  => 'list',
              fmt   => '%(modal_verb)s be one of the following',
              items => [
                  @result,
              ],
              vals  => [],
          });
      }
  }
  
  1;
  
  __END__
  
DATA_SAH_COMPILER_HUMAN_TH_ANY

$fatpacked{"Data/Sah/Compiler/human/TH/array.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'DATA_SAH_COMPILER_HUMAN_TH_ARRAY';
  package Data::Sah::Compiler::human::TH::array;
  
  our $DATE = '2015-04-14'; 
  our $VERSION = '0.51'; 
  
  use 5.010;
  use strict;
  use warnings;
  
  use Mo qw(build default);
  use Role::Tiny::With;
  
  extends 'Data::Sah::Compiler::human::TH';
  with 'Data::Sah::Compiler::human::TH::Comparable';
  with 'Data::Sah::Compiler::human::TH::HasElems';
  with 'Data::Sah::Type::array';
  
  sub handle_type {
      my ($self, $cd) = @_;
      my $c = $self->compiler;
  
      $c->add_ccl($cd, {
          fmt   => ["array", "arrays"],
          type  => 'noun',
      });
  }
  
  sub clause_each_index {
      my ($self, $cd) = @_;
      my $c  = $self->compiler;
      my $cv = $cd->{cl_value};
  
      my %iargs = %{$cd->{args}};
      $iargs{outer_cd}             = $cd;
      $iargs{schema}               = $cv;
      $iargs{schema_is_normalized} = 0;
      my $icd = $c->compile(%iargs);
  
      $c->add_ccl($cd, {
          type  => 'list',
          fmt   => 'each array subscript %(modal_verb)s be',
          items => [
              $icd->{ccls},
          ],
          vals  => [],
      });
  }
  
  sub clause_each_elem {
      my ($self, $cd) = @_;
      my $c  = $self->compiler;
      my $cv = $cd->{cl_value};
  
      my %iargs = %{$cd->{args}};
      $iargs{outer_cd}             = $cd;
      $iargs{schema}               = $cv;
      $iargs{schema_is_normalized} = 0;
      my $icd = $c->compile(%iargs);
  
      if (@{$icd->{ccls}} == 1) {
          my $c0 = $icd->{ccls}[0];
          if ($c0->{type} eq 'noun' && ref($c0->{text}) eq 'ARRAY' &&
                  @{$c0->{text}} > 1 && @{$cd->{ccls}} &&
                      $cd->{ccls}[0]{type} eq 'noun') {
              for (ref($cd->{ccls}[0]{text}) eq 'ARRAY' ?
                       @{$cd->{ccls}[0]{text}} : ($cd->{ccls}[0]{text})) {
                  my $fmt = $c->_xlt($cd, '%s of %s');
                  $_ = sprintf $fmt, $_, $c0->{text}[1];
              }
              return;
          }
      }
  
      $c->add_ccl($cd, {
          type  => 'list',
          fmt   => 'each array element %(modal_verb)s be',
          items => [
              $icd->{ccls},
          ],
          vals  => [],
      });
  }
  
  sub clause_elems {
      my ($self, $cd) = @_;
      my $c  = $self->compiler;
      my $cv = $cd->{cl_value};
  
      for my $i (0..@$cv-1) {
          local $cd->{spath} = [@{$cd->{spath}}, $i];
          my $v = $cv->[$i];
          my %iargs = %{$cd->{args}};
          $iargs{outer_cd}             = $cd;
          $iargs{schema}               = $v;
          $iargs{schema_is_normalized} = 0;
          my $icd = $c->compile(%iargs);
          $c->add_ccl($cd, {
              type  => 'list',
              fmt   => '%s %(modal_verb)s be',
              vals  => [
                  $c->_ordinate($cd, $i+1, $c->_xlt($cd, "element")),
              ],
              items => [ $icd->{ccls} ],
          });
      }
  }
  
  1;
  
  __END__
  
DATA_SAH_COMPILER_HUMAN_TH_ARRAY

$fatpacked{"Data/Sah/Compiler/human/TH/bool.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'DATA_SAH_COMPILER_HUMAN_TH_BOOL';
  package Data::Sah::Compiler::human::TH::bool;
  
  our $DATE = '2015-04-14'; 
  our $VERSION = '0.51'; 
  
  use 5.010;
  use strict;
  use warnings;
  
  use Mo qw(build default);
  use Role::Tiny::With;
  
  extends 'Data::Sah::Compiler::human::TH';
  with 'Data::Sah::Compiler::human::TH::Comparable';
  with 'Data::Sah::Compiler::human::TH::Sortable';
  with 'Data::Sah::Type::bool';
  
  sub name { "boolean value" }
  
  sub handle_type {
      my ($self, $cd) = @_;
      my $c = $self->compiler;
  
      $c->add_ccl($cd, {
          fmt   => ["boolean value", "boolean values"],
          type  => 'noun',
      });
  }
  
  sub before_clause_is_true {
      my ($self, $cd) = @_;
      $cd->{CLAUSE_DO_MULTI} = 0;
  }
  
  sub clause_is_true {
      my ($self, $cd) = @_;
      my $c  = $self->compiler;
      my $cv = $cd->{cl_value};
  
      $c->add_ccl($cd, {
          fmt   => $cv ? q[%(modal_verb)s be true] : q[%(modal_verb)s be false],
      });
  }
  
  sub clause_is_re {
      my ($self, $cd) = @_;
      my $c  = $self->compiler;
      my $cv = $cd->{cl_value};
  
      $c->add_ccl($cd, {
          fmt   => q[%(modal_verb)s be a regex pattern],
      });
  }
  
  1;
  
  __END__
  
DATA_SAH_COMPILER_HUMAN_TH_BOOL

$fatpacked{"Data/Sah/Compiler/human/TH/buf.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'DATA_SAH_COMPILER_HUMAN_TH_BUF';
  package Data::Sah::Compiler::human::TH::buf;
  
  our $DATE = '2015-04-14'; 
  our $VERSION = '0.51'; 
  
  use 5.010;
  use strict;
  use warnings;
  
  use Mo qw(build default);
  use Role::Tiny::With;
  
  extends 'Data::Sah::Compiler::human::TH::str';
  
  sub name { "buffer" }
  
  sub handle_type {
      my ($self, $cd) = @_;
      my $c = $self->compiler;
  
      $c->add_ccl($cd, {
          fmt   => ["buffer", "buffers"],
          type  => 'noun',
      });
  }
  
  1;
  
  __END__
  
DATA_SAH_COMPILER_HUMAN_TH_BUF

$fatpacked{"Data/Sah/Compiler/human/TH/cistr.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'DATA_SAH_COMPILER_HUMAN_TH_CISTR';
  package Data::Sah::Compiler::human::TH::cistr;
  
  our $DATE = '2015-04-14'; 
  our $VERSION = '0.51'; 
  
  use 5.010;
  use strict;
  use warnings;
  
  use Mo qw(build default);
  use Role::Tiny::With;
  
  extends 'Data::Sah::Compiler::human::TH::str';
  
  1;
  
  __END__
  
DATA_SAH_COMPILER_HUMAN_TH_CISTR

$fatpacked{"Data/Sah/Compiler/human/TH/code.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'DATA_SAH_COMPILER_HUMAN_TH_CODE';
  package Data::Sah::Compiler::human::TH::code;
  
  our $DATE = '2015-04-14'; 
  our $VERSION = '0.51'; 
  
  use 5.010;
  use strict;
  use warnings;
  
  use Mo qw(build default);
  use Role::Tiny::With;
  
  extends 'Data::Sah::Compiler::human::TH';
  with 'Data::Sah::Type::code';
  
  sub handle_type {
      my ($self, $cd) = @_;
      my $c = $self->compiler;
  
      $c->add_ccl($cd, {
          fmt   => ["code", "codes"],
          type  => 'noun',
      });
  }
  
  1;
  
  __END__
  
DATA_SAH_COMPILER_HUMAN_TH_CODE

$fatpacked{"Data/Sah/Compiler/human/TH/date.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'DATA_SAH_COMPILER_HUMAN_TH_DATE';
  package Data::Sah::Compiler::human::TH::date;
  
  our $DATE = '2015-04-14'; 
  our $VERSION = '0.51'; 
  
  use 5.010;
  use strict;
  use warnings;
  
  use Mo qw(build default);
  use Role::Tiny::With;
  
  extends 'Data::Sah::Compiler::human::TH';
  with 'Data::Sah::Compiler::human::TH::Comparable';
  with 'Data::Sah::Compiler::human::TH::Sortable';
  with 'Data::Sah::Type::date';
  
  sub name { "date" }
  
  sub handle_type {
      my ($self, $cd) = @_;
      my $c = $self->compiler;
  
      $c->add_ccl($cd, {type=>'noun', fmt => ["date", "dates"]});
  }
  
  1;
  
  __END__
  
DATA_SAH_COMPILER_HUMAN_TH_DATE

$fatpacked{"Data/Sah/Compiler/human/TH/float.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'DATA_SAH_COMPILER_HUMAN_TH_FLOAT';
  package Data::Sah::Compiler::human::TH::float;
  
  our $DATE = '2015-04-14'; 
  our $VERSION = '0.51'; 
  
  use 5.010;
  use strict;
  use warnings;
  
  use Mo qw(build default);
  use Role::Tiny::With;
  
  extends 'Data::Sah::Compiler::human::TH';
  with 'Data::Sah::Compiler::human::TH::Comparable';
  with 'Data::Sah::Compiler::human::TH::Sortable';
  with 'Data::Sah::Type::float';
  
  sub name { "decimal number" }
  
  sub handle_type {
      my ($self, $cd) = @_;
      my $c = $self->compiler;
  
      $c->add_ccl($cd, {
          type=>'noun',
          fmt => ["decimal number", "decimal numbers"],
      });
  }
  
  sub clause_is_nan {
      my ($self, $cd) = @_;
      my $c = $self->compiler;
  
      my $cv = $cd->{cl_value};
      if ($cd->{cl_is_expr}) {
          $c->add_ccl($cd, {});
      } else {
          $c->add_ccl($cd, {
              fmt => $cv ?
                  q[%(modal_verb)s be a NaN] :
                      q[%(modal_verb_neg)s be a NaN],
          });
      }
  }
  
  sub clause_is_inf {
      my ($self, $cd) = @_;
      my $c = $self->compiler;
  
      my $cv = $cd->{cl_value};
      if ($cd->{cl_is_expr}) {
          $c->add_ccl($cd, {});
      } else {
          $c->add_ccl($cd, {
              fmt => $cv ?
                  q[%(modal_verb)s an infinity] :
                      q[%(modal_verb_neg)s an infinity],
          });
      }
  }
  
  sub clause_is_pos_inf {
      my ($self, $cd) = @_;
      my $c = $self->compiler;
  
      my $cv = $cd->{cl_value};
      if ($cd->{cl_is_expr}) {
          $c->add_ccl($cd, {});
      } else {
          $c->add_ccl($cd, {
              fmt => $cv ?
                  q[%(modal_verb)s a positive infinity] :
                      q[%(modal_verb_neg)s a positive infinity],
          });
      }
  }
  
  sub clause_is_neg_inf {
      my ($self, $cd) = @_;
      my $c = $self->compiler;
  
      my $cv = $cd->{cl_value};
      if ($cd->{cl_is_expr}) {
          $c->add_ccl($cd, {});
      } else {
          $c->add_ccl($cd, {
              fmt => $cv ?
                  q[%(modal_verb)s a negative infinity] :
                      q[%(modal_verb_neg)s a negative infinity],
          });
      }
  }
  
  1;
  
  __END__
  
DATA_SAH_COMPILER_HUMAN_TH_FLOAT

$fatpacked{"Data/Sah/Compiler/human/TH/hash.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'DATA_SAH_COMPILER_HUMAN_TH_HASH';
  package Data::Sah::Compiler::human::TH::hash;
  
  our $DATE = '2015-04-14'; 
  our $VERSION = '0.51'; 
  
  use 5.010;
  use strict;
  use warnings;
  
  use Mo qw(build default);
  use Role::Tiny::With;
  
  extends 'Data::Sah::Compiler::human::TH';
  with 'Data::Sah::Compiler::human::TH::Comparable';
  with 'Data::Sah::Compiler::human::TH::HasElems';
  with 'Data::Sah::Type::hash';
  
  sub handle_type {
      my ($self, $cd) = @_;
      my $c = $self->compiler;
  
      $c->add_ccl($cd, {
          fmt   => ["hash", "hashes"],
          type  => 'noun',
      });
  }
  
  sub clause_has {
      my ($self, $cd) = @_;
      my $c  = $self->compiler;
  
      $c->add_ccl($cd, {
          expr=>1, multi=>1,
          fmt => "%(modal_verb)s have %s in its field values"});
  }
  
  sub clause_each_index {
      my ($self, $cd) = @_;
      my $c  = $self->compiler;
      my $cv = $cd->{cl_value};
  
      my %iargs = %{$cd->{args}};
      $iargs{outer_cd}             = $cd;
      $iargs{schema}               = $cv;
      $iargs{schema_is_normalized} = 0;
      my $icd = $c->compile(%iargs);
  
      $c->add_ccl($cd, {
          type  => 'list',
          fmt   => 'field name %(modal_verb)s be',
          items => [
              $icd->{ccls},
          ],
          vals  => [],
      });
  }
  
  sub clause_each_elem {
      my ($self, $cd) = @_;
      my $c  = $self->compiler;
      my $cv = $cd->{cl_value};
  
      my %iargs = %{$cd->{args}};
      $iargs{outer_cd}             = $cd;
      $iargs{schema}               = $cv;
      $iargs{schema_is_normalized} = 0;
      my $icd = $c->compile(%iargs);
  
      $c->add_ccl($cd, {
          type  => 'list',
          fmt   => 'each field %(modal_verb)s be',
          items => [
              $icd->{ccls},
          ],
          vals  => [],
      });
  }
  
  sub clause_keys {
      my ($self, $cd) = @_;
      my $c  = $self->compiler;
      my $cv = $cd->{cl_value};
  
      for my $k (sort keys %$cv) {
          local $cd->{spath} = [@{$cd->{spath}}, $k];
          my $v = $cv->{$k};
          my %iargs = %{$cd->{args}};
          $iargs{outer_cd}             = $cd;
          $iargs{schema}               = $v;
          $iargs{schema_is_normalized} = 0;
          my $icd = $c->compile(%iargs);
          $c->add_ccl($cd, {
              type  => 'list',
              fmt   => 'field %s %(modal_verb)s be',
              vals  => [$k],
              items => [ $icd->{ccls} ],
          });
      }
  }
  
  sub clause_re_keys {
      my ($self, $cd) = @_;
      my $c  = $self->compiler;
      my $cv = $cd->{cl_value};
  
      for my $k (sort keys %$cv) {
          local $cd->{spath} = [@{$cd->{spath}}, $k];
          my $v = $cv->{$k};
          my %iargs = %{$cd->{args}};
          $iargs{outer_cd}             = $cd;
          $iargs{schema}               = $v;
          $iargs{schema_is_normalized} = 0;
          my $icd = $c->compile(%iargs);
          $c->add_ccl($cd, {
              type  => 'list',
              fmt   => 'fields whose names match regex pattern %s %(modal_verb)s be',
              vals  => [$k],
              items => [ $icd->{ccls} ],
          });
      }
  }
  
  sub clause_req_keys {
    my ($self, $cd) = @_;
    my $c  = $self->compiler;
  
    $c->add_ccl($cd, {
      fmt   => q[%(modal_verb)s have required fields %s],
      expr  => 1,
    });
  }
  
  sub clause_allowed_keys {
    my ($self, $cd) = @_;
    my $c  = $self->compiler;
  
    $c->add_ccl($cd, {
      fmt   => q[%(modal_verb)s only have these allowed fields %s],
      expr  => 1,
    });
  }
  
  sub clause_allowed_keys_re {
    my ($self, $cd) = @_;
    my $c  = $self->compiler;
  
    $c->add_ccl($cd, {
      fmt   => q[%(modal_verb)s only have fields matching regex pattern %s],
      expr  => 1,
    });
  }
  
  sub clause_forbidden_keys {
    my ($self, $cd) = @_;
    my $c  = $self->compiler;
  
    $c->add_ccl($cd, {
      fmt   => q[%(modal_verb_neg)s have these forbidden fields %s],
      expr  => 1,
    });
  }
  
  sub clause_forbidden_keys_re {
    my ($self, $cd) = @_;
    my $c  = $self->compiler;
  
    $c->add_ccl($cd, {
      fmt   => q[%(modal_verb_neg)s have fields matching regex pattern %s],
      expr  => 1,
    });
  }
  
  1;
  
  __END__
  
DATA_SAH_COMPILER_HUMAN_TH_HASH

$fatpacked{"Data/Sah/Compiler/human/TH/int.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'DATA_SAH_COMPILER_HUMAN_TH_INT';
  package Data::Sah::Compiler::human::TH::int;
  
  our $DATE = '2015-04-14'; 
  our $VERSION = '0.51'; 
  
  use 5.010;
  use strict;
  use warnings;
  
  use Mo qw(build default);
  use Role::Tiny::With;
  
  extends 'Data::Sah::Compiler::human::TH::num';
  with 'Data::Sah::Type::int';
  
  sub name { "integer" }
  
  sub handle_type {
      my ($self, $cd) = @_;
      my $c = $self->compiler;
  
      $c->add_ccl($cd, {
          type  => 'noun',
          fmt   => ["integer", "integers"],
      });
  }
  
  sub clause_div_by {
      my ($self, $cd) = @_;
      my $c  = $self->compiler;
      my $cv = $cd->{cl_value};
  
      if (!$cd->{cl_is_multi} && !$cd->{cl_is_expr} &&
              $cv == 2) {
          $c->add_ccl($cd, {
              fmt   => q[%(modal_verb)s be even],
          });
          return;
      }
  
      $c->add_ccl($cd, {
          fmt   => q[%(modal_verb)s be divisible by %s],
          expr  => 1,
      });
  }
  
  sub clause_mod {
      my ($self, $cd) = @_;
      my $c  = $self->compiler;
      my $cv = $cd->{cl_value};
  
      if (!$cd->{cl_is_multi} && !$cd->{cl_is_expr}) {
          if ($cv->[0] == 2 && $cv->[1] == 0) {
              $c->add_ccl($cd, {
                  fmt   => q[%(modal_verb)s be even],
              });
          } elsif ($cv->[0] == 2 && $cv->[1] == 1) {
              $c->add_ccl($cd, {
                  fmt   => q[%(modal_verb)s be odd],
              });
          }
          return;
      }
  
      $c->add_ccl($cd, {
          type => 'clause',
          fmt  =>
              q[%(modal_verb)s leave a remainder of %2$s when divided by %1$s],
          vals => $cv,
      });
  }
  
  1;
  
  __END__
  
DATA_SAH_COMPILER_HUMAN_TH_INT

$fatpacked{"Data/Sah/Compiler/human/TH/num.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'DATA_SAH_COMPILER_HUMAN_TH_NUM';
  package Data::Sah::Compiler::human::TH::num;
  
  our $DATE = '2015-04-14'; 
  our $VERSION = '0.51'; 
  
  use 5.010;
  use strict;
  use warnings;
  
  use Mo qw(build default);
  use Role::Tiny::With;
  
  extends 'Data::Sah::Compiler::human::TH';
  with 'Data::Sah::Compiler::human::TH::Comparable';
  with 'Data::Sah::Compiler::human::TH::Sortable';
  with 'Data::Sah::Type::num';
  
  sub name { "number" }
  
  sub handle_type {
      my ($self, $cd) = @_;
      my $c = $self->compiler;
  
      $c->add_ccl($cd, {type=>'noun', fmt => ["number", "numbers"]});
  }
  
  1;
  
  __END__
  
DATA_SAH_COMPILER_HUMAN_TH_NUM

$fatpacked{"Data/Sah/Compiler/human/TH/obj.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'DATA_SAH_COMPILER_HUMAN_TH_OBJ';
  package Data::Sah::Compiler::human::TH::obj;
  
  our $DATE = '2015-04-14'; 
  our $VERSION = '0.51'; 
  
  use 5.010;
  use strict;
  use warnings;
  
  use Mo qw(build default);
  use Role::Tiny::With;
  
  extends 'Data::Sah::Compiler::human::TH';
  with 'Data::Sah::Type::obj';
  
  sub name { "object" }
  
  sub handle_type {
      my ($self, $cd) = @_;
      my $c = $self->compiler;
  
      $c->add_ccl($cd, {
          fmt   => ["object", "objects"],
          type  => 'noun',
      });
  }
  
  sub clause_can {
      my ($self, $cd) = @_;
      my $c  = $self->compiler;
      my $cv = $cd->{cl_value};
  
      $c->add_ccl($cd, {
          fmt   => q[%(modal_verb)s have method(s) %s],
      });
  }
  
  sub clause_isa {
      my ($self, $cd) = @_;
      my $c  = $self->compiler;
      my $cv = $cd->{cl_value};
  
      $c->add_ccl($cd, {
          fmt   => q[%(modal_verb)s be subclass of %s],
      });
  }
  
  1;
  
  __END__
  
DATA_SAH_COMPILER_HUMAN_TH_OBJ

$fatpacked{"Data/Sah/Compiler/human/TH/re.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'DATA_SAH_COMPILER_HUMAN_TH_RE';
  package Data::Sah::Compiler::human::TH::re;
  
  our $DATE = '2015-04-14'; 
  our $VERSION = '0.51'; 
  
  use 5.010;
  use strict;
  use warnings;
  
  use Mo qw(build default);
  use Role::Tiny::With;
  
  extends 'Data::Sah::Compiler::human::TH';
  with 'Data::Sah::Type::re';
  
  sub name { "regex pattern" }
  
  sub handle_type {
      my ($self, $cd) = @_;
      my $c = $self->compiler;
  
      $c->add_ccl($cd, {
          fmt   => ["regex pattern", "regex patterns"],
          type  => 'noun',
      });
  }
  
  1;
  
  __END__
  
DATA_SAH_COMPILER_HUMAN_TH_RE

$fatpacked{"Data/Sah/Compiler/human/TH/str.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'DATA_SAH_COMPILER_HUMAN_TH_STR';
  package Data::Sah::Compiler::human::TH::str;
  
  our $DATE = '2015-04-14'; 
  our $VERSION = '0.51'; 
  
  use 5.010;
  use strict;
  use warnings;
  
  use Mo qw(build default);
  use Role::Tiny::With;
  
  extends 'Data::Sah::Compiler::human::TH';
  with 'Data::Sah::Compiler::human::TH::Sortable';
  with 'Data::Sah::Compiler::human::TH::Comparable';
  with 'Data::Sah::Compiler::human::TH::HasElems';
  with 'Data::Sah::Type::str';
  
  sub name { "text" }
  
  sub handle_type {
      my ($self, $cd) = @_;
      my $c = $self->compiler;
  
      $c->add_ccl($cd, {
          fmt   => ["text", "texts"],
          type  => 'noun',
      });
  }
  
  sub clause_each_index {
      my ($self, $cd) = @_;
      my $c  = $self->compiler;
      my $cv = $cd->{cl_value};
  
      my %iargs = %{$cd->{args}};
      $iargs{outer_cd}             = $cd;
      $iargs{schema}               = $cv;
      $iargs{schema_is_normalized} = 0;
      my $icd = $c->compile(%iargs);
  
      $c->add_ccl($cd, {
          type  => 'list',
          fmt   => 'each subscript of text %(modal_verb)s be',
          items => [
              $icd->{ccls},
          ],
          vals  => [],
      });
  }
  
  sub clause_each_elem {
      my ($self, $cd) = @_;
      my $c  = $self->compiler;
      my $cv = $cd->{cl_value};
  
      my %iargs = %{$cd->{args}};
      $iargs{outer_cd}             = $cd;
      $iargs{schema}               = $cv;
      $iargs{schema_is_normalized} = 0;
      my $icd = $c->compile(%iargs);
  
      $c->add_ccl($cd, {
          type  => 'list',
          fmt   => 'each character of the text %(modal_verb)s be',
          items => [
              $icd->{ccls},
          ],
          vals  => [],
      });
  }
  
  sub clause_encoding {
      my ($self, $cd) = @_;
      my $c  = $self->compiler;
      my $cv = $cd->{cl_value};
  
      $c->_die($cd, "Only 'utf8' encoding is currently supported")
          unless $cv eq 'utf8';
  }
  
  sub clause_match {
      my ($self, $cd) = @_;
      my $c  = $self->compiler;
      my $cv = $cd->{cl_value};
  
      $c->add_ccl($cd, {
          fmt   => q[%(modal_verb)s match regex pattern %s],
      });
  }
  
  sub clause_is_re {
      my ($self, $cd) = @_;
      my $c  = $self->compiler;
      my $cv = $cd->{cl_value};
  
      $c->add_ccl($cd, {
          fmt   => q[%(modal_verb)s be a regex pattern],
      });
  }
  
  1;
  
  __END__
  
DATA_SAH_COMPILER_HUMAN_TH_STR

$fatpacked{"Data/Sah/Compiler/human/TH/undef.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'DATA_SAH_COMPILER_HUMAN_TH_UNDEF';
  package Data::Sah::Compiler::human::TH::undef;
  
  our $DATE = '2015-04-14'; 
  our $VERSION = '0.51'; 
  
  use 5.010;
  use strict;
  use warnings;
  
  use Mo qw(build default);
  use Role::Tiny::With;
  
  extends 'Data::Sah::Compiler::human::TH';
  with 'Data::Sah::Type::undef';
  
  sub name { "undefined value" }
  
  sub handle_type {
      my ($self, $cd) = @_;
      my $c = $self->compiler;
  
      $c->add_ccl($cd, {
          fmt   => ["undefined value", "undefined values"],
          type  => 'noun',
      });
  }
  
  1;
  
  __END__
  
DATA_SAH_COMPILER_HUMAN_TH_UNDEF

$fatpacked{"Data/Sah/Compiler/js.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'DATA_SAH_COMPILER_JS';
  package Data::Sah::Compiler::js;
  
  our $DATE = '2015-04-14'; 
  our $VERSION = '0.51'; 
  
  use 5.010;
  use strict;
  use warnings;
  
  use Mo qw(build default);
  use String::Indent ();
  
  extends 'Data::Sah::Compiler::Prog';
  
  sub BUILD {
      my ($self, $args) = @_;
  
      $self->comment_style('cpp');
      $self->indent_character(" " x 4);
      $self->var_sigil("");
      $self->concat_op("+");
  }
  
  sub name { "js" }
  
  sub expr {
      my ($self, $expr) = @_;
      $self->expr_compiler->js($expr);
  }
  
  sub literal {
      my ($self, $val) = @_;
  
      state $json = do {
          require JSON;
          JSON->new->allow_nonref;
      };
  
      state $cleanser = do {
          require Data::Clean::JSON;
          Data::Clean::JSON->get_cleanser;
      };
  
      $json->encode($cleanser->clone_and_clean($val));
  }
  
  sub compile {
      my ($self, %args) = @_;
  
  
  
      $self->SUPER::compile(%args);
  }
  
  sub true { "true" }
  
  sub false { "false" }
  
  sub expr_defined {
      my ($self, $t) = @_;
      "!($t === undefined || $t === null)";
  }
  
  sub expr_array_subscript {
      my ($self, $at, $idxt) = @_;
      "$at\[$idxt]";
  }
  
  sub expr_last_elem {
      my ($self, $at, $idxt) = @_;
      "$at\[($at).length-1]";
  }
  
  sub expr_array_0_nmin1 {
      my ($self, $n) = @_;
      "Array($n).join().split(',').map(function(e,i){return i})";
  }
  
  sub expr_array_1_n {
      my ($self, $n) = @_;
      "Array($n).join().split(',').map(function(e,i){return i+1})";
  }
  
  sub expr_push {
      my ($self, $at, $elt) = @_;
      "($at).push($elt)";
  }
  
  sub expr_pop {
      my ($self, $at, $elt) = @_;
      "($at).pop()";
  }
  
  sub expr_push_and_pop_dpath_between_expr {
      my ($self, $et) = @_;
      join(
          "",
          "[",
          $self->expr_push('_sahv_dpath', $self->literal(undef)), ", ", 
          $self->enclose_paren($et), ", ", 
          $self->expr_pop('_sahv_dpath'), 
          "][1]",
      );
  }
  
  sub expr_prefix_dpath {
      my ($self, $t) = @_;
      '(_sahv_dpath.length ? "@" + _sahv_dpath.join("/") + ": " : "") + ' . $t;
  }
  
  sub expr_setif {
      my ($self, $l, $r) = @_;
      "$l = " . $self->expr_defined($l) . " ? $l : $r";
  }
  
  sub expr_set_err_str {
      my ($self, $et, $err_expr) = @_;
      $self->expr_setif($et, $err_expr);
  }
  
  sub expr_set_err_full {
      my ($self, $et, $k, $err_expr) = @_;
      join(
          "",
          "(",
          $self->expr_setif("$et\['$k']", "{}"),
          ",",
          $self->expr_setif("$et\['$k'][_sahv_dpath.join('/')]", $err_expr),
          ")",
      );
  }
  
  sub expr_reset_err_str {
      my ($self, $et, $err_expr) = @_;
      "($et = null, true)";
  }
  
  sub expr_reset_err_full {
      my ($self, $et) = @_;
      join(
          "",
          "(",
          $self->expr_setif("$et\['errors']", "{}"),
          ",",
          "delete($et\['errors'][_sahv_dpath.join('/')])",
          ")",
      );
  }
  
  sub expr_log {
      my ($self, $cd, $ccl) = @_;
      "";
  }
  
  sub expr_block {
      my ($self, $code) = @_;
      join(
          "",
          "(function() {\n",
          String::Indent::indent(
              $self->indent_character,
              $code,
          ),
          "})()",
      );
  }
  
  sub block_uses_sub { 1 }
  
  sub stmt_declare_local_var {
      my $self = shift;
      my $v = shift;
      if (@_) {
          "var $v = $_[0];";
      } else {
          "var $v;";
      }
  }
  
  sub expr_anon_sub {
      my ($self, $args, $code) = @_;
      join(
          "",
          "function(".join(", ", @$args).") {\n",
          String::Indent::indent(
              $self->indent_character,
              $code,
          ),
          "}"
      );
  }
  
  sub stmt_require_module {
      my ($self, $mod, $cd) = @_;
      '';
  }
  
  sub stmt_require_log_module {
      my ($self, $mod) = @_;
      '';
  }
  
  sub stmt_return {
      my $self = shift;
      if (@_) {
          "return($_[0]);";
      } else {
          'return;';
      }
  }
  
  sub expr_validator_sub {
      my ($self, %args) = @_;
  
      $args{data_term} = 'data';
      $self->SUPER::expr_validator_sub(%args);
  }
  
  sub _str2reliteral {
      my ($self, $cd, $str) = @_;
  
      my $re;
      if (ref($str) eq 'Regexp') {
          $re = "$str";
      } else {
          eval { qr/$str/ };
          $self->_die($cd, "Invalid regex $str: $@") if $@;
          $re = $str;
      }
  
      $re = "$re";
      $re =~ s!/!\\/!g;
      "/$re/";
  }
  
  1;
  
  __END__
  
DATA_SAH_COMPILER_JS

$fatpacked{"Data/Sah/Compiler/js/TH.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'DATA_SAH_COMPILER_JS_TH';
  package Data::Sah::Compiler::js::TH;
  
  our $DATE = '2015-04-14'; 
  our $VERSION = '0.51'; 
  
  use 5.010;
  use strict;
  use warnings;
  
  use Mo qw(build default);
  
  extends 'Data::Sah::Compiler::Prog::TH';
  
  sub gen_each {
      my ($self, $cd, $indices_expr, $data_name, $data_term, $code_at_sub_begin) = @_;
      my $c  = $self->compiler;
      my $cv = $cd->{cl_value};
      my $dt = $cd->{data_term};
  
      local $cd->{_subdata_level} = $cd->{_subdata_level} + 1;
      my $use_dpath = $cd->{args}{return_type} ne 'bool';
  
      my %iargs = %{$cd->{args}};
      $iargs{outer_cd}             = $cd;
      $iargs{data_name}            = $data_name,
      $iargs{data_term}            = $data_term,
      $iargs{schema}               = $cv;
      $iargs{schema_is_normalized} = 0;
      $iargs{indent_level}++;
      my $icd = $c->compile(%iargs);
      my @code = (
          "(", $indices_expr, ").every(function(_sahv_idx){", ($code_at_sub_begin // ''), " return(\n",
          ($c->indent_str($cd), "(_sahv_dpath[_sahv_dpath.length ? _sahv_dpath.length-1 : 0] = _sahv_idx),\n") x !!$use_dpath,
          $icd->{result}, "\n",
          $c->indent_str($icd), ")})",
      );
      $c->add_ccl($cd, join("", @code), {subdata=>1});
  }
  
  1;
  
  __END__
  
DATA_SAH_COMPILER_JS_TH

$fatpacked{"Data/Sah/Compiler/js/TH/all.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'DATA_SAH_COMPILER_JS_TH_ALL';
  package Data::Sah::Compiler::js::TH::all;
  
  our $DATE = '2015-04-14'; 
  our $VERSION = '0.51'; 
  
  use 5.010;
  use strict;
  use warnings;
  
  use Mo qw(build default);
  use Role::Tiny::With;
  
  
  use parent (
      'Data::Sah::Compiler::js::TH',
      'Data::Sah::Compiler::Prog::TH::all',
  );
  
  1;
  
  __END__
  
DATA_SAH_COMPILER_JS_TH_ALL

$fatpacked{"Data/Sah/Compiler/js/TH/any.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'DATA_SAH_COMPILER_JS_TH_ANY';
  package Data::Sah::Compiler::js::TH::any;
  
  our $DATE = '2015-04-14'; 
  our $VERSION = '0.51'; 
  
  use 5.010;
  use strict;
  use warnings;
  
  use Mo qw(build default);
  
  
  use parent (
      'Data::Sah::Compiler::js::TH',
      'Data::Sah::Compiler::Prog::TH::any',
  );
  
  1;
  
  __END__
  
DATA_SAH_COMPILER_JS_TH_ANY

$fatpacked{"Data/Sah/Compiler/js/TH/array.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'DATA_SAH_COMPILER_JS_TH_ARRAY';
  package Data::Sah::Compiler::js::TH::array;
  
  our $DATE = '2015-04-14'; 
  our $VERSION = '0.51'; 
  
  use 5.010;
  use strict;
  use warnings;
  
  use Mo qw(build default);
  use Role::Tiny::With;
  
  extends 'Data::Sah::Compiler::js::TH';
  with 'Data::Sah::Type::array';
  
  sub handle_type {
      my ($self, $cd) = @_;
      my $c = $self->compiler;
  
      my $dt = $cd->{data_term};
      $cd->{_ccl_check_type} = "$dt instanceof Array";
  }
  
  my $STR = "JSON.stringify";
  
  sub superclause_comparable {
      my ($self, $which, $cd) = @_;
      my $c  = $self->compiler;
      my $ct = $cd->{cl_term};
      my $dt = $cd->{data_term};
  
      if ($which eq 'is') {
          $c->add_ccl($cd, "$STR($dt) == $STR($ct)");
      } elsif ($which eq 'in') {
          $c->add_ccl(
              $cd,
              "!($ct).every(function(x){return $STR(x) != $STR($dt) })");
      }
  }
  
  sub superclause_has_elems {
      my ($self_th, $which, $cd) = @_;
      my $c  = $self_th->compiler;
      my $cv = $cd->{cl_value};
      my $ct = $cd->{cl_term};
      my $dt = $cd->{data_term};
  
      if ($which eq 'len') {
          $c->add_ccl($cd, "($dt).length == $ct");
      } elsif ($which eq 'min_len') {
          $c->add_ccl($cd, "($dt).length >= $ct");
      } elsif ($which eq 'max_len') {
          $c->add_ccl($cd, "($dt).length <= $ct");
      } elsif ($which eq 'len_between') {
          if ($cd->{cl_is_expr}) {
              $c->add_ccl(
                  $cd, "($dt).length >= $ct\->[0] && ($dt).length >= $ct\->[1]");
          } else {
              $c->add_ccl(
                  $cd, "($dt).length >= $cv->[0] && ($dt).length <= $cv->[1]");
          }
      } elsif ($which eq 'has') {
          $c->add_ccl(
              $cd,
              "($dt).map(function(x){return $STR(x)}).indexOf($STR($ct)) > -1");
      } elsif ($which eq 'each_index') {
          $self_th->gen_each($cd,
                             $c->expr_array_0_nmin1("($dt).length"), '_sahv_idx', '_sahv_idx');
      } elsif ($which eq 'each_elem') {
          $self_th->gen_each($cd,
                             $c->expr_array_0_nmin1("($dt).length"), '_sahv_idx', "$dt\[_sahv_idx]");
      } elsif ($which eq 'check_each_index') {
          $self_th->compiler->_die_unimplemented_clause($cd);
      } elsif ($which eq 'check_each_elem') {
          $self_th->compiler->_die_unimplemented_clause($cd);
      } elsif ($which eq 'uniq') {
          $self_th->compiler->_die_unimplemented_clause($cd);
      } elsif ($which eq 'exists') {
          $self_th->compiler->_die_unimplemented_clause($cd);
      }
  }
  
  sub clause_elems {
      my ($self_th, $cd) = @_;
      my $c  = $self_th->compiler;
      my $cv = $cd->{cl_value};
      my $dt = $cd->{data_term};
  
      local $cd->{_subdata_level} = $cd->{_subdata_level} + 1;
      my $use_dpath = $cd->{args}{return_type} ne 'bool';
  
      my $jccl;
      {
          local $cd->{ccls} = [];
  
          my $cdef = $cd->{clset}{"elems.create_default"} // 1;
          delete $cd->{uclset}{"elems.create_default"};
  
          for my $i (0..@$cv-1) {
              local $cd->{spath} = [@{$cd->{spath}}, $i];
              my $sch = $c->main->normalize_schema($cv->[$i]);
              my $edt = "$dt\[$i]";
              my %iargs = %{$cd->{args}};
              $iargs{outer_cd}             = $cd;
              $iargs{data_name}            = "$cd->{args}{data_name}_$i";
              $iargs{data_term}            = $edt;
              $iargs{schema}               = $sch;
              $iargs{schema_is_normalized} = 1;
              $iargs{indent_level}++;
              my $icd = $c->compile(%iargs);
              my @code = (
                  ($c->indent_str($cd), "(_sahv_dpath[-1] = $i),\n") x !!$use_dpath,
                  $icd->{result}, "\n",
              );
              my $ires = join("", @code);
              local $cd->{_debug_ccl_note} = "elem: $i";
              if ($cdef && defined($sch->[1]{default})) {
                  $c->add_ccl($cd, $ires);
              } else {
                  $c->add_ccl($cd, "($dt).length < ".($i+1)." || ($ires)");
              }
          }
          $jccl = $c->join_ccls(
              $cd, $cd->{ccls}, {err_msg => ''});
      }
      $c->add_ccl($cd, $jccl, {subdata=>1});
  }
  
  1;
  
  __END__
  
DATA_SAH_COMPILER_JS_TH_ARRAY

$fatpacked{"Data/Sah/Compiler/js/TH/bool.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'DATA_SAH_COMPILER_JS_TH_BOOL';
  package Data::Sah::Compiler::js::TH::bool;
  
  our $DATE = '2015-04-14'; 
  our $VERSION = '0.51'; 
  
  use 5.010;
  use strict;
  use warnings;
  
  use Mo qw(build default);
  use Role::Tiny::With;
  
  extends 'Data::Sah::Compiler::js::TH';
  with 'Data::Sah::Type::bool';
  
  sub handle_type {
      my ($self, $cd) = @_;
      my $c = $self->compiler;
  
      my $dt = $cd->{data_term};
      $cd->{_ccl_check_type} = "typeof($dt)=='boolean' || typeof($dt)=='number' || typeof($dt)=='string'";
  }
  
  sub superclause_comparable {
      my ($self, $which, $cd) = @_;
      my $c  = $self->compiler;
      my $ct = $cd->{cl_term};
      my $dt = $cd->{data_term};
  
      if ($which eq 'is') {
          $c->add_ccl($cd, "!!($dt) == !!($ct)");
      } elsif ($which eq 'in') {
          $c->add_ccl($cd, "($ct).map(function(x){return !!x}).indexOf(!!($dt)) > -1");
      }
  }
  
  sub superclause_sortable {
      my ($self, $which, $cd) = @_;
      my $c  = $self->compiler;
      my $cv = $cd->{cl_value};
      my $ct = $cd->{cl_term};
      my $dt = $cd->{data_term};
  
      if ($which eq 'min') {
          $c->add_ccl($cd, "!!($dt) >= !!($ct)");
      } elsif ($which eq 'xmin') {
          $c->add_ccl($cd, "!!($dt) > !!($ct)");
      } elsif ($which eq 'max') {
          $c->add_ccl($cd, "!!($dt) <= !!($ct)");
      } elsif ($which eq 'xmax') {
          $c->add_ccl($cd, "!!($dt) < !!($ct)");
      } elsif ($which eq 'between') {
          if ($cd->{cl_is_expr}) {
              $c->add_ccl($cd, "!!($dt) >= !!($ct\->[0]) && ".
                              "!!($dt) <= !!($ct\->[1])");
          } else {
              $c->add_ccl($cd, "!!($dt) >= !!($cv->[0]) && ".
                              "!!($dt) <= !!($cv->[1])");
          }
      } elsif ($which eq 'xbetween') {
          if ($cd->{cl_is_expr}) {
              $c->add_ccl($cd, "!!($dt) > !!($ct\->[0]) && ".
                              "!!($dt) < !!($ct\->[1])");
          } else {
              $c->add_ccl($cd, "!!($dt) > !!($cv->[0]) && ".
                              "!!($dt) < !!($cv->[1])");
          }
      }
  }
  
  sub clause_is_true {
      my ($self, $cd) = @_;
      my $c  = $self->compiler;
      my $ct = $cd->{cl_term};
      my $dt = $cd->{data_term};
  
      $c->add_ccl($cd, "$ct ? !!($dt) : !(".$c->expr_defined($ct).") ? true : !($dt)");
  }
  
  1;
  
  __END__
  
DATA_SAH_COMPILER_JS_TH_BOOL

$fatpacked{"Data/Sah/Compiler/js/TH/buf.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'DATA_SAH_COMPILER_JS_TH_BUF';
  package Data::Sah::Compiler::js::TH::buf;
  
  our $DATE = '2015-04-14'; 
  our $VERSION = '0.51'; 
  
  use 5.010;
  use strict;
  use warnings;
  
  use Mo qw(build default);
  use Role::Tiny::With;
  
  extends 'Data::Sah::Compiler::js::TH::str';
  with 'Data::Sah::Type::buf';
  
  1;
  
  __END__
  
DATA_SAH_COMPILER_JS_TH_BUF

$fatpacked{"Data/Sah/Compiler/js/TH/cistr.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'DATA_SAH_COMPILER_JS_TH_CISTR';
  package Data::Sah::Compiler::js::TH::cistr;
  
  our $DATE = '2015-04-14'; 
  our $VERSION = '0.51'; 
  
  use 5.010;
  use strict;
  use warnings;
  
  use Mo qw(build default);
  use Role::Tiny::With;
  
  extends 'Data::Sah::Compiler::js::TH::str';
  with 'Data::Sah::Type::cistr';
  
  sub before_all_clauses {
      my ($self, $cd) = @_;
      my $c = $self->compiler;
      my $dt = $cd->{data_term};
  
  
      $self->set_tmp_data_term($cd, "typeof($dt)=='number' ? ''+$dt : typeof($dt)=='string' ? ($dt).toLowerCase() : $dt");
  }
  
  sub after_all_clauses {
      my ($self, $cd) = @_;
      my $c = $self->compiler;
      my $dt = $cd->{data_term};
  
      $self->restore_data_term($cd);
  }
  
  sub superclause_comparable {
      my ($self, $which, $cd) = @_;
      my $c  = $self->compiler;
      my $ct = $cd->{cl_term};
      my $dt = $cd->{data_term};
  
      if ($which eq 'is') {
          $c->add_ccl($cd, "$dt == ($ct).toLowerCase()");
      } elsif ($which eq 'in') {
          $c->add_ccl($cd, "($ct).map(function(x) { return x.toLowerCase() }).indexOf($dt) > -1");
      }
  }
  
  sub superclause_sortable {
      my ($self, $which, $cd) = @_;
      my $c  = $self->compiler;
      my $cv = $cd->{cl_value};
      my $ct = $cd->{cl_term};
      my $dt = $cd->{data_term};
  
      if ($which eq 'min') {
          $c->add_ccl($cd, "$dt >= ($ct).toLowerCase()");
      } elsif ($which eq 'xmin') {
          $c->add_ccl($cd, "$dt > ($ct).toLowerCase()");
      } elsif ($which eq 'max') {
          $c->add_ccl($cd, "$dt <= ($ct).toLowerCase()");
      } elsif ($which eq 'xmax') {
          $c->add_ccl($cd, "$dt < ($ct).toLowerCase()");
      } elsif ($which eq 'between') {
          if ($cd->{cl_is_expr}) {
              $c->add_ccl($cd, "$dt >= (($ct)[0]).toLowerCase() && ".
                              "$dt <= (($ct)[1]).toLowerCase()");
          } else {
              $c->add_ccl($cd, "$dt >= ".$c->literal(lc $cv->[0]).
                              " && $dt <= ".$c->literal(lc $cv->[1]));
          }
      } elsif ($which eq 'xbetween') {
          if ($cd->{cl_is_expr}) {
              $c->add_ccl($cd, "$dt > (($ct)[0]).toLowerCase() && ".
                              "$dt < (($ct)[1]).toLowerCase()");
          } else {
              $c->add_ccl($cd, "$dt > ".$c->literal(lc $cv->[0]).
                              " && $dt < ".$c->literal(lc $cv->[1]));
          }
      }
  }
  
  sub superclause_has_elems {
      my ($self_th, $which, $cd) = @_;
      my $c  = $self_th->compiler;
      my $cv = $cd->{cl_value};
      my $ct = $cd->{cl_term};
      my $dt = $cd->{data_term};
  
      if ($which eq 'has') {
          $c->add_ccl($cd, "($dt).indexOf(($ct).toLowerCase()) > -1");
      } else {
          $self_th->SUPER::superclause_has_elems($which, $cd);
      }
  }
  
  sub clause_match {
      my ($self, $cd) = @_;
      my $c  = $self->compiler;
      my $cv = $cd->{cl_value};
      my $ct = $cd->{cl_term};
      my $dt = $cd->{data_term};
  
      my $re;
      if ($cd->{cl_is_expr}) {
          $re = $ct;
      } else {
          $re = $c->_str2reliteral($cd, $cv);
      }
  
      $c->add_ccl($cd, join(
          "",
          "(function(){ ",
          "var _sahv_match = true; ",
          "try { _sahv_match = ($dt).match(RegExp($re)) } catch(e) { if (e.name=='SyntaxError') _sahv_match = false } ",
          ($cd->{cl_is_expr} ?
               "return _sahv_match == !!($ct);" :
                   "return ".($cv ? '':'!')."!!_sahv_match;"),
          "} )()",
      ));
  }
  
  1;
  
  __END__
  
DATA_SAH_COMPILER_JS_TH_CISTR

$fatpacked{"Data/Sah/Compiler/js/TH/code.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'DATA_SAH_COMPILER_JS_TH_CODE';
  package Data::Sah::Compiler::js::TH::code;
  
  our $DATE = '2015-04-14'; 
  our $VERSION = '0.51'; 
  
  use 5.010;
  use strict;
  use warnings;
  
  use Mo qw(build default);
  use Role::Tiny::With;
  
  extends 'Data::Sah::Compiler::js::TH';
  with 'Data::Sah::Type::code';
  
  sub handle_type {
      my ($self, $cd) = @_;
      my $c = $self->compiler;
  
      my $dt = $cd->{data_term};
      $cd->{_ccl_check_type} = "typeof($dt)=='function'";
  }
  
  1;
  
  __END__
  
DATA_SAH_COMPILER_JS_TH_CODE

$fatpacked{"Data/Sah/Compiler/js/TH/date.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'DATA_SAH_COMPILER_JS_TH_DATE';
  package Data::Sah::Compiler::js::TH::date;
  
  our $DATE = '2015-04-14'; 
  our $VERSION = '0.51'; 
  
  use 5.010;
  use strict;
  use warnings;
  
  use Mo qw(build default);
  use Role::Tiny::With;
  use Scalar::Util qw(blessed looks_like_number);
  
  extends 'Data::Sah::Compiler::js::TH';
  with 'Data::Sah::Type::date';
  
  my $epoch_low  = 10**8;
  my $epoch_high = 2**31;
  
  
  sub expr_coerce_term {
      my ($self, $cd, $t) = @_;
  
      join(
          '',
          "(",
          "($t instanceof Date) ? $t : ",
          "typeof($t)=='number' ? (new Date($t * 1000)) : ",
          "parseFloat($t)==$t   ? (new Date(parseFloat($t)) * 1000) : ",
          "(new Date($t))",
          ")",
      );
  }
  
  sub expr_coerce_value {
      my ($self, $cd, $v) = @_;
  
      if (blessed($v) && $v->isa('DateTime')) {
          return join(
              '',
              "(new Date(",
              $v->year, ",",
              $v->month, ",",
              $v->day, ",",
              $v->hour, ",",
              $v->minute, ",",
              $v->second, ",",
              $v->millisecond,
              "))",
          );
      } elsif (looks_like_number($v) && $v >= 10**8 && $v <= 2**31) {
          return "(new Date($v*1000))";
      } elsif ($v =~ /\A([0-9]{4})-([0-9]{2})-([0-9]{2})T([0-9]{2}):([0-9]{2}):([0-9]{2})Z\z/) {
          require DateTime;
          eval { DateTime->new(year=>$1, month=>$2, day=>$3,
                               hour=>$4, minute=>$5, second=>$6,
                               time_zone=>'UTC') ; 1 }
              or die "Invalid date literal '$v': $@";
          return "(new Date(\"$v\"))";
      } elsif ($v =~ /\A([0-9]{4})-([0-9]{2})-([0-9]{2})\z/) {
          require DateTime;
          eval { DateTime->new(year=>$1, month=>$2, day=>$3) ; 1 }
              or die "Invalid date literal '$v': $@";
          return "(new Date(\"$v\"))";
      } else {
          die "Invalid date literal '$v'";
      }
  }
  
  sub handle_type {
      my ($self, $cd) = @_;
  
      my $dt = $cd->{data_term};
      $cd->{_ccl_check_type} = join(
          '',
          "(",
          "typeof($dt)=='number' ? ($dt >= $epoch_low && $dt <= $epoch_high) : ",
          "parseFloat($dt)==$dt ? (parseFloat($dt) >= $epoch_low && parseFloat($dt) <= $epoch_high) : ",
          "!isNaN((new Date($dt)).getYear())",
          ")",
      );
  }
  
  sub before_all_clauses {
      my ($self, $cd) = @_;
      my $c = $self->compiler;
      my $dt = $cd->{data_term};
  
  
      $self->set_tmp_data_term($cd, $self->expr_coerce_term($cd, $dt));
  }
  
  sub after_all_clauses {
      my ($self, $cd) = @_;
      my $c = $self->compiler;
      my $dt = $cd->{data_term};
  
      $self->restore_data_term($cd);
  }
  
  sub superclause_comparable {
      my ($self, $which, $cd) = @_;
      my $c  = $self->compiler;
      my $cv = $cd->{cl_value};
      my $ct = $cd->{cl_term};
      my $dt = $cd->{data_term};
  
      if ($which eq 'is') {
          if ($cd->{cl_is_expr}) {
              $ct = $self->expr_coerce_term($cd, $ct);
          } else {
              $ct = $self->expr_coerce_value($cd, $cv);
          }
          $c->add_ccl($cd, "+($dt) === +($ct)");
      } elsif ($which eq 'in') {
          $c->add_module('List::Util');
          if ($cd->{cl_is_expr}) {
              $c->_die($cd, "date's in clause with expression not yet supported");
          }
          $ct = '['.join(', ', map { "+(".$self->expr_coerce_value($cd, $_).")" } @$ct).']';
          $c->add_ccl($cd, "($ct).indexOf(+($dt)) > -1");
      }
  }
  
  sub superclause_sortable {
      my ($self, $which, $cd) = @_;
      my $c  = $self->compiler;
      my $cv = $cd->{cl_value};
      my $ct = $cd->{cl_term};
      my $dt = $cd->{data_term};
  
      if ($cd->{cl_is_expr}) {
          $c->_die($cd, "date's comparison with expression not yet supported");
      }
  
      if ($which eq 'min') {
          $c->add_ccl($cd, "+($dt) >= +(".$self->expr_coerce_value($cd, $cv).")");
      } elsif ($which eq 'xmin') {
          $c->add_ccl($cd, "+($dt) > +(".$self->expr_coerce_value($cd, $cv).")");
      } elsif ($which eq 'max') {
          $c->add_ccl($cd, "+($dt) <= +(".$self->expr_coerce_value($cd, $cv).")");
      } elsif ($which eq 'xmax') {
          $c->add_ccl($cd, "+($dt) < +(".$self->expr_coerce_value($cd, $cv).")");
      } elsif ($which eq 'between') {
          $c->add_ccl($cd, "+($dt) >= +(".$self->expr_coerce_value($cd, $cv->[0]).") && ".
                          "+($dt) <= +(".$self->expr_coerce_value($cd, $cv->[1]).")");
      } elsif ($which eq 'xbetween') {
          $c->add_ccl($cd, "+($dt) > +(".$self->expr_coerce_value($cd, $cv->[0]).") && ".
                          "+($dt) < +(".$self->expr_coerce_value($cd, $cv->[1]).")");
      }
  }
  
  1;
  
  __END__
  
DATA_SAH_COMPILER_JS_TH_DATE

$fatpacked{"Data/Sah/Compiler/js/TH/float.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'DATA_SAH_COMPILER_JS_TH_FLOAT';
  package Data::Sah::Compiler::js::TH::float;
  
  our $DATE = '2015-04-14'; 
  our $VERSION = '0.51'; 
  
  use 5.010;
  use strict;
  use warnings;
  
  use Mo qw(build default);
  use Role::Tiny::With;
  
  extends 'Data::Sah::Compiler::js::TH::num';
  with 'Data::Sah::Type::float';
  
  sub handle_type {
      my ($self, $cd) = @_;
      my $c = $self->compiler;
      my $dt = $cd->{data_term};
  
      $cd->{_ccl_check_type} = "(typeof($dt)=='number' || parseFloat($dt)==$dt)";
  }
  
  sub clause_is_nan {
      my ($self, $cd) = @_;
      my $c  = $self->compiler;
      my $ct = $cd->{cl_term};
      my $dt = $cd->{data_term};
  
      if ($cd->{cl_is_expr}) {
          $c->add_ccl(
              $cd,
              join(
                  "",
                  "$ct ? isNaN($dt) : ",
                  $self->expr_defined($ct), " ? !isNaN($dt) : true",
              )
          );
      } else {
          if ($cd->{cl_value}) {
              $c->add_ccl($cd, "isNaN($dt)");
          } elsif (defined $cd->{cl_value}) {
              $c->add_ccl($cd, "!isNaN($dt)");
          }
      }
  }
  
  sub clause_is_pos_inf {
      my ($self, $cd) = @_;
      my $c  = $self->compiler;
      my $ct = $cd->{cl_term};
      my $dt = $cd->{data_term};
  
      if ($cd->{cl_is_expr}) {
          $c->add_ccl(
              $cd,
              join(
                  "",
                  "$ct ? $dt == Infinity : ",
                  $self->expr_defined($ct), " ? $dt != Infinity : true",
              )
          );
      } else {
          if ($cd->{cl_value}) {
              $c->add_ccl($cd, "$dt == Infinity");
          } elsif (defined $cd->{cl_value}) {
              $c->add_ccl($cd, "$dt != Infinity");
          }
      }
  }
  
  sub clause_is_neg_inf {
      my ($self, $cd) = @_;
      my $c  = $self->compiler;
      my $ct = $cd->{cl_term};
      my $dt = $cd->{data_term};
  
      if ($cd->{cl_is_expr}) {
          $c->add_ccl(
              $cd,
              join(
                  "",
                  "$ct ? $dt == -Infinity : ",
                  $self->expr_defined($ct), " ? $dt != -Infinity : true",
              )
          );
      } else {
          if ($cd->{cl_value}) {
              $c->add_ccl($cd, "$dt == -Infinity");
          } elsif (defined $cd->{cl_value}) {
              $c->add_ccl($cd, "$dt != -Infinity");
          }
      }
  }
  
  sub clause_is_inf {
      my ($self, $cd) = @_;
      my $c  = $self->compiler;
      my $ct = $cd->{cl_term};
      my $dt = $cd->{data_term};
  
      if ($cd->{cl_is_expr}) {
          $c->add_ccl(
              $cd,
              join(
                  "",
                  "$ct ? Math.abs($dt) == Infinity : ",
                  $self->expr_defined($ct), " ? Math.abs($dt) != Infinity : true",
              )
          );
      } else {
          if ($cd->{cl_value}) {
              $c->add_ccl($cd, "Math.abs($dt) == Infinity");
          } elsif (defined $cd->{cl_value}) {
              $c->add_ccl($cd, "Math.abs($dt) != Infinity");
          }
      }
  }
  
  1;
  
  __END__
  
DATA_SAH_COMPILER_JS_TH_FLOAT

$fatpacked{"Data/Sah/Compiler/js/TH/hash.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'DATA_SAH_COMPILER_JS_TH_HASH';
  package Data::Sah::Compiler::js::TH::hash;
  
  our $DATE = '2015-04-14'; 
  our $VERSION = '0.51'; 
  
  use 5.010;
  use strict;
  use warnings;
  
  use Mo qw(build default);
  use Role::Tiny::With;
  
  extends 'Data::Sah::Compiler::js::TH';
  with 'Data::Sah::Type::hash';
  
  sub handle_type {
      my ($self, $cd) = @_;
      my $c = $self->compiler;
  
      my $dt = $cd->{data_term};
      $cd->{_ccl_check_type} = "typeof($dt)=='object' && !($dt instanceof Array)";
  }
  
  my $STR = "JSON.stringify";
  
  sub superclause_comparable {
      my ($self, $which, $cd) = @_;
      my $c  = $self->compiler;
      my $ct = $cd->{cl_term};
      my $dt = $cd->{data_term};
  
      if ($which eq 'is') {
          $c->add_ccl($cd, "$STR($dt) == $STR($ct)");
      } elsif ($which eq 'in') {
          $c->add_ccl(
              $cd,
              "!($ct).every(function(x){return $STR(x) != $STR($dt) })");
      }
  }
  
  sub superclause_has_elems {
      my ($self_th, $which, $cd) = @_;
      my $c  = $self_th->compiler;
      my $cv = $cd->{cl_value};
      my $ct = $cd->{cl_term};
      my $dt = $cd->{data_term};
  
  
      if ($which eq 'len') {
          $c->add_ccl($cd, "Object.keys($dt).length == $ct");
      } elsif ($which eq 'min_len') {
          $c->add_ccl($cd, "Object.keys($dt).length >= $ct");
      } elsif ($which eq 'max_len') {
          $c->add_ccl($cd, "Object.keys($dt).length <= $ct");
      } elsif ($which eq 'len_between') {
          if ($cd->{cl_is_expr}) {
              $c->add_ccl(
                  $cd, "Object.keys($dt).length >= $ct\->[0] && ".
                      "Object.keys($dt).length >= $ct\->[1]");
          } else {
              $c->add_ccl(
                  $cd, "Object.keys($dt).length >= $cv->[0] && ".
                      "Object.keys($dt).length <= $cv->[1]");
          }
      } elsif ($which eq 'has') {
          $c->add_ccl(
              $cd,
              "!Object.keys($dt).every(function(x){return $STR(($dt)[x]) != $STR($ct) })");
      } elsif ($which eq 'each_index') {
          $self_th->gen_each($cd, "Object.keys($dt)", '_sahv_idx', '_sahv_idx');
      } elsif ($which eq 'each_elem') {
          $self_th->gen_each($cd, "Object.keys($dt)", '_sahv_idx', "$dt\[_sahv_idx]");
      } elsif ($which eq 'check_each_index') {
          $self_th->compiler->_die_unimplemented_clause($cd);
      } elsif ($which eq 'check_each_elem') {
          $self_th->compiler->_die_unimplemented_clause($cd);
      } elsif ($which eq 'uniq') {
          $self_th->compiler->_die_unimplemented_clause($cd);
      } elsif ($which eq 'exists') {
          $self_th->compiler->_die_unimplemented_clause($cd);
      }
  }
  
  sub _clause_keys_or_re_keys {
      my ($self_th, $which, $cd) = @_;
      my $c  = $self_th->compiler;
      my $cv = $cd->{cl_value};
      my $dt = $cd->{data_term};
  
      local $cd->{_subdata_level} = $cd->{_subdata_level} + 1;
      my $use_dpath = $cd->{args}{return_type} ne 'bool';
  
  
      my $jccl;
      {
          local $cd->{ccls} = [];
  
          my $chk_x_unknown;
          my $filt_x_unknown;
          if ($which eq 'keys') {
              my $lit_valid_keys = $c->literal([keys %$cv]);
              $chk_x_unknown  = "$lit_valid_keys.indexOf(x) > -1";
              $filt_x_unknown = "$lit_valid_keys.indexOf(x) == -1";
          } else {
              my $lit_regexes = "[".
                  join(",", map { $c->_str2reliteral($cd, $_) }
                           keys %$cv)."]";
              $chk_x_unknown  = "!$lit_regexes.every(function(y) { return !x.match(y) })";
              $filt_x_unknown = "$lit_regexes.every(function(y) { return !x.match(y) })";
          }
  
          if ($cd->{clset}{"$which.restrict"} // 1) {
              local $cd->{_debug_ccl_note} = "$which.restrict";
              $c->add_ccl(
                  $cd,
                  "Object.keys($dt).every(function(x){ return $chk_x_unknown })",
                  {
                      err_msg => 'TMP1',
                      err_expr => join(
                          "",
                          $c->literal($c->_xlt(
                              $cd, "hash contains ".
                                  "unknown field(s) (%s)")),
                          '.replace("%s", ',
                          "Object.keys($dt).filter(function(x){ return $filt_x_unknown }).join(', ')",
                          ')',
                      ),
                  },
              );
          }
          delete $cd->{uclset}{"$which.restrict"};
  
          my $cdef;
          if ($which eq 'keys') {
              $cdef = $cd->{clset}{"keys.create_default"} // 1;
              delete $cd->{uclset}{"keys.create_default"};
          }
  
          my $nkeys = scalar(keys %$cv);
          my $i = 0;
          for my $k (sort keys %$cv) {
              my $kre = $c->_str2reliteral($cd, $k);
              local $cd->{spath} = [@{ $cd->{spath} }, $k];
              ++$i;
              my $sch = $c->main->normalize_schema($cv->{$k});
              my $kdn = $k; $kdn =~ s/\W+/_/g;
              my $klit = $which eq 're_keys' ? 'x' : $c->literal($k);
              my $kdt = "$dt\[$klit]";
              my %iargs = %{$cd->{args}};
              $iargs{outer_cd}             = $cd;
              $iargs{data_name}            = $kdn;
              $iargs{data_term}            = $kdt;
              $iargs{schema}               = $sch;
              $iargs{schema_is_normalized} = 1;
              $iargs{indent_level}++;
              my $icd = $c->compile(%iargs);
  
              my $sdef = $cdef && defined($sch->[1]{default});
  
              $c->add_var($cd, '_sahv_stack', []) if $use_dpath;
  
              my @code = (
                  ($c->indent_str($cd), "(_sahv_dpath.push(null), _sahv_stack.push(null), _sahv_stack[_sahv_stack.length-1] = \n")
                      x !!($use_dpath && $i == 1),
  
                  ("Object.keys($dt).every(function(x) { return (")
                      x !!($which eq 're_keys'),
  
                  $which eq 're_keys' ? "!x.match($kre) || (" :
                      ($sdef ? "" : "!$dt.hasOwnProperty($klit) || ("),
  
                  ($c->indent_str($cd), "(_sahv_dpath[_sahv_dpath.length-1] = ".
                       ($which eq 're_keys' ? 'x' : $klit)."),\n") x !!$use_dpath,
                  $icd->{result}, "\n",
  
                  $which eq 're_keys' || !$sdef ? ")" : "",
  
                  (") })")
                      x !!($which eq 're_keys'),
  
                  ($c->indent_str($cd), "), _sahv_dpath.pop(), _sahv_stack.pop()\n")
                      x !!($use_dpath && $i == $nkeys),
              );
              my $ires = join("", @code);
              local $cd->{_debug_ccl_note} = "$which: ".$c->literal($k);
              $c->add_ccl($cd, $ires);
          }
          $jccl = $c->join_ccls(
              $cd, $cd->{ccls}, {err_msg => ''});
      }
      $c->add_ccl($cd, $jccl, {});
  }
  
  sub clause_keys {
      my ($self, $cd) = @_;
      $self->_clause_keys_or_re_keys('keys', $cd);
  }
  
  sub clause_re_keys {
      my ($self, $cd) = @_;
      $self->_clause_keys_or_re_keys('re_keys', $cd);
  }
  
  sub clause_req_keys {
      my ($self, $cd) = @_;
      my $c  = $self->compiler;
      my $ct = $cd->{cl_term};
      my $dt = $cd->{data_term};
  
      $c->add_ccl(
        $cd,
        "($ct).every(function(x){ return Object.keys($dt).indexOf(x) > -1 })", 
        {
          err_msg => 'TMP',
          err_expr => join(
              "",
              $c->literal($c->_xlt(
                  $cd, "hash has missing required field(s) (%s)")),
              '.replace("%s", ',
              "($ct).filter(function(x){ return Object.keys($dt).indexOf(x) == -1 }).join(', ')",
              ')',
          ),
        }
      );
  }
  
  sub clause_allowed_keys {
      my ($self, $cd) = @_;
      my $c  = $self->compiler;
      my $ct = $cd->{cl_term};
      my $dt = $cd->{data_term};
  
      $c->add_ccl(
        $cd,
        "Object.keys($dt).every(function(x){ return ($ct).indexOf(x) > -1 })", 
        {
          err_msg => 'TMP',
          err_expr => join(
              "",
              $c->literal($c->_xlt(
                  $cd, "hash contains non-allowed field(s) (%s)")),
              '.replace("%s", ',
              "Object.keys($dt).filter(function(x){ return ($ct).indexOf(x) == -1 }).join(', ')",
              ')',
          ),
        }
      );
  }
  
  sub clause_allowed_keys_re {
      my ($self, $cd) = @_;
      my $c  = $self->compiler;
      my $cv = $cd->{cl_value};
      my $dt = $cd->{data_term};
  
      if ($cd->{cl_is_expr}) {
          $c->_die_unimplemented_clause($cd, "with expr");
      }
  
      my $re = $c->_str2reliteral($cd, $cv);
      $c->add_ccl(
        $cd,
        "Object.keys($dt).every(function(x){ return x.match(RegExp($re)) })",
        {
          err_msg => 'TMP',
          err_expr => join(
              "",
              $c->literal($c->_xlt(
                  $cd, "hash contains non-allowed field(s) (%s)")),
              '.replace("%s", ',
              "Object.keys($dt).filter(function(x){ return !x.match(RegExp($re)) }).join(', ')",
              ')',
          ),
        }
      );
  }
  
  sub clause_forbidden_keys {
      my ($self, $cd) = @_;
      my $c  = $self->compiler;
      my $ct = $cd->{cl_term};
      my $dt = $cd->{data_term};
  
      $c->add_ccl(
        $cd,
        "Object.keys($dt).every(function(x){ return ($ct).indexOf(x) == -1 })", 
        {
          err_msg => 'TMP',
          err_expr => join(
              "",
              $c->literal($c->_xlt(
                  $cd, "hash contains forbidden field(s) (%s)")),
              '.replace("%s", ',
              "Object.keys($dt).filter(function(x){ return ($ct).indexOf(x) > -1 }).join(', ')",
              ')',
          ),
        }
      );
  }
  
  sub clause_forbidden_keys_re {
      my ($self, $cd) = @_;
      my $c  = $self->compiler;
      my $cv = $cd->{cl_value};
      my $dt = $cd->{data_term};
  
      if ($cd->{cl_is_expr}) {
          $c->_die_unimplemented_clause($cd, "with expr");
      }
  
      my $re = $c->_str2reliteral($cd, $cv);
      $c->add_ccl(
        $cd,
        "Object.keys($dt).every(function(x){ return !x.match(RegExp($re)) })",
        {
          err_msg => 'TMP',
          err_expr => join(
              "",
              $c->literal($c->_xlt(
                  $cd, "hash contains forbidden field(s) (%s)")),
              '.replace("%s", ',
              "Object.keys($dt).filter(function(x){ return x.match(RegExp($re)) }).join(', ')",
              ')',
          ),
        }
      );
  }
  
  1;
  
  __END__
  
DATA_SAH_COMPILER_JS_TH_HASH

$fatpacked{"Data/Sah/Compiler/js/TH/int.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'DATA_SAH_COMPILER_JS_TH_INT';
  package Data::Sah::Compiler::js::TH::int;
  
  our $DATE = '2015-04-14'; 
  our $VERSION = '0.51'; 
  
  use 5.010;
  use strict;
  use warnings;
  
  use Mo qw(build default);
  use Role::Tiny::With;
  
  extends 'Data::Sah::Compiler::js::TH::num';
  with 'Data::Sah::Type::int';
  
  sub handle_type {
      my ($self, $cd) = @_;
      my $c = $self->compiler;
      my $dt = $cd->{data_term};
  
      $cd->{_ccl_check_type} = "(typeof($dt)=='number' && Math.round($dt)==$dt || parseInt($dt)==$dt)";
  }
  
  sub clause_div_by {
      my ($self, $cd) = @_;
      my $c  = $self->compiler;
      my $ct = $cd->{cl_term};
      my $dt = $cd->{data_term};
  
      $c->add_ccl($cd, "$dt % $ct == 0");
  }
  
  sub clause_mod {
      my ($self, $cd) = @_;
      my $c  = $self->compiler;
      my $ct = $cd->{cl_term};
      my $dt = $cd->{data_term};
  
      $c->add_ccl($cd, "$dt % $ct\[0] == $ct\[1]");
  }
  
  1;
  
  __END__
  
DATA_SAH_COMPILER_JS_TH_INT

$fatpacked{"Data/Sah/Compiler/js/TH/num.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'DATA_SAH_COMPILER_JS_TH_NUM';
  package Data::Sah::Compiler::js::TH::num;
  
  our $DATE = '2015-04-14'; 
  our $VERSION = '0.51'; 
  
  use 5.010;
  use strict;
  use warnings;
  
  use Mo qw(build default);
  use Role::Tiny::With;
  
  extends 'Data::Sah::Compiler::js::TH';
  with 'Data::Sah::Type::num';
  
  sub handle_type {
      my ($self, $cd) = @_;
      my $c = $self->compiler;
      my $dt = $cd->{data_term};
  
      $cd->{_ccl_check_type} = "(typeof($dt)=='number' || parseFloat($dt)==$dt)";
  }
  
  sub before_all_clauses {
      my ($self, $cd) = @_;
      my $c = $self->compiler;
      my $dt = $cd->{data_term};
  
  
      $self->set_tmp_data_term(
          $cd, "typeof($dt)=='number' ? $dt : parseFloat($dt)");
  }
  
  sub after_all_clauses {
      my ($self, $cd) = @_;
      my $c = $self->compiler;
      my $dt = $cd->{data_term};
  
      $self->restore_data_term($cd);
  }
  
  sub superclause_comparable {
      my ($self, $which, $cd) = @_;
      my $c  = $self->compiler;
      my $ct = $cd->{cl_term};
      my $dt = $cd->{data_term};
  
      if ($which eq 'is') {
          $c->add_ccl($cd, "$dt == $ct");
      } elsif ($which eq 'in') {
          $c->add_ccl($cd, "($ct).indexOf($dt) > -1");
      }
  }
  
  sub superclause_sortable {
      my ($self, $which, $cd) = @_;
      my $c  = $self->compiler;
      my $cv = $cd->{cl_value};
      my $ct = $cd->{cl_term};
      my $dt = $cd->{data_term};
  
      if ($which eq 'min') {
          $c->add_ccl($cd, "$dt >= $ct");
      } elsif ($which eq 'xmin') {
          $c->add_ccl($cd, "$dt > $ct");
      } elsif ($which eq 'max') {
          $c->add_ccl($cd, "$dt <= $ct");
      } elsif ($which eq 'xmax') {
          $c->add_ccl($cd, "$dt < $ct");
      } elsif ($which eq 'between') {
          if ($cd->{cl_is_expr}) {
              $c->add_ccl($cd, "$dt >= $ct\[0] && $dt <= $ct\[1]");
          } else {
              $c->add_ccl($cd, "$dt >= $cv->[0] && $dt <= $cv->[1]");
          }
      } elsif ($which eq 'xbetween') {
          if ($cd->{cl_is_expr}) {
              $c->add_ccl($cd, "$dt > $ct\[0] && $dt < $ct\[1]");
          } else {
              $c->add_ccl($cd, "$dt > $cv->[0] && $dt < $cv->[1]");
          }
      }
  }
  
  1;
  
  __END__
  
DATA_SAH_COMPILER_JS_TH_NUM

$fatpacked{"Data/Sah/Compiler/js/TH/obj.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'DATA_SAH_COMPILER_JS_TH_OBJ';
  package Data::Sah::Compiler::js::TH::obj;
  
  our $DATE = '2015-04-14'; 
  our $VERSION = '0.51'; 
  
  use 5.010;
  use strict;
  use warnings;
  
  use Mo qw(build default);
  use Role::Tiny::With;
  
  extends 'Data::Sah::Compiler::js::TH';
  with 'Data::Sah::Type::obj';
  
  sub handle_type {
      my ($self, $cd) = @_;
      my $c = $self->compiler;
      my $dt = $cd->{data_term};
  
      $cd->{_ccl_check_type} = "typeof($dt) == 'object'";
  }
  
  sub clause_can {
      my ($self, $cd) = @_;
      my $c  = $self->compiler;
      my $ct = $cd->{cl_term};
      my $dt = $cd->{data_term};
  
      $c->add_ccl($cd, "typeof($dt\[$ct])=='function'");
  }
  
  sub clause_isa {
      my ($self, $cd) = @_;
      my $c  = $self->compiler;
      my $ct = $cd->{cl_term};
      my $dt = $cd->{data_term};
  
      $c->_die_unimplemented_clause($cd);
  }
  
  1;
  
  __END__
  
DATA_SAH_COMPILER_JS_TH_OBJ

$fatpacked{"Data/Sah/Compiler/js/TH/re.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'DATA_SAH_COMPILER_JS_TH_RE';
  package Data::Sah::Compiler::js::TH::re;
  
  our $DATE = '2015-04-14'; 
  our $VERSION = '0.51'; 
  
  use 5.010;
  use strict;
  use warnings;
  
  use Mo qw(build default);
  use Role::Tiny::With;
  
  extends 'Data::Sah::Compiler::js::TH';
  with 'Data::Sah::Type::re';
  
  
  sub handle_type {
      my ($self, $cd) = @_;
      my $c = $self->compiler;
  
      my $dt = $cd->{data_term};
      $cd->{_ccl_check_type} = "$dt instanceof RegExp";
  }
  
  1;
  
  __END__
  
DATA_SAH_COMPILER_JS_TH_RE

$fatpacked{"Data/Sah/Compiler/js/TH/str.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'DATA_SAH_COMPILER_JS_TH_STR';
  package Data::Sah::Compiler::js::TH::str;
  
  our $DATE = '2015-04-14'; 
  our $VERSION = '0.51'; 
  
  use 5.010;
  use strict;
  use warnings;
  
  use Mo qw(build default);
  use Role::Tiny::With;
  
  extends 'Data::Sah::Compiler::js::TH';
  with 'Data::Sah::Type::str';
  
  sub handle_type {
      my ($self, $cd) = @_;
      my $c = $self->compiler;
  
      my $dt = $cd->{data_term};
      $cd->{_ccl_check_type} = "typeof($dt)=='string' || typeof($dt)=='number'";
  }
  
  sub before_all_clauses {
      my ($self, $cd) = @_;
      my $c = $self->compiler;
      my $dt = $cd->{data_term};
  
  
      $self->set_tmp_data_term($cd, "typeof($dt)=='number' ? ''+$dt : $dt");
  }
  
  sub after_all_clauses {
      my ($self, $cd) = @_;
      my $c = $self->compiler;
      my $dt = $cd->{data_term};
  
      $self->restore_data_term($cd);
  }
  
  sub superclause_comparable {
      my ($self, $which, $cd) = @_;
      my $c  = $self->compiler;
      my $ct = $cd->{cl_term};
      my $dt = $cd->{data_term};
  
      if ($which eq 'is') {
          $c->add_ccl($cd, "$dt == $ct");
      } elsif ($which eq 'in') {
          $c->add_ccl($cd, "($ct).indexOf($dt) > -1");
      }
  }
  
  sub superclause_sortable {
      my ($self, $which, $cd) = @_;
      my $c  = $self->compiler;
      my $cv = $cd->{cl_value};
      my $ct = $cd->{cl_term};
      my $dt = $cd->{data_term};
  
      if ($which eq 'min') {
          $c->add_ccl($cd, "$dt >= $ct");
      } elsif ($which eq 'xmin') {
          $c->add_ccl($cd, "$dt > $ct");
      } elsif ($which eq 'max') {
          $c->add_ccl($cd, "$dt <= $ct");
      } elsif ($which eq 'xmax') {
          $c->add_ccl($cd, "$dt < $ct");
      } elsif ($which eq 'between') {
          if ($cd->{cl_is_expr}) {
              $c->add_ccl($cd, "$dt >= ($ct)[0] && $dt <= ($ct)[1]");
          } else {
              $c->add_ccl($cd, "$dt >= ".$c->literal($cv->[0]).
                              " && $dt <= ".$c->literal($cv->[1]));
          }
      } elsif ($which eq 'xbetween') {
          if ($cd->{cl_is_expr}) {
              $c->add_ccl($cd, "$dt > ($ct)[0] && $dt < ($ct)[1]");
          } else {
              $c->add_ccl($cd, "$dt > ".$c->literal($cv->[0]).
                              " && $dt < ".$c->literal($cv->[1]));
          }
      }
  }
  
  sub superclause_has_elems {
      my ($self_th, $which, $cd) = @_;
      my $c  = $self_th->compiler;
      my $cv = $cd->{cl_value};
      my $ct = $cd->{cl_term};
      my $dt = $cd->{data_term};
  
      if ($which eq 'len') {
          $c->add_ccl($cd, "($dt).length == $ct");
      } elsif ($which eq 'min_len') {
          $c->add_ccl($cd, "($dt).length >= $ct");
      } elsif ($which eq 'max_len') {
          $c->add_ccl($cd, "($dt).length <= $ct");
      } elsif ($which eq 'len_between') {
          if ($cd->{cl_is_expr}) {
              $c->add_ccl(
                  $cd, "($dt).length >= ($ct)[0] && ".
                      "($dt).length >= ($ct)[1]");
          } else {
              $c->add_ccl(
                  $cd, "($dt).length >= $cv->[0] && ".
                      "($dt).length <= $cv->[1]");
          }
      } elsif ($which eq 'has') {
          $c->add_ccl($cd, "($dt).indexOf($ct) > -1");
      } elsif ($which eq 'each_index') {
          $self_th->gen_each($cd, $c->expr_array_0_nmin1("($dt).length"), '_sahv_idx', '_sahv_idx');
      } elsif ($which eq 'each_elem') {
          $self_th->gen_each($cd, $c->expr_array_0_nmin1("($dt).length"), '_sahv_idx', "$dt.charAt(_sahv_idx)");
      } elsif ($which eq 'check_each_index') {
          $self_th->compiler->_die_unimplemented_clause($cd);
      } elsif ($which eq 'check_each_elem') {
          $self_th->compiler->_die_unimplemented_clause($cd);
      } elsif ($which eq 'uniq') {
          $self_th->compiler->_die_unimplemented_clause($cd);
      } elsif ($which eq 'exists') {
          $self_th->compiler->_die_unimplemented_clause($cd);
      }
  }
  
  sub clause_encoding {
      my ($self, $cd) = @_;
      my $c  = $self->compiler;
      my $cv = $cd->{cl_value};
      my $ct = $cd->{cl_term};
      my $dt = $cd->{data_term};
  
      $c->_die($cd, "Only 'utf8' encoding is currently supported")
          unless $cv eq 'utf8';
  }
  
  sub clause_match {
      my ($self, $cd) = @_;
      my $c  = $self->compiler;
      my $cv = $cd->{cl_value};
      my $ct = $cd->{cl_term};
      my $dt = $cd->{data_term};
  
      my $re;
      if ($cd->{cl_is_expr}) {
          $re = $ct;
      } else {
          $re = $c->_str2reliteral($cd, $cv);
      }
  
      $c->add_ccl($cd, join(
          "",
          "(function(){ ",
          "var _sahv_match = true; ",
          "try { _sahv_match = ($dt).match(RegExp($re)) } catch(e) { if (e.name=='SyntaxError') _sahv_match = false } ",
          ($cd->{cl_is_expr} ?
               "return _sahv_match == !!($ct);" :
                   "return ".($cv ? '':'!')."!!_sahv_match;"),
          "} )()",
      ));
  }
  
  sub clause_is_re {
      my ($self, $cd) = @_;
      my $c  = $self->compiler;
      my $cv = $cd->{cl_value};
      my $ct = $cd->{cl_term};
      my $dt = $cd->{data_term};
  
      $c->add_ccl($cd, join(
          "",
          "(function(){ var _sahv_is_re = true; ",
          "try { RegExp($dt) } catch(e) { if (e.name=='SyntaxError') _sahv_is_re = false } ",
          ($cd->{cl_is_expr} ?
              "return _sahv_is_re == !!($ct);" :
                  "return ".($cv ? '':'!')."_sahv_is_re;"),
          "} )()",
      ));
  }
  
  1;
  
  __END__
  
DATA_SAH_COMPILER_JS_TH_STR

$fatpacked{"Data/Sah/Compiler/js/TH/undef.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'DATA_SAH_COMPILER_JS_TH_UNDEF';
  package Data::Sah::Compiler::js::TH::undef;
  
  our $DATE = '2015-04-14'; 
  our $VERSION = '0.51'; 
  
  use 5.010;
  use strict;
  use warnings;
  
  use Mo qw(build default);
  use Role::Tiny::With;
  
  extends 'Data::Sah::Compiler::js::TH';
  with 'Data::Sah::Type::undef';
  
  sub handle_type {
      my ($self, $cd) = @_;
      my $c = $self->compiler;
  
      my $dt = $cd->{data_term};
      $cd->{_ccl_check_type} = "$dt === undefined || $dt === null";
  }
  
  1;
  
  __END__
  
DATA_SAH_COMPILER_JS_TH_UNDEF

$fatpacked{"Data/Sah/Compiler/perl.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'DATA_SAH_COMPILER_PERL';
  package Data::Sah::Compiler::perl;
  
  our $DATE = '2015-04-14'; 
  our $VERSION = '0.51'; 
  
  use 5.010;
  use strict;
  use warnings;
  
  use Data::Dmp qw(dmp);
  use Mo qw(build default);
  use String::Indent ();
  
  extends 'Data::Sah::Compiler::Prog';
  
  sub BUILD {
      my ($self, $args) = @_;
  
      $self->comment_style('shell');
      $self->indent_character(" " x 4);
      $self->var_sigil('$');
      $self->concat_op(".");
  }
  
  sub name { "perl" }
  
  sub literal {
      dmp($_[1]);
  }
  
  sub expr {
      my ($self, $expr) = @_;
      $self->expr_compiler->perl($expr);
  }
  
  sub compile {
      my ($self, %args) = @_;
  
  
  
      $args{pp} //= $ENV{DATA_SAH_PP};
      $args{pp} //= eval { require Scalar::Util::Numeric; 1 } ? 0 : 1;
  
      $self->SUPER::compile(%args);
  }
  
  sub init_cd {
      my ($self, %args) = @_;
  
      my $cd = $self->SUPER::init_cd(%args);
  
      if (my $ocd = $cd->{outer_cd}) {
          $cd->{module_statements} = $ocd->{module_statements};
      } else {
          $cd->{module_statements} = {};
      }
  
      $self->add_no($cd, 'warnings', ["'void'"]);
  
      $cd;
  }
  
  sub true { "1" }
  
  sub false { "''" }
  
  sub add_use {
      my ($self, $cd, $name, $imports) = @_;
  
      die "BUG: imports must be an arrayref"
          if defined($imports) && ref($imports) ne 'ARRAY';
      $self->add_module($cd, $name);
      $cd->{module_statements}{$name} = ['use', $imports];
  }
  
  sub add_no {
      my ($self, $cd, $name, $imports) = @_;
  
      die "BUG: imports must be an arrayref"
          if defined($imports) && ref($imports) ne 'ARRAY';
      $self->add_module($cd, $name);
      $cd->{module_statements}{$name} = ['no', $imports];
  }
  
  sub add_smartmatch_pragma {
      my ($self, $cd) = @_;
      $self->add_use($cd, 'experimental', ["'smartmatch'"]);
  }
  
  sub add_sun_module {
      my ($self, $cd) = @_;
      if ($cd->{args}{pp}) {
          $cd->{_sun_module} = 'Scalar::Util::Numeric::PP';
      } else {
          $cd->{_sun_module} = 'Scalar::Util::Numeric';
      }
      $self->add_module($cd, $cd->{_sun_module});
  }
  
  sub expr_defined {
      my ($self, $t) = @_;
      "defined($t)";
  }
  
  sub expr_array_subscript {
      my ($self, $at, $idxt) = @_;
      "$at->\[$idxt]";
  }
  
  sub expr_last_elem {
      my ($self, $at, $idxt) = @_;
      "$at->\[-1]";
  }
  
  sub expr_push {
      my ($self, $at, $elt) = @_;
      "push(\@{$at}, $elt)";
  }
  
  sub expr_pop {
      my ($self, $at, $elt) = @_;
      "pop(\@{$at})";
  }
  
  sub expr_push_and_pop_dpath_between_expr {
      my ($self, $et) = @_;
      join(
          "",
          "[",
          $self->expr_push('$_sahv_dpath', $self->literal(undef)), ", ", 
          "~~", $self->enclose_paren($et), ", ", 
          $self->expr_pop('$_sahv_dpath'), 
          "]->[1]",
      );
  }
  
  sub expr_prefix_dpath {
      my ($self, $t) = @_;
      '(@$_sahv_dpath ? \'@\'.join("/",@$_sahv_dpath).": " : "") . ' . $t;
  }
  
  sub expr_setif {
      my ($self, $l, $r) = @_;
      "($l //= $r)";
  }
  
  sub expr_set_err_str {
      my ($self, $et, $err_expr) = @_;
      "($et //= $err_expr)";
  }
  
  sub expr_set_err_full {
      my ($self, $et, $k, $err_expr) = @_;
      "($et\->{$k}{join('/',\@\$_sahv_dpath)} //= $err_expr)";
  }
  
  sub expr_reset_err_str {
      my ($self, $et, $err_expr) = @_;
      "($et = undef, 1)";
  }
  
  sub expr_reset_err_full {
      my ($self, $et) = @_;
      "(delete($et\->{errors}{join('/',\@\$_sahv_dpath)}), 1)";
  }
  
  sub expr_log {
      my ($self, $cd, @expr) = @_;
  
      "\$log->tracef('[sah validator](spath=%s) %s', " .
          $self->literal($cd->{spath}).", " . join(", ", @expr) . ")";
  }
  
  sub expr_block {
      my ($self, $code) = @_;
      join(
          "",
          "do {\n",
          String::Indent::indent(
              $self->indent_character,
              $code,
          ),
          "}",
      );
  }
  
  sub block_uses_sub { 0 }
  
  sub stmt_declare_local_var {
      my ($self, $v, $vt) = @_;
      if ($vt eq 'undef') {
          "my \$$v;";
      } else {
          "my \$$v = $vt;";
      }
  }
  
  sub expr_anon_sub {
      my ($self, $args, $code) = @_;
      join(
          "",
          "sub {\n",
          String::Indent::indent(
              $self->indent_character,
              join(
                  "",
                  ("my (".join(", ", @$args).") = \@_;\n") x !!@$args,
                  $code,
              ),
          ),
          "}"
      );
  }
  
  sub stmt_require_module {
      my ($self, $mod, $cd) = @_;
      my $ms = $cd->{module_statements};
  
      if (!$ms->{$mod}) {
          "require $mod;";
      } elsif ($ms->{$mod}[0] eq 'use' || $ms->{$mod}[0] eq 'no') {
          my $verb = $ms->{$mod}[0];
          if (!$ms->{$mod}[1]) {
              "$verb $mod;";
          } else {
              "$verb $mod (".join(", ", @{ $ms->{$mod}[1] }).");";
          }
      }
  }
  
  sub stmt_require_log_module {
      my ($self, $mod) = @_;
      'use Log::Any qw($log);';
  }
  
  sub stmt_return {
      my $self = shift;
      if (@_) {
          "return($_[0]);";
      } else {
          'return;';
      }
  }
  
  sub expr_validator_sub {
      my ($self, %args) = @_;
  
      $self->check_compile_args(\%args);
  
      my $aref = delete $args{accept_ref};
      if ($aref) {
          $args{var_term}  = '$ref_'.$args{data_name};
          $args{data_term} = '$$ref_'.$args{data_name};
      } else {
          $args{var_term}  = '$'.$args{data_name};
          $args{data_term} = '$'.$args{data_name};
      }
  
      $self->SUPER::expr_validator_sub(%args);
  }
  
  sub _str2reliteral {
      require Regexp::Stringify;
  
      my ($self, $cd, $str) = @_;
  
      my $re;
      if (ref($str) eq 'Regexp') {
          $re = $str;
      } else {
          eval { $re = qr/$str/ };
          $self->_die($cd, "Invalid regex $str: $@") if $@;
      }
  
      Regexp::Stringify::stringify_regexp(regexp=>$re, plver=>5.010);
  }
  
  1;
  
  __END__
  
DATA_SAH_COMPILER_PERL

$fatpacked{"Data/Sah/Compiler/perl/TH.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'DATA_SAH_COMPILER_PERL_TH';
  package Data::Sah::Compiler::perl::TH;
  
  our $DATE = '2015-04-14'; 
  our $VERSION = '0.51'; 
  
  use 5.010;
  use strict;
  use warnings;
  
  use Mo qw(build default);
  use Role::Tiny::With;
  
  extends 'Data::Sah::Compiler::Prog::TH';
  
  sub gen_each {
      my ($self, $cd, $indices_expr, $data_name, $data_term, $code_at_sub_begin) = @_;
      my $c  = $self->compiler;
      my $cv = $cd->{cl_value};
      my $dt = $cd->{data_term};
  
      local $cd->{_subdata_level} = $cd->{_subdata_level} + 1;
      my $use_dpath = $cd->{args}{return_type} ne 'bool';
  
      $c->add_module($cd, 'List::Util');
      my %iargs = %{$cd->{args}};
      $iargs{outer_cd}             = $cd;
      $iargs{data_name}            = $data_name;
      $iargs{data_term}            = $data_term;
      $iargs{schema}               = $cv;
      $iargs{schema_is_normalized} = 0;
      $iargs{indent_level}++;
      my $icd = $c->compile(%iargs);
      my @code = (
          "!defined(List::Util::first(sub {", ($code_at_sub_begin // ''), "!(\n",
          ($c->indent_str($cd),
           "(\$_sahv_dpath->[-1] = \$_),\n") x !!$use_dpath,
           $icd->{result}, "\n",
           $c->indent_str($icd), ")}, ",
           $indices_expr,
           "))",
      );
      $c->add_ccl($cd, join("", @code), {subdata=>1});
  }
  
  1;
  
  __END__
  
DATA_SAH_COMPILER_PERL_TH

$fatpacked{"Data/Sah/Compiler/perl/TH/all.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'DATA_SAH_COMPILER_PERL_TH_ALL';
  package Data::Sah::Compiler::perl::TH::all;
  
  our $DATE = '2015-04-14'; 
  our $VERSION = '0.51'; 
  
  use 5.010;
  use strict;
  use warnings;
  
  use Mo qw(build default);
  use Role::Tiny::With;
  
  
  use parent (
      'Data::Sah::Compiler::perl::TH',
      'Data::Sah::Compiler::Prog::TH::all',
  );
  
  1;
  
  __END__
  
DATA_SAH_COMPILER_PERL_TH_ALL

$fatpacked{"Data/Sah/Compiler/perl/TH/any.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'DATA_SAH_COMPILER_PERL_TH_ANY';
  package Data::Sah::Compiler::perl::TH::any;
  
  our $DATE = '2015-04-14'; 
  our $VERSION = '0.51'; 
  
  use 5.010;
  use strict;
  use warnings;
  
  use Mo qw(build default);
  use Role::Tiny::With;
  
  
  use parent (
      'Data::Sah::Compiler::perl::TH',
      'Data::Sah::Compiler::Prog::TH::any',
  );
  
  1;
  
  __END__
  
DATA_SAH_COMPILER_PERL_TH_ANY

$fatpacked{"Data/Sah/Compiler/perl/TH/array.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'DATA_SAH_COMPILER_PERL_TH_ARRAY';
  package Data::Sah::Compiler::perl::TH::array;
  
  our $DATE = '2015-04-14'; 
  our $VERSION = '0.51'; 
  
  use 5.010;
  use strict;
  use warnings;
  
  use Mo qw(build default);
  use Role::Tiny::With;
  
  extends 'Data::Sah::Compiler::perl::TH';
  with 'Data::Sah::Type::array';
  
  sub handle_type {
      my ($self, $cd) = @_;
      my $c = $self->compiler;
  
      my $dt = $cd->{data_term};
      $cd->{_ccl_check_type} = "ref($dt) eq 'ARRAY'";
  }
  
  my $FRZ = "Storable::freeze";
  
  sub superclause_comparable {
      my ($self, $which, $cd) = @_;
      my $c  = $self->compiler;
      my $ct = $cd->{cl_term};
      my $dt = $cd->{data_term};
  
      $c->add_module($cd, 'Storable');
  
      if ($which eq 'is') {
          $c->add_ccl($cd, "$FRZ($dt) eq $FRZ($ct)");
      } elsif ($which eq 'in') {
          $c->add_smartmatch_pragma($cd);
          $c->add_ccl($cd, "$FRZ($dt) ~~ [map {$FRZ(\$_)} \@{ $ct }]");
      }
  }
  
  sub superclause_has_elems {
      my ($self_th, $which, $cd) = @_;
      my $c  = $self_th->compiler;
      my $cv = $cd->{cl_value};
      my $ct = $cd->{cl_term};
      my $dt = $cd->{data_term};
  
      if ($which eq 'len') {
          $c->add_ccl($cd, "\@{$dt} == $ct");
      } elsif ($which eq 'min_len') {
          $c->add_ccl($cd, "\@{$dt} >= $ct");
      } elsif ($which eq 'max_len') {
          $c->add_ccl($cd, "\@{$dt} <= $ct");
      } elsif ($which eq 'len_between') {
          if ($cd->{cl_is_expr}) {
              $c->add_ccl(
                  $cd, "\@{$dt} >= $ct\->[0] && \@{$dt} >= $ct\->[1]");
          } else {
              $c->add_ccl(
                  $cd, "\@{$dt} >= $cv->[0] && \@{$dt} <= $cv->[1]");
          }
      } elsif ($which eq 'has') {
          $c->add_smartmatch_pragma($cd);
  
          $c->add_ccl($cd, "$ct ~~ $dt");
      } elsif ($which eq 'each_index') {
          $self_th->gen_each($cd, "0..\@{$dt}-1", '_', '$_');
      } elsif ($which eq 'each_elem') {
          $self_th->gen_each($cd, "0..\@{$dt}-1", '_', "$dt\->[\$_]");
      } elsif ($which eq 'check_each_index') {
          $self_th->compiler->_die_unimplemented_clause($cd);
      } elsif ($which eq 'check_each_elem') {
          $self_th->compiler->_die_unimplemented_clause($cd);
      } elsif ($which eq 'uniq') {
          $self_th->compiler->_die_unimplemented_clause($cd);
      } elsif ($which eq 'exists') {
          $self_th->compiler->_die_unimplemented_clause($cd);
      }
  }
  
  sub clause_elems {
      my ($self_th, $cd) = @_;
      my $c  = $self_th->compiler;
      my $cv = $cd->{cl_value};
      my $dt = $cd->{data_term};
  
      local $cd->{_subdata_level} = $cd->{_subdata_level} + 1;
      my $use_dpath = $cd->{args}{return_type} ne 'bool';
  
      my $jccl;
      {
          local $cd->{ccls} = [];
  
          my $cdef = $cd->{clset}{"elems.create_default"} // 1;
          delete $cd->{uclset}{"elems.create_default"};
  
          for my $i (0..@$cv-1) {
              local $cd->{spath} = [@{$cd->{spath}}, $i];
              my $sch = $c->main->normalize_schema($cv->[$i]);
              my $edt = "$dt\->[$i]";
              my %iargs = %{$cd->{args}};
              $iargs{outer_cd}             = $cd;
              $iargs{data_name}            = "$cd->{args}{data_name}_$i";
              $iargs{data_term}            = $edt;
              $iargs{schema}               = $sch;
              $iargs{schema_is_normalized} = 1;
              $iargs{indent_level}++;
              my $icd = $c->compile(%iargs);
              my @code = (
                  ($c->indent_str($cd), "(\$_sahv_dpath->[-1] = $i),\n") x !!$use_dpath,
                  $icd->{result}, "\n",
              );
              my $ires = join("", @code);
              local $cd->{_debug_ccl_note} = "elem: $i";
              if ($cdef && defined($sch->[1]{default})) {
                  $c->add_ccl($cd, $ires);
              } else {
                  $c->add_ccl($cd, "\@{$dt} < ".($i+1)." || ($ires)");
              }
          }
          $jccl = $c->join_ccls(
              $cd, $cd->{ccls}, {err_msg => ''});
      }
      $c->add_ccl($cd, $jccl, {subdata=>1});
  }
  
  1;
  
  __END__
  
DATA_SAH_COMPILER_PERL_TH_ARRAY

$fatpacked{"Data/Sah/Compiler/perl/TH/bool.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'DATA_SAH_COMPILER_PERL_TH_BOOL';
  package Data::Sah::Compiler::perl::TH::bool;
  
  our $DATE = '2015-04-14'; 
  our $VERSION = '0.51'; 
  
  use 5.010;
  use strict;
  use warnings;
  
  use Mo qw(build default);
  use Role::Tiny::With;
  
  extends 'Data::Sah::Compiler::perl::TH';
  with 'Data::Sah::Type::bool';
  
  sub handle_type {
      my ($self, $cd) = @_;
      my $c = $self->compiler;
  
      my $dt = $cd->{data_term};
      $cd->{_ccl_check_type} = "!ref($dt)";
  }
  
  sub superclause_comparable {
      my ($self, $which, $cd) = @_;
      my $c  = $self->compiler;
      my $ct = $cd->{cl_term};
      my $dt = $cd->{data_term};
  
      if ($which eq 'is') {
          $c->add_ccl($cd, "($dt ? 1:0) == ($ct ? 1:0)");
      } elsif ($which eq 'in') {
          $c->add_smartmatch_pragma($cd);
          $c->add_ccl($cd, "($dt ? 1:0) ~~ [map {\$_?1:0} \@{$ct}]");
      }
  }
  
  sub superclause_sortable {
      my ($self, $which, $cd) = @_;
      my $c  = $self->compiler;
      my $cv = $cd->{cl_value};
      my $ct = $cd->{cl_term};
      my $dt = $cd->{data_term};
  
      if ($which eq 'min') {
          $c->add_ccl($cd, "($dt ? 1:0) >= ($ct ? 1:0)");
      } elsif ($which eq 'xmin') {
          $c->add_ccl($cd, "($dt ? 1:0) > ($ct ? 1:0)");
      } elsif ($which eq 'max') {
          $c->add_ccl($cd, "($dt ? 1:0) <= ($ct ? 1:0)");
      } elsif ($which eq 'xmax') {
          $c->add_ccl($cd, "($dt ? 1:0) < ($ct ? 1:0)");
      } elsif ($which eq 'between') {
          if ($cd->{cl_is_expr}) {
              $c->add_ccl($cd, "($dt ? 1:0) >= ($ct\->[0] ? 1:0) && ".
                              "($dt ? 1:0) <= ($ct\->[1] ? 1:0)");
          } else {
              $c->add_ccl($cd, "($dt ? 1:0) >= ($cv->[0] ? 1:0) && ".
                              "($dt ? 1:0) <= ($cv->[1] ? 1:0)");
          }
      } elsif ($which eq 'xbetween') {
          if ($cd->{cl_is_expr}) {
              $c->add_ccl($cd, "($dt ? 1:0) > ($ct\->[0] ? 1:0) && ".
                              "($dt ? 1:0) < ($ct\->[1] ? 1:0)");
          } else {
              $c->add_ccl($cd, "($dt ? 1:0) > ($cv->[0] ? 1:0) && ".
                              "($dt ? 1:0) < ($cv->[1] ? 1:0)");
          }
      }
  }
  
  sub clause_is_true {
      my ($self, $cd) = @_;
      my $c  = $self->compiler;
      my $ct = $cd->{cl_term};
      my $dt = $cd->{data_term};
  
      $c->add_ccl($cd, "($ct) ? $dt : !defined($ct) ? 1 : !$dt");
  }
  
  1;
  
  __END__
  
DATA_SAH_COMPILER_PERL_TH_BOOL

$fatpacked{"Data/Sah/Compiler/perl/TH/buf.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'DATA_SAH_COMPILER_PERL_TH_BUF';
  package Data::Sah::Compiler::perl::TH::buf;
  
  our $DATE = '2015-04-14'; 
  our $VERSION = '0.51'; 
  
  use 5.010;
  use strict;
  use warnings;
  
  use Mo qw(build default);
  use Role::Tiny::With;
  
  extends 'Data::Sah::Compiler::perl::TH::str';
  with 'Data::Sah::Type::buf';
  
  1;
  
  __END__
  
DATA_SAH_COMPILER_PERL_TH_BUF

$fatpacked{"Data/Sah/Compiler/perl/TH/cistr.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'DATA_SAH_COMPILER_PERL_TH_CISTR';
  package Data::Sah::Compiler::perl::TH::cistr;
  
  our $DATE = '2015-04-14'; 
  our $VERSION = '0.51'; 
  
  use 5.010;
  use strict;
  use warnings;
  
  use Mo qw(build default);
  use Role::Tiny::With;
  
  extends 'Data::Sah::Compiler::perl::TH::str';
  with 'Data::Sah::Type::cistr';
  
  sub before_all_clauses {
      my ($self, $cd) = @_;
      my $c = $self->compiler;
      my $dt = $cd->{data_term};
  
  
      $self->set_tmp_data_term($cd, "lc($dt)");
  }
  
  sub after_all_clauses {
      my ($self, $cd) = @_;
      my $c = $self->compiler;
      my $dt = $cd->{data_term};
  
      $self->restore_data_term($cd);
  }
  
  sub superclause_comparable {
      my ($self, $which, $cd) = @_;
      my $c  = $self->compiler;
      my $ct = $cd->{cl_term};
      my $dt = $cd->{data_term};
  
      if ($which eq 'is') {
          $c->add_ccl($cd, "$dt eq lc($ct)");
      } elsif ($which eq 'in') {
          $c->add_smartmatch_pragma($cd);
          $c->add_ccl($cd, "$dt ~~ [map {lc} \@{ $ct }]");
      }
  }
  
  sub superclause_sortable {
      my ($self, $which, $cd) = @_;
      my $c  = $self->compiler;
      my $cv = $cd->{cl_value};
      my $ct = $cd->{cl_term};
      my $dt = $cd->{data_term};
  
      if ($which eq 'min') {
          $c->add_ccl($cd, "$dt ge lc($ct)");
      } elsif ($which eq 'xmin') {
          $c->add_ccl($cd, "$dt gt lc($ct)");
      } elsif ($which eq 'max') {
          $c->add_ccl($cd, "$dt le lc($ct)");
      } elsif ($which eq 'xmax') {
          $c->add_ccl($cd, "$dt lt lc($ct)");
      } elsif ($which eq 'between') {
          if ($cd->{cl_is_expr}) {
              $c->add_ccl($cd, "$dt ge lc($ct\->[0]) && ".
                              "$dt le lc($ct\->[1])");
          } else {
              $c->add_ccl($cd, "$dt ge ".$c->literal(lc $cv->[0]).
                              " && $dt le ".$c->literal(lc $cv->[1]));
          }
      } elsif ($which eq 'xbetween') {
          if ($cd->{cl_is_expr}) {
              $c->add_ccl($cd, "$dt gt lc($ct\->[0]) && ".
                              "$dt lt lc($ct\->[1])");
          } else {
              $c->add_ccl($cd, "$dt gt ".$c->literal(lc $cv->[0]).
                              " && $dt lt ".$c->literal(lc $cv->[1]));
          }
      }
  }
  
  sub superclause_has_elems {
      my ($self_th, $which, $cd) = @_;
      my $c  = $self_th->compiler;
      my $cv = $cd->{cl_value};
      my $ct = $cd->{cl_term};
      my $dt = $cd->{data_term};
  
      if ($which eq 'has') {
          $c->add_ccl($cd, "index($dt, lc($ct)) > -1");
      } else {
          $self_th->SUPER::superclause_has_elems($which, $cd);
      }
  }
  
  sub __change_re_str_switch {
      my $re = shift;
  
      if ($^V ge v5.14.0) {
          state $sub = sub { my $s = shift; $s =~ /i/ ? $s : "i$s" };
          $re =~ s/\A\(\?\^(\w*):/"(?".$sub->($1).":"/e;
      } else {
          state $subl = sub { my $s = shift; $s =~ /i/ ? $s : "i$s" };
          state $subr = sub { my $s = shift; $s =~ s/i//; $s };
          $re =~ s/\A\(\?(\w*)-(\w*):/"(?".$subl->($1)."-".$subr->($2).":"/e;
      }
      return $re;
  }
  
  sub clause_match {
      my ($self, $cd) = @_;
      my $c  = $self->compiler;
      my $cv = $cd->{cl_value};
      my $ct = $cd->{cl_term};
      my $dt = $cd->{data_term};
  
      if ($cd->{cl_is_expr}) {
          $c->add_ccl($cd, join(
              "",
              "ref($ct) eq 'Regexp' ? $dt =~ qr/$ct/i : ",
              "do { my \$re = $ct; eval { \$re = /\$re/i; 1 } && ",
              "$dt =~ \$re }",
          ));
      } else {
          my $re = $c->_str2reliteral($cd, $cv);
          $re = __change_re_str_switch($re);
          $c->add_ccl($cd, "$dt =~ /$re/i");
      }
  }
  
  1;
  
  __END__
  
DATA_SAH_COMPILER_PERL_TH_CISTR

$fatpacked{"Data/Sah/Compiler/perl/TH/code.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'DATA_SAH_COMPILER_PERL_TH_CODE';
  package Data::Sah::Compiler::perl::TH::code;
  
  our $DATE = '2015-04-14'; 
  our $VERSION = '0.51'; 
  
  use 5.010;
  use strict;
  use warnings;
  
  use Mo qw(build default);
  use Role::Tiny::With;
  
  extends 'Data::Sah::Compiler::perl::TH';
  with 'Data::Sah::Type::code';
  
  sub handle_type {
      my ($self, $cd) = @_;
      my $c = $self->compiler;
  
      my $dt = $cd->{data_term};
      $cd->{_ccl_check_type} = "ref($dt) eq 'CODE'";
  }
  
  1;
  
  __END__
  
DATA_SAH_COMPILER_PERL_TH_CODE

$fatpacked{"Data/Sah/Compiler/perl/TH/date.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'DATA_SAH_COMPILER_PERL_TH_DATE';
  package Data::Sah::Compiler::perl::TH::date;
  
  our $DATE = '2015-04-14'; 
  our $VERSION = '0.51'; 
  
  use 5.010;
  use strict;
  use warnings;
  
  use Mo qw(build default);
  use Role::Tiny::With;
  use Scalar::Util qw(blessed looks_like_number);
  
  extends 'Data::Sah::Compiler::perl::TH';
  with 'Data::Sah::Type::date';
  
  sub expr_coerce_term {
      my ($self, $cd, $t) = @_;
  
      my $c = $self->compiler;
      $c->add_module($cd, 'DateTime');
      $c->add_module($cd, 'Scalar::Util');
  
      join(
          '',
          "(",
          "(Scalar::Util::blessed($t) && $t->isa('DateTime')) ? $t : ",
          "(Scalar::Util::looks_like_number($t) && $t >= 10**8 && $t <= 2**31) ? (DateTime->from_epoch(epoch=>$t)) : ",
          "$t =~ /\\A([0-9]{4})-([0-9]{2})-([0-9]{2})T([0-9]{2}):([0-9]{2}):([0-9]{2})Z\\z/ ? DateTime->new(year=>\$1, month=>\$2, day=>\$3, hour=>\$4, minute=>\$5, second=>\$6, time_zone=>'UTC') : ",
          "$t =~ /\\A([0-9]{4})-([0-9]{2})-([0-9]{2})\\z/ ? DateTime->new(year=>\$1, month=>\$2, day=>\$3) : die(\"BUG: can't coerce date\")",
          ")",
      );
  }
  
  sub expr_coerce_value {
      my ($self, $cd, $v) = @_;
  
      my $c = $self->compiler;
      $c->add_module($cd, 'DateTime');
  
      if (blessed($v) && $v->isa('DateTime')) {
          return join(
              '',
              "DateTime->new(",
              "year=>",   $v->year, ",",
              "month=>",  $v->month, ",",
              "day=>",    $v->day, ",",
              "hour=>",   $v->hour, ",",
              "minute=>", $v->minute, ",",
              "second=>", $v->second, ",",
              ")",
          );
      } elsif (looks_like_number($v) && $v >= 10**8 && $v <= 2**31) {
          return "DateTime->from_epoch(epoch=>$v)";
      } elsif ($v =~ /\A([0-9]{4})-([0-9]{2})-([0-9]{2})T([0-9]{2}):([0-9]{2}):([0-9]{2})Z\z/) {
          require DateTime;
          eval { DateTime->new(year=>$1, month=>$2, day=>$3,
                               hour=>$4, minute=>$5, second=>$6,
                               time_zone=>'UTC') ; 1 }
              or die "Invalid date literal '$v': $@";
          return "DateTime->new(year=>$1, month=>$2, day=>$3, hour=>$4, minute=>$5, second=>$6, time_zone=>'UTC')";
      } elsif ($v =~ /\A([0-9]{4})-([0-9]{2})-([0-9]{2})\z/) {
          require DateTime;
          eval { DateTime->new(year=>$1, month=>$2, day=>$3) ; 1 }
              or die "Invalid date literal '$v': $@";
          return "DateTime->new(year=>$1, month=>$2, day=>$3)";
      } else {
          die "Invalid date literal '$v'";
      }
  }
  
  sub handle_type {
      my ($self, $cd) = @_;
      my $c  = $self->compiler;
      my $dt = $cd->{data_term};
  
      $c->add_module($cd, 'Scalar::Util');
      $cd->{_ccl_check_type} = join(
          '',
          "(",
          "(Scalar::Util::blessed($dt) && $dt->isa('DateTime'))",
          " || ",
          "(Scalar::Util::looks_like_number($dt) && $dt >= 10**8 && $dt <= 2**31)",
          " || ",
          "($dt =~ /\\A([0-9]{4})-([0-9]{2})-([0-9]{2})T([0-9]{2}):([0-9]{2}):([0-9]{2})Z\\z/ && eval { DateTime->new(year=>\$1, month=>\$2, day=>\$3, hour=>\$4, minute=>\$5, second=>\$6, time_zone=>'UTC'); 1})",
          " || ",
          "($dt =~ /\\A([0-9]{4})-([0-9]{2})-([0-9]{2})\\z/ && eval { DateTime->new(year=>\$1, month=>\$2, day=>\$3); 1})",
          ")",
      );
  }
  
  sub before_all_clauses {
      my ($self, $cd) = @_;
      my $c = $self->compiler;
      my $dt = $cd->{data_term};
  
  
      $self->set_tmp_data_term($cd, $self->expr_coerce_term($cd, $dt));
  }
  
  sub after_all_clauses {
      my ($self, $cd) = @_;
      my $c = $self->compiler;
      my $dt = $cd->{data_term};
  
      $self->restore_data_term($cd);
  }
  
  sub superclause_comparable {
      my ($self, $which, $cd) = @_;
      my $c  = $self->compiler;
      my $cv = $cd->{cl_value};
      my $ct = $cd->{cl_term};
      my $dt = $cd->{data_term};
  
      if ($which eq 'is') {
          if ($cd->{cl_is_expr}) {
              $ct = $self->expr_coerce_term($cd, $ct);
          } else {
              $ct = $self->expr_coerce_value($cd, $cv);
          }
          $c->add_ccl($cd, "DateTime->compare($dt, $ct)==0");
      } elsif ($which eq 'in') {
          $c->add_module('List::Util');
          if ($cd->{cl_is_expr}) {
              $c->_die($cd, "date's in clause with expression not yet supported");
          } else {
              $ct = join(', ', map { $self->expr_coerce_value($cd, $_) } @$cv);
          };
          $c->add_ccl($cd, "List::Util::first(sub{DateTime->compare($dt, \$_)==0}, $ct)");
      }
  }
  
  sub superclause_sortable {
      my ($self, $which, $cd) = @_;
      my $c  = $self->compiler;
      my $cv = $cd->{cl_value};
      my $ct = $cd->{cl_term};
      my $dt = $cd->{data_term};
  
      if ($cd->{cl_is_expr}) {
          $c->_die($cd, "date's comparison with expression not yet supported");
      }
  
      if ($which eq 'min') {
          $c->add_ccl($cd, "DateTime->compare($dt, ".
                          $self->expr_coerce_value($cd, $cv).") >= 0");
      } elsif ($which eq 'xmin') {
          $c->add_ccl($cd, "DateTime->compare($dt, ".
                          $self->expr_coerce_value($cd, $cv).") > 0");
      } elsif ($which eq 'max') {
          $c->add_ccl($cd, "DateTime->compare($dt, ".
                          $self->expr_coerce_value($cd, $cv).") <= 0");
      } elsif ($which eq 'xmax') {
          $c->add_ccl($cd, "DateTime->compare($dt, ".
                          $self->expr_coerce_value($cd, $cv).") < 0");
      } elsif ($which eq 'between') {
          $c->add_ccl($cd,
                      join(
                          '',
                          "DateTime->compare($dt, ",
                          $self->expr_coerce_value($cd, $cv->[0]).") >= 0 && ",
                          "DateTime->compare($dt, ",
                          $self->expr_coerce_value($cd, $cv->[1]).") <= 0",
                      ));
      } elsif ($which eq 'xbetween') {
          $c->add_ccl($cd,
                      join(
                          '',
                          "DateTime->compare($dt, ",
                          $self->expr_coerce_value($cd, $cv->[0]).") > 0 && ",
                          "DateTime->compare($dt, ",
                          $self->expr_coerce_value($cd, $cv->[1]).") < 0",
                      ));
      }
  }
  
  1;
  
  __END__
  
DATA_SAH_COMPILER_PERL_TH_DATE

$fatpacked{"Data/Sah/Compiler/perl/TH/float.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'DATA_SAH_COMPILER_PERL_TH_FLOAT';
  package Data::Sah::Compiler::perl::TH::float;
  
  our $DATE = '2015-04-14'; 
  our $VERSION = '0.51'; 
  
  use 5.010;
  use strict;
  use warnings;
  
  use Mo qw(build default);
  use Role::Tiny::With;
  
  extends 'Data::Sah::Compiler::perl::TH::num';
  with 'Data::Sah::Type::float';
  
  sub handle_type {
      my ($self, $cd) = @_;
      my $c = $self->compiler;
  
      my $dt = $cd->{data_term};
      $c->add_sun_module($cd);
      $cd->{_ccl_check_type} = "$cd->{_sun_module}::isnum($dt)";
  }
  
  sub clause_is_nan {
      my ($self, $cd) = @_;
      my $c  = $self->compiler;
      my $ct = $cd->{cl_term};
      my $dt = $cd->{data_term};
  
      if ($cd->{cl_is_expr}) {
          $c->add_ccl(
              $cd,
              join(
                  "",
                  "$ct ? $cd->{_sun_module}::isnan($dt) : ",
                  "defined($ct) ? !$cd->{_sun_module}::isnan($dt) : 1",
              )
          );
      } else {
          if ($cd->{cl_value}) {
              $c->add_ccl($cd, "$cd->{_sun_module}::isnan($dt)");
          } elsif (defined $cd->{cl_value}) {
              $c->add_ccl($cd, "!$cd->{_sun_module}::isnan($dt)");
          }
      }
  }
  
  sub clause_is_neg_inf {
      my ($self, $cd) = @_;
      my $c  = $self->compiler;
      my $ct = $cd->{cl_term};
      my $dt = $cd->{data_term};
  
      if ($cd->{cl_is_expr}) {
          $c->add_ccl($cd, "$ct ? $cd->{_sun_module}::isinf($dt) && $cd->{_sun_module}::isneg($dt) : ".
                          "defined($ct) ? !($cd->{_sun_module}::isinf($dt) && $cd->{_sun_module}::isneg($dt)) : 1");
      } else {
          if ($cd->{cl_value}) {
              $c->add_ccl($cd, "$cd->{_sun_module}::isinf($dt) && $cd->{_sun_module}::isneg($dt)");
          } elsif (defined $cd->{cl_value}) {
              $c->add_ccl($cd, "!($cd->{_sun_module}::isinf($dt) && $cd->{_sun_module}::isneg($dt))");
          }
      }
  }
  
  sub clause_is_pos_inf {
      my ($self, $cd) = @_;
      my $c  = $self->compiler;
      my $ct = $cd->{cl_term};
      my $dt = $cd->{data_term};
  
      if ($cd->{cl_is_expr}) {
          $c->add_ccl($cd, "$ct ? $cd->{_sun_module}::isinf($dt) && !$cd->{_sun_module}::isneg($dt) : ".
                          "defined($ct) ? !($cd->{_sun_module}::isinf($dt) && !$cd->{_sun_module}::isneg($dt)) : 1");
      } else {
          if ($cd->{cl_value}) {
              $c->add_ccl($cd, "$cd->{_sun_module}::isinf($dt) && !$cd->{_sun_module}::isneg($dt)");
          } elsif (defined $cd->{cl_value}) {
              $c->add_ccl($cd, "!($cd->{_sun_module}::isinf($dt) && !$cd->{_sun_module}::isneg($dt))");
          }
      }
  }
  
  sub clause_is_inf {
      my ($self, $cd) = @_;
      my $c  = $self->compiler;
      my $ct = $cd->{cl_term};
      my $dt = $cd->{data_term};
  
      if ($cd->{cl_is_expr}) {
          $c->add_ccl($cd, "$ct ? $cd->{_sun_module}::isinf($dt) : ".
                          "defined($ct) ? $cd->{_sun_module}::isinf($dt) : 1");
      } else {
          if ($cd->{cl_value}) {
              $c->add_ccl($cd, "$cd->{_sun_module}::isinf($dt)");
          } elsif (defined $cd->{cl_value}) {
              $c->add_ccl($cd, "!$cd->{_sun_module}::isinf($dt)");
          }
      }
  }
  
  1;
  
  __END__
  
DATA_SAH_COMPILER_PERL_TH_FLOAT

$fatpacked{"Data/Sah/Compiler/perl/TH/hash.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'DATA_SAH_COMPILER_PERL_TH_HASH';
  package Data::Sah::Compiler::perl::TH::hash;
  
  our $DATE = '2015-04-14'; 
  our $VERSION = '0.51'; 
  
  use 5.010;
  use strict;
  use warnings;
  
  use Mo qw(build default);
  use Role::Tiny::With;
  
  extends 'Data::Sah::Compiler::perl::TH';
  with 'Data::Sah::Type::hash';
  
  sub handle_type {
      my ($self, $cd) = @_;
      my $c = $self->compiler;
  
      my $dt = $cd->{data_term};
      $cd->{_ccl_check_type} = "ref($dt) eq 'HASH'";
  }
  
  my $FRZ = "Storable::freeze";
  
  sub superclause_comparable {
      my ($self, $which, $cd) = @_;
      my $c  = $self->compiler;
      my $ct = $cd->{cl_term};
      my $dt = $cd->{data_term};
  
      $c->add_module($cd, 'Storable');
  
      if ($which eq 'is') {
          $c->add_ccl($cd, "$FRZ($dt) eq $FRZ($ct)");
      } elsif ($which eq 'in') {
          $c->add_smartmatch_pragma($cd);
          $c->add_ccl($cd, "$FRZ($dt) ~~ [map {$FRZ(\$_)} \@{ $ct }]");
      }
  }
  
  sub superclause_has_elems {
      my ($self_th, $which, $cd) = @_;
      my $c  = $self_th->compiler;
      my $cv = $cd->{cl_value};
      my $ct = $cd->{cl_term};
      my $dt = $cd->{data_term};
  
      if ($which eq 'len') {
          $c->add_ccl($cd, "keys(\%{$dt}) == $ct");
      } elsif ($which eq 'min_len') {
          $c->add_ccl($cd, "keys(\%{$dt}) >= $ct");
      } elsif ($which eq 'max_len') {
          $c->add_ccl($cd, "keys(\%{$dt}) <= $ct");
      } elsif ($which eq 'len_between') {
          if ($cd->{cl_is_expr}) {
              $c->add_ccl(
                  $cd, "keys(\%{$dt}) >= $ct\->[0] && ".
                      "keys(\%{$dt}) >= $ct\->[1]");
          } else {
              $c->add_ccl(
                  $cd, "keys(\%{$dt}) >= $cv->[0] && ".
                      "keys(\%{$dt}) <= $cv->[1]");
          }
      } elsif ($which eq 'has') {
          $c->add_smartmatch_pragma($cd);
  
          $c->add_ccl($cd, "$ct ~~ [values \%{ $dt }]");
      } elsif ($which eq 'each_index') {
          $self_th->gen_each($cd, "sort keys(\%{$dt})", '', '$_');
      } elsif ($which eq 'each_elem') {
          $self_th->gen_each($cd, "sort keys(\%{$dt})", '_', "$dt\->{\$_}");
      } elsif ($which eq 'check_each_index') {
          $self_th->compiler->_die_unimplemented_clause($cd);
      } elsif ($which eq 'check_each_elem') {
          $self_th->compiler->_die_unimplemented_clause($cd);
      } elsif ($which eq 'uniq') {
          $self_th->compiler->_die_unimplemented_clause($cd);
      } elsif ($which eq 'exists') {
          $self_th->compiler->_die_unimplemented_clause($cd);
      }
  }
  
  sub _clause_keys_or_re_keys {
      my ($self_th, $which, $cd) = @_;
      my $c  = $self_th->compiler;
      my $cv = $cd->{cl_value};
      my $dt = $cd->{data_term};
  
      local $cd->{_subdata_level} = $cd->{_subdata_level} + 1;
      my $use_dpath = $cd->{args}{return_type} ne 'bool';
  
  
      my $jccl;
      {
          local $cd->{ccls} = [];
  
          my $lit_valid_keys;
          if ($which eq 'keys') {
              $lit_valid_keys = $c->literal([sort keys %$cv]);
          } else {
              $lit_valid_keys = "[".
                  join(",", map { "qr/".$c->_str2reliteral($cd, $_)."/" }
                           sort keys %$cv)."]";
          }
  
          if ($cd->{clset}{"$which.restrict"} // 1) {
              local $cd->{_debug_ccl_note} = "$which.restrict";
              $c->add_module($cd, "List::Util");
              $c->add_smartmatch_pragma($cd);
              $c->add_ccl(
                  $cd,
                  "!defined(List::Util::first(sub {!(\$_ ~~ $lit_valid_keys)}, ".
                      "keys %{$dt}))",
                  {
                      err_msg => 'TMP1',
                      err_expr => join(
                          "",
                          'sprintf(',
                          $c->literal($c->_xlt(
                              $cd, "hash contains ".
                                  "unknown field(s) (%s)")),
                          ',',
                          "join(', ', sort grep {!(\$_ ~~ $lit_valid_keys)} ",
                          "keys %{$dt})",
                          ')',
                      ),
                  },
              );
          }
          delete $cd->{uclset}{"$which.restrict"};
  
          my $cdef;
          if ($which eq 'keys') {
              $cdef = $cd->{clset}{"keys.create_default"} // 1;
              delete $cd->{uclset}{"keys.create_default"};
          }
  
          my $nkeys = scalar(keys %$cv);
          my $i = 0;
          for my $k (sort keys %$cv) {
              my $kre = $c->_str2reliteral($cd, $k);
              local $cd->{spath} = [@{ $cd->{spath} }, $k];
              ++$i;
              my $sch = $c->main->normalize_schema($cv->{$k});
              my $kdn = $k; $kdn =~ s/\W+/_/g;
              my $klit = $which eq 're_keys' ? '$_' : $c->literal($k);
              my $kdt = "$dt\->{$klit}";
              my %iargs = %{$cd->{args}};
              $iargs{outer_cd}             = $cd;
              $iargs{data_name}            = $kdn;
              $iargs{data_term}            = $kdt;
              $iargs{schema}               = $sch;
              $iargs{schema_is_normalized} = 1;
              $iargs{indent_level}++;
              my $icd = $c->compile(%iargs);
  
              my $sdef = $cdef && defined($sch->[1]{default});
  
              $c->add_var($cd, '_sahv_stack', []) if $use_dpath;
  
              my @code = (
                  ($c->indent_str($cd), "(push(@\$_sahv_dpath, undef), push(\@\$_sahv_stack, undef), \$_sahv_stack->[-1] = \n")
                      x !!($use_dpath && $i == 1),
  
                  ('(!defined(List::Util::first(sub {!(')
                      x !!($which eq 're_keys'),
  
                  $which eq 're_keys' ? "\$_ !~ /$kre/ || (" :
                      ($sdef ? "" : "!exists($kdt) || ("),
  
                  ($c->indent_str($cd), "(\$_sahv_dpath->[-1] = ".
                       ($which eq 're_keys' ? '$_' : $klit)."),\n")
                           x !!$use_dpath,
                  $icd->{result}, "\n",
  
                  $which eq 're_keys' || !$sdef ? ")" : "",
  
                  (")}, sort keys %{ $dt })))")
                      x !!($which eq 're_keys'),
  
                  ($c->indent_str($cd), "), pop(\@\$_sahv_dpath), pop(\@\$_sahv_stack)\n")
                      x !!($use_dpath && $i == $nkeys),
              );
              my $ires = join("", @code);
              local $cd->{_debug_ccl_note} = "$which: ".$c->literal($k);
              $c->add_ccl($cd, $ires);
          }
          $jccl = $c->join_ccls(
              $cd, $cd->{ccls}, {err_msg => ''});
      }
      $c->add_ccl($cd, $jccl, {});
  }
  
  sub clause_keys {
      my ($self, $cd) = @_;
      $self->_clause_keys_or_re_keys('keys', $cd);
  }
  
  sub clause_re_keys {
      my ($self, $cd) = @_;
      $self->_clause_keys_or_re_keys('re_keys', $cd);
  }
  
  sub clause_req_keys {
      my ($self, $cd) = @_;
      my $c  = $self->compiler;
      my $ct = $cd->{cl_term};
      my $dt = $cd->{data_term};
  
  
      $c->add_module($cd, "List::Util");
      $c->add_ccl(
        $cd,
        "do { my \$h = $dt; !defined(List::Util::first(sub {!exists(\$h\->{\$_})}, \@{ $ct })) }",
        {
          err_msg => 'TMP',
          err_expr =>
            "sprintf(".
            $c->literal($c->_xlt($cd, "hash has missing required field(s) (%s)")).
            ",join(', ', do { my \$h = $dt; grep { !exists(\$h\->{\$_}) } \@{ $ct } }))"
        }
      );
  }
  
  sub clause_allowed_keys {
      my ($self, $cd) = @_;
      my $c  = $self->compiler;
      my $ct = $cd->{cl_term};
      my $dt = $cd->{data_term};
  
      $c->add_module($cd, "List::Util");
      $c->add_smartmatch_pragma($cd);
      $c->add_ccl(
        $cd,
        "!defined(List::Util::first(sub {!(\$_ ~~ $ct)}, keys \%{ $dt }))",
        {
          err_msg => 'TMP',
          err_expr =>
            "sprintf(".
            $c->literal($c->_xlt($cd, "hash contains non-allowed field(s) (%s)")).
            ",join(', ', sort grep { !(\$_ ~~ $ct) } keys \%{ $dt }))"
        }
      );
  }
  
  sub clause_allowed_keys_re {
      my ($self, $cd) = @_;
      my $c  = $self->compiler;
      my $cv = $cd->{cl_value};
      my $dt = $cd->{data_term};
  
      if ($cd->{cl_is_expr}) {
          $c->_die_unimplemented_clause($cd, "with expr");
      }
  
      my $re = $c->_str2reliteral($cd, $cv);
      $c->add_module($cd, "List::Util");
      $c->add_smartmatch_pragma($cd);
      $c->add_ccl(
          $cd,
          "!defined(List::Util::first(sub {\$_ !~ /$re/}, keys \%{ $dt }))",
          {
            err_msg => 'TMP',
            err_expr =>
            "sprintf(".
            $c->literal($c->_xlt($cd, "hash contains non-allowed field(s) (%s)")).
            ",join(', ', sort grep { \$_ !~ /$re/ } keys \%{ $dt }))"
        }
      );
  }
  
  sub clause_forbidden_keys {
      my ($self, $cd) = @_;
      my $c  = $self->compiler;
      my $ct = $cd->{cl_term};
      my $dt = $cd->{data_term};
  
      $c->add_module($cd, "List::Util");
      $c->add_smartmatch_pragma($cd);
      $c->add_ccl(
        $cd,
        "!defined(List::Util::first(sub {\$_ ~~ $ct}, keys \%{ $dt }))",
        {
          err_msg => 'TMP',
          err_expr =>
            "sprintf(".
            $c->literal($c->_xlt($cd, "hash contains forbidden field(s) (%s)")).
            ",join(', ', sort grep { \$_ ~~ $ct } keys \%{ $dt }))"
        }
      );
  }
  
  sub clause_forbidden_keys_re {
      my ($self, $cd) = @_;
      my $c  = $self->compiler;
      my $cv = $cd->{cl_value};
      my $dt = $cd->{data_term};
  
      if ($cd->{cl_is_expr}) {
          $c->_die_unimplemented_clause($cd, "with expr");
      }
  
      my $re = $c->_str2reliteral($cd, $cv);
      $c->add_module($cd, "List::Util");
      $c->add_smartmatch_pragma($cd);
      $c->add_ccl(
          $cd,
          "!defined(List::Util::first(sub {\$_ =~ /$re/}, keys \%{ $dt }))",
          {
            err_msg => 'TMP',
            err_expr =>
            "sprintf(".
            $c->literal($c->_xlt($cd, "hash contains forbidden field(s) (%s)")).
            ",join(', ', sort grep { \$_ =~ /$re/ } keys \%{ $dt }))"
        }
      );
  }
  
  1;
  
  __END__
  
DATA_SAH_COMPILER_PERL_TH_HASH

$fatpacked{"Data/Sah/Compiler/perl/TH/int.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'DATA_SAH_COMPILER_PERL_TH_INT';
  package Data::Sah::Compiler::perl::TH::int;
  
  our $DATE = '2015-04-14'; 
  our $VERSION = '0.51'; 
  
  use 5.010;
  use strict;
  use warnings;
  
  use Mo qw(build default);
  use Role::Tiny::With;
  
  extends 'Data::Sah::Compiler::perl::TH::num';
  with 'Data::Sah::Type::int';
  
  sub handle_type {
      my ($self, $cd) = @_;
      my $c = $self->compiler;
  
      my $dt = $cd->{data_term};
      $c->add_sun_module($cd);
      $cd->{_ccl_check_type} =
          "$cd->{_sun_module}::isint($dt)";
  }
  
  sub clause_div_by {
      my ($self, $cd) = @_;
      my $c  = $self->compiler;
      my $ct = $cd->{cl_term};
      my $dt = $cd->{data_term};
  
      $c->add_ccl($cd, "$dt % $ct == 0");
  }
  
  sub clause_mod {
      my ($self, $cd) = @_;
      my $c  = $self->compiler;
      my $ct = $cd->{cl_term};
      my $dt = $cd->{data_term};
  
      $c->add_ccl($cd, "$dt % $ct\->[0] == $ct\->[1]");
  }
  
  1;
  
  __END__
  
DATA_SAH_COMPILER_PERL_TH_INT

$fatpacked{"Data/Sah/Compiler/perl/TH/num.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'DATA_SAH_COMPILER_PERL_TH_NUM';
  package Data::Sah::Compiler::perl::TH::num;
  
  our $DATE = '2015-04-14'; 
  our $VERSION = '0.51'; 
  
  use 5.010;
  use strict;
  use warnings;
  
  use Mo qw(build default);
  use Role::Tiny::With;
  
  extends 'Data::Sah::Compiler::perl::TH';
  with 'Data::Sah::Type::num';
  
  sub handle_type {
      my ($self, $cd) = @_;
      my $c = $self->compiler;
      my $dt = $cd->{data_term};
  
      $c->add_sun_module($cd);
      $cd->{_ccl_check_type} = "$cd->{_sun_module}::isnum($dt)";
  }
  
  sub superclause_comparable {
      my ($self, $which, $cd) = @_;
      my $c  = $self->compiler;
      my $ct = $cd->{cl_term};
      my $dt = $cd->{data_term};
  
      if ($which eq 'is') {
          $c->add_ccl($cd, "$dt == $ct");
      } elsif ($which eq 'in') {
          $c->add_smartmatch_pragma($cd);
          $c->add_ccl($cd, "$dt ~~ $ct");
      }
  }
  
  sub superclause_sortable {
      my ($self, $which, $cd) = @_;
      my $c  = $self->compiler;
      my $cv = $cd->{cl_value};
      my $ct = $cd->{cl_term};
      my $dt = $cd->{data_term};
  
      if ($which eq 'min') {
          $c->add_ccl($cd, "$dt >= $ct");
      } elsif ($which eq 'xmin') {
          $c->add_ccl($cd, "$dt > $ct");
      } elsif ($which eq 'max') {
          $c->add_ccl($cd, "$dt <= $ct");
      } elsif ($which eq 'xmax') {
          $c->add_ccl($cd, "$dt < $ct");
      } elsif ($which eq 'between') {
          if ($cd->{cl_is_expr}) {
              $c->add_ccl($cd, "$dt >= $ct\->[0] && $dt <= $ct\->[1]");
          } else {
              $c->add_ccl($cd, "$dt >= $cv->[0] && $dt <= $cv->[1]");
          }
      } elsif ($which eq 'xbetween') {
          if ($cd->{cl_is_expr}) {
              $c->add_ccl($cd, "$dt > $ct\->[0] && $dt < $ct\->[1]");
          } else {
              $c->add_ccl($cd, "$dt > $cv->[0] && $dt < $cv->[1]");
          }
      }
  }
  
  1;
  
  __END__
  
DATA_SAH_COMPILER_PERL_TH_NUM

$fatpacked{"Data/Sah/Compiler/perl/TH/obj.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'DATA_SAH_COMPILER_PERL_TH_OBJ';
  package Data::Sah::Compiler::perl::TH::obj;
  
  our $DATE = '2015-04-14'; 
  our $VERSION = '0.51'; 
  
  use 5.010;
  use strict;
  use warnings;
  
  use Mo qw(build default);
  use Role::Tiny::With;
  
  extends 'Data::Sah::Compiler::perl::TH';
  with 'Data::Sah::Type::obj';
  
  sub handle_type {
      my ($self, $cd) = @_;
      my $c = $self->compiler;
  
      my $dt = $cd->{data_term};
      $c->add_module($cd, 'Scalar::Util');
      $cd->{_ccl_check_type} = "Scalar::Util::blessed($dt)";
  }
  
  sub clause_can {
      my ($self, $cd) = @_;
      my $c  = $self->compiler;
      my $ct = $cd->{cl_term};
      my $dt = $cd->{data_term};
  
      $c->add_ccl($cd, "$dt->can($ct)");
  }
  
  sub clause_isa {
      my ($self, $cd) = @_;
      my $c  = $self->compiler;
      my $ct = $cd->{cl_term};
      my $dt = $cd->{data_term};
  
      $c->add_ccl($cd, "$dt->isa($ct)");
  }
  
  1;
  
  __END__
  
DATA_SAH_COMPILER_PERL_TH_OBJ

$fatpacked{"Data/Sah/Compiler/perl/TH/re.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'DATA_SAH_COMPILER_PERL_TH_RE';
  package Data::Sah::Compiler::perl::TH::re;
  
  our $DATE = '2015-04-14'; 
  our $VERSION = '0.51'; 
  
  use 5.010;
  use strict;
  use warnings;
  
  use Mo qw(build default);
  use Role::Tiny::With;
  
  extends 'Data::Sah::Compiler::perl::TH';
  with 'Data::Sah::Type::re';
  
  
  sub handle_type {
      my ($self, $cd) = @_;
      my $c = $self->compiler;
  
      my $dt = $cd->{data_term};
      $cd->{_ccl_check_type} = "ref($dt) eq 'Regexp' || !ref($dt) && ".
          "eval { my \$tmp = $dt; qr/\$tmp/; 1 }";
  }
  
  1;
  
  __END__
  
DATA_SAH_COMPILER_PERL_TH_RE

$fatpacked{"Data/Sah/Compiler/perl/TH/str.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'DATA_SAH_COMPILER_PERL_TH_STR';
  package Data::Sah::Compiler::perl::TH::str;
  
  our $DATE = '2015-04-14'; 
  our $VERSION = '0.51'; 
  
  use 5.010;
  use strict;
  use warnings;
  
  use Mo qw(build default);
  use Role::Tiny::With;
  
  extends 'Data::Sah::Compiler::perl::TH';
  with 'Data::Sah::Type::str';
  
  sub handle_type {
      my ($self, $cd) = @_;
      my $c = $self->compiler;
  
      my $dt = $cd->{data_term};
      $cd->{_ccl_check_type} = "!ref($dt)";
  }
  
  sub superclause_comparable {
      my ($self, $which, $cd) = @_;
      my $c  = $self->compiler;
      my $ct = $cd->{cl_term};
      my $dt = $cd->{data_term};
  
      if ($which eq 'is') {
          $c->add_ccl($cd, "$dt eq $ct");
      } elsif ($which eq 'in') {
          $c->add_smartmatch_pragma($cd);
          $c->add_ccl($cd, "$dt ~~ $ct");
      }
  }
  
  sub superclause_sortable {
      my ($self, $which, $cd) = @_;
      my $c  = $self->compiler;
      my $cv = $cd->{cl_value};
      my $ct = $cd->{cl_term};
      my $dt = $cd->{data_term};
  
      if ($which eq 'min') {
          $c->add_ccl($cd, "$dt ge $ct");
      } elsif ($which eq 'xmin') {
          $c->add_ccl($cd, "$dt gt $ct");
      } elsif ($which eq 'max') {
          $c->add_ccl($cd, "$dt le $ct");
      } elsif ($which eq 'xmax') {
          $c->add_ccl($cd, "$dt lt $ct");
      } elsif ($which eq 'between') {
          if ($cd->{cl_is_expr}) {
              $c->add_ccl($cd, "$dt ge $ct\->[0] && $dt le $ct\->[1]");
          } else {
              $c->add_ccl($cd, "$dt ge ".$c->literal($cv->[0]).
                              " && $dt le ".$c->literal($cv->[1]));
          }
      } elsif ($which eq 'xbetween') {
          if ($cd->{cl_is_expr}) {
              $c->add_ccl($cd, "$dt gt $ct\->[0] && $dt lt $ct\->[1]");
          } else {
              $c->add_ccl($cd, "$dt gt ".$c->literal($cv->[0]).
                              " && $dt lt ".$c->literal($cv->[1]));
          }
      }
  }
  
  sub superclause_has_elems {
      my ($self_th, $which, $cd) = @_;
      my $c  = $self_th->compiler;
      my $cv = $cd->{cl_value};
      my $ct = $cd->{cl_term};
      my $dt = $cd->{data_term};
  
      if ($which eq 'len') {
          $c->add_ccl($cd, "length($dt) == $ct");
      } elsif ($which eq 'min_len') {
          $c->add_ccl($cd, "length($dt) >= $ct");
      } elsif ($which eq 'max_len') {
          $c->add_ccl($cd, "length($dt) <= $ct");
      } elsif ($which eq 'len_between') {
          if ($cd->{cl_is_expr}) {
              $c->add_ccl(
                  $cd, "length($dt) >= $ct\->[0] && ".
                      "length($dt) >= $ct\->[1]");
          } else {
              $c->add_ccl(
                  $cd, "length($dt) >= $cv->[0] && ".
                      "length($dt) <= $cv->[1]");
          }
      } elsif ($which eq 'has') {
          $c->add_ccl($cd, "index($dt, $ct) >= 0");
      } elsif ($which eq 'each_index') {
          $self_th->gen_each($cd, "0..length($dt)-1", '_', '$_');
      } elsif ($which eq 'each_elem') {
          $self_th->gen_each($cd, "0..length($dt)-1", '_', "substr($dt, \$_, 1)");
      } elsif ($which eq 'check_each_index') {
          $self_th->compiler->_die_unimplemented_clause($cd);
      } elsif ($which eq 'check_each_elem') {
          $self_th->compiler->_die_unimplemented_clause($cd);
      } elsif ($which eq 'uniq') {
          $self_th->compiler->_die_unimplemented_clause($cd);
      } elsif ($which eq 'exists') {
          $self_th->compiler->_die_unimplemented_clause($cd);
      }
  }
  
  sub clause_encoding {
      my ($self, $cd) = @_;
      my $c  = $self->compiler;
      my $cv = $cd->{cl_value};
      my $ct = $cd->{cl_term};
      my $dt = $cd->{data_term};
  
      $c->_die($cd, "Only 'utf8' encoding is currently supported")
          unless $cv eq 'utf8';
  }
  
  sub clause_match {
      my ($self, $cd) = @_;
      my $c  = $self->compiler;
      my $cv = $cd->{cl_value};
      my $ct = $cd->{cl_term};
      my $dt = $cd->{data_term};
  
      if ($cd->{cl_is_expr}) {
          $c->add_ccl($cd, join(
              "",
              "ref($ct) eq 'Regexp' ? $dt =~ $ct : ",
              "do { my \$re = $ct; eval { \$re = /\$re/; 1 } && ",
              "$dt =~ \$re }",
          ));
      } else {
          my $re = $c->_str2reliteral($cd, $cv);
          $c->add_ccl($cd, "$dt =~ qr($re)");
      }
  }
  
  sub clause_is_re {
      my ($self, $cd) = @_;
      my $c  = $self->compiler;
      my $cv = $cd->{cl_value};
      my $ct = $cd->{cl_term};
      my $dt = $cd->{data_term};
  
      if ($cd->{cl_is_expr}) {
          $c->add_ccl($cd, join(
              "",
              "do { my \$re = $dt; ",
              "(eval { \$re = qr/\$re/; 1 } ? 1:0) == ($ct ? 1:0) }",
          ));
      } else {
          $c->add_ccl($cd, join(
              "",
              "do { my \$re = $dt; ",
              ($cv ? "" : "!"), "(eval { \$re = qr/\$re/; 1 })",
              "}",
          ));
      }
  }
  
  1;
  
  __END__
  
DATA_SAH_COMPILER_PERL_TH_STR

$fatpacked{"Data/Sah/Compiler/perl/TH/undef.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'DATA_SAH_COMPILER_PERL_TH_UNDEF';
  package Data::Sah::Compiler::perl::TH::undef;
  
  our $DATE = '2015-04-14'; 
  our $VERSION = '0.51'; 
  
  use 5.010;
  use strict;
  use warnings;
  
  use Mo qw(build default);
  use Role::Tiny::With;
  
  extends 'Data::Sah::Compiler::perl::TH';
  with 'Data::Sah::Type::undef';
  
  sub handle_type {
      my ($self, $cd) = @_;
      my $c = $self->compiler;
  
      my $dt = $cd->{data_term};
      $cd->{_ccl_check_type} = "!defined($dt)";
  }
  
  1;
  
  __END__
  
DATA_SAH_COMPILER_PERL_TH_UNDEF

$fatpacked{"Data/Sah/Human.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'DATA_SAH_HUMAN';
  package Data::Sah::Human;
  
  our $DATE = '2015-04-14'; 
  our $VERSION = '0.51'; 
  
  use 5.010;
  use strict;
  use warnings;
  
  our $Log_Validator_Code = $ENV{LOG_SAH_VALIDATOR_CODE} // 0;
  
  require Exporter;
  our @ISA       = qw(Exporter);
  our @EXPORT_OK = qw(gen_human_msg);
  
  sub gen_human_msg {
      require Data::Sah;
  
      my ($schema, $opts) = @_;
  
      state $hc = Data::Sah->new->get_compiler("human");
  
      my %args = (schema => $schema, %{$opts // {}});
      my $opt_source = delete $args{source};
  
      $args{log_result} = 1 if $Log_Validator_Code;
  
      my $cd = $hc->compile(%args);
      $opt_source ? $cd : $cd->{result};
  }
  
  1;
  
  __END__
  
DATA_SAH_HUMAN

$fatpacked{"Data/Sah/JS.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'DATA_SAH_JS';
  package Data::Sah::JS;
  
  our $DATE = '2015-04-14'; 
  our $VERSION = '0.51'; 
  
  use 5.010;
  use strict;
  use warnings;
  
  our $Log_Validator_Code = $ENV{LOG_SAH_VALIDATOR_CODE} // 0;
  
  require Exporter;
  our @ISA       = qw(Exporter);
  our @EXPORT_OK = qw(gen_validator);
  
  sub get_nodejs_path {
      require File::Which;
  
      my $path;
      for my $name (qw/nodejs node/) {
          $path = File::Which::which($name);
          next unless $path;
  
          my $cmd = "$path -e 'console.log(1+1)'";
          my $out = `$cmd`;
          if ($out =~ /\A2\n?\z/) {
              return $path;
          } else {
          }
      }
      return undef;
  }
  
  sub gen_validator {
      require Data::Sah;
  
      my ($schema, $opts) = @_;
  
      state $jsc = Data::Sah->new->get_compiler("js");
  
      my %args = (schema => $schema, %{$opts // {}});
      my $opt_source = delete $args{source};
  
      $args{log_result} = 1 if $Log_Validator_Code;
  
      my $v_src = $jsc->expr_validator_sub(%args);
      return $v_src if $opt_source;
  
      state $nodejs_path = get_nodejs_path();
      die "Can't find node.js in PATH" unless $nodejs_path;
  
  
      sub {
          require File::Temp;
          require JSON;
  
          my $data = shift;
  
          state $json = JSON->new->allow_nonref;
  
          my $src = "var validator = $v_src;\n\n".
              "console.log(JSON.stringify(validator(".
                  $json->encode($data).")))";
  
          my ($jsh, $jsfn) = File::Temp::tempfile();
          print $jsh $src;
          close($jsh) or die "Can't write JS code to file $jsfn: $!";
  
          my $cmd = "$nodejs_path $jsfn";
          my $out = `$cmd`;
          $json->decode($out);
      };
  }
  
  1;
  
  __END__
  
DATA_SAH_JS

$fatpacked{"Data/Sah/Lang.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'DATA_SAH_LANG';
  package Data::Sah::Lang;
  
  our $DATE = '2015-04-14'; 
  our $VERSION = '0.51'; 
  
  use 5.010;
  use strict;
  use warnings;
  
  our @ISA    = qw(Exporter);
  our @EXPORT = qw(add_translations);
  
  sub add_translations {
      my %args = @_;
  
  }
  
  1;
  
  __END__
  
DATA_SAH_LANG

$fatpacked{"Data/Sah/Lang/fr_FR.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'DATA_SAH_LANG_FR_FR';
  package Data::Sah::Lang::fr_FR;
  
  our $DATE = '2015-04-14'; 
  our $VERSION = '0.51'; 
  
  use 5.010;
  use strict;
  use warnings;
  
  use Tie::IxHash;
  
  
  our %translations;
  tie %translations, 'Tie::IxHash', (
  
  
      q[ ], 
      q[ ],
  
      q[, ],
      q[, ],
  
      q[: ],
      q[: ],
  
      q[. ],
      q[. ],
  
      q[(],
      q[(],
  
      q[)],
      q[)],
  
  
      q[must],
      q[doit],
  
      q[must not],
      q[ne doit pas],
  
      q[should],
      q[devrait],
  
      q[should not],
      q[ne devrait pas],
  
  
      q[%s and %s],
      q[%s et %s],
  
      q[%s or %s],
      q[%s ou %s],
  
      q[one of %s],
      q[une des %s],
  
      q[all of %s],
      q[toutes les valeurs %s],
  
      q[%(modal_verb)s satisfy all of the following],
      q[%(modal_verb)s satisfaire Ã  toutes les conditions suivantes],
  
      q[%(modal_verb)s satisfy one of the following],
      q[%(modal_verb)s satisfaire l'une des conditions suivantes],
  
      q[%(modal_verb)s satisfy none of the following],
      q[%(modal_verb)s satisfaire Ã  aucune des conditions suivantes],
  
  
  
  
  
  
  
      q[integer],
      q[nombre entier],
  
      q[integers],
      q[nombres entiers],
  
      q[%(modal_verb)s be divisible by %s],
      q[%(modal_verb)s Ãªtre divisible par %s],
  
      q[%(modal_verb)s leave a remainder of %2$s when divided by %1$s],
      q[%(modal_verb)s laisser un reste %2$s si divisÃ© par %1$s],
  
  );
  
  1;
  
  __END__
  
DATA_SAH_LANG_FR_FR

$fatpacked{"Data/Sah/Lang/id_ID.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'DATA_SAH_LANG_ID_ID';
  package Data::Sah::Lang::id_ID;
  
  our $DATE = '2015-04-14'; 
  our $VERSION = '0.51'; 
  
  use 5.010;
  use strict;
  use warnings;
  
  use Tie::IxHash;
  
  sub ordinate {
      my ($n, $noun) = @_;
      "$noun ke-$n";
  }
  
  our %translations;
  tie %translations, 'Tie::IxHash', (
  
  
      q[ ], 
      q[ ],
  
      q[, ],
      q[, ],
  
      q[: ],
      q[: ],
  
      q[. ],
      q[. ],
  
      q[(],
      q[(],
  
      q[)],
      q[)],
  
  
      q[must],
      q[harus],
  
      q[must not],
      q[tidak boleh],
  
      q[should],
      q[sebaiknya],
  
      q[should not],
      q[sebaiknya tidak],
  
  
      q[%s and %s],
      q[%s dan %s],
  
      q[%s or %s],
      q[%s atau %s],
  
      q[%s nor %s],
      q[%s maupun %s],
  
      q[one of %s],
      q[salah satu dari %s],
  
      q[all of %s],
      q[semua dari nilai-nilai %s],
  
      q[any of %s],
      q[satupun dari %s],
  
      q[none of %s],
      q[tak satupun dari %s],
  
      q[%(modal_verb)s satisfy all of the following],
      q[%(modal_verb)s memenuhi semua ketentuan ini],
  
      q[%(modal_verb)s satisfy none all of the following],
      q[%(modal_verb)s melanggar semua ketentuan ini],
  
      q[%(modal_verb)s satisfy one of the following],
      q[%(modal_verb)s memenuhi salah satu ketentuan ini],
  
  
      q[default value is %s],
      q[jika tidak diisi diset ke %s],
  
      q[required %s],
      q[%s wajib diisi],
  
      q[optional %s],
      q[%s opsional],
  
      q[forbidden %s],
      q[%s tidak boleh diisi],
  
  
      q[%(modal_verb)s have the value %s],
      q[%(modal_verb)s bernilai %s],
  
      q[%(modal_verb)s be one of %s],
      q[%(modal_verb)s salah satu dari %s],
  
  
      q[length %(modal_verb)s be %s],
      q[panjang %(modal_verb)s %s],
  
      q[length %(modal_verb)s be at least %s],
      q[panjang %(modal_verb)s minimal %s],
  
      q[length %(modal_verb)s be at most %s],
      q[panjang %(modal_verb)s maksimal %s],
  
      q[length %(modal_verb)s be between %s and %s],
      q[panjang %(modal_verb)s antara %s dan %s],
  
      q[%(modal_verb)s have %s in its elements],
      q[%(modal_verb)s mengandung %s di elemennya],
  
  
      q[%(modal_verb)s be at least %s],
      q[%(modal_verb)s minimal %s],
  
      q[%(modal_verb)s be larger than %s],
      q[%(modal_verb)s lebih besar dari %s],
  
      q[%(modal_verb)s be at most %s],
      q[%(modal_verb)s maksimal %s],
  
      q[%(modal_verb)s be smaller than %s],
      q[%(modal_verb)s lebih kecil dari %s],
  
      q[%(modal_verb)s be between %s and %s],
      q[%(modal_verb)s antara %s dan %s],
  
      q[%(modal_verb)s be larger than %s and smaller than %s],
      q[%(modal_verb)s lebih besar dari %s dan lebih kecil dari %s],
  
  
      q[undefined value],
      q[nilai tak terdefinisi],
  
      q[undefined values],
      q[nilai tak terdefinisi],
  
  
      q[%(modal_verb)s be %s],
      q[%(modal_verb)s %s],
  
      q[as well as %s],
      q[juga %s],
  
      q[%(modal_verb)s be all of the following],
      q[%(modal_verb)s merupakan semua ini],
  
  
      q[%(modal_verb)s be either %s],
      q[%s],
  
      q[or %s],
      q[atau %s],
  
      q[%(modal_verb)s be one of the following],
      q[%(modal_verb)s merupakan salah satu dari],
  
  
      q[array],
      q[larik],
  
      q[arrays],
      q[larik],
  
      q[%s of %s],
      q[%s %s],
  
      q[each array element %(modal_verb)s be],
      q[setiap elemen larik %(modal_verb)s],
  
      q[%s %(modal_verb)s be],
      q[%s %(modal_verb)s],
  
      q[element],
      q[elemen],
  
      q[each array subscript %(modal_verb)s be],
      q[setiap subskrip larik %(modal_verb)s],
  
  
      q[boolean value],
      q[nilai boolean],
  
      q[boolean values],
      q[nilai boolean],
  
      q[%(modal_verb)s be true],
      q[%(modal_verb)s bernilai benar],
  
      q[%(modal_verb)s be false],
      q[%(modal_verb)s bernilai salah],
  
  
      q[code],
      q[kode],
  
      q[codes],
      q[kode],
  
  
      q[decimal number],
      q[bilangan desimal],
  
      q[decimal numbers],
      q[bilangan desimal],
  
      q[%(modal_verb)s be a NaN],
      q[%(modal_verb)s NaN],
  
      q[%(modal_verb_neg)s be a NaN],
      q[%(modal_verb_neg)s NaN],
  
      q[%(modal_verb)s be an infinity],
      q[%(modal_verb)s tak hingga],
  
      q[%(modal_verb_neg)s be an infinity],
      q[%(modal_verb_neg)s tak hingga],
  
      q[%(modal_verb)s be a positive infinity],
      q[%(modal_verb)s positif tak hingga],
  
      q[%(modal_verb_neg)s be a positive infinity],
      q[%(modal_verb_neg)s positif tak hingga],
  
      q[%(modal_verb)s be a negative infinity],
      q[%(modal_verb)s negatif tak hingga],
  
      q[%(modal_verb)s be a negative infinity],
      q[%(modal_verb)s negatif tak hingga],
  
  
      q[hash],
      q[hash],
  
      q[hashes],
      q[hash],
  
      q[field %s %(modal_verb)s be],
      q[field %s %(modal_verb)s],
  
      q[field name %(modal_verb)s be],
      q[nama field %(modal_verb)s],
  
      q[each field %(modal_verb)s be],
      q[setiap field %(modal_verb)s],
  
      q[hash contains unknown field(s) (%s)],
      q[hash mengandung field yang tidak dikenali (%s)],
  
      q[hash contains unknown field(s) (%s)],
      q[hash mengandung field yang tidak dikenali (%s)],
  
      q[%(modal_verb)s have required fields %s],
      q[%(modal_verb)s mengandung field wajib %s],
  
      q[hash has missing required field(s) (%s)],
      q[hash kekurangan field wajib (%s)],
  
      q[%(modal_verb)s have %s in its field values],
      q[%(modal_verb)s mengandung %s di nilai field],
  
      q[%(modal_verb)s only have these allowed fields %s],
      q[%(modal_verb)s hanya mengandung field yang diizinkan %s],
  
      q[%(modal_verb)s only have fields matching regex pattern %s],
      q[%(modal_verb)s hanya mengandung field yang namanya mengikuti pola regex %s],
  
      q[%(modal_verb_neg)s have these forbidden fields %s],
      q[%(modal_verb_neg)s mengandung field yang dilarang %s],
  
      q[%(modal_verb_neg)s have fields matching regex pattern %s],
      q[%(modal_verb_neg)s mengandung field yang namanya mengikuti pola regex %s],
  
      q[hash contains non-allowed field(s) (%s)],
      q[hash mengandung field yang tidak diizinkan (%s)],
  
      q[hash contains forbidden field(s) (%s)],
      q[hash mengandung field yang dilarang (%s)],
  
      q[fields whose names match regex pattern %s %(modal_verb)s be],
      q[field yang namanya cocok dengan pola regex %s %(modal_verb)s],
  
  
      q[integer],
      q[bilangan bulat],
  
      q[integers],
      q[bilangan bulat],
  
      q[%(modal_verb)s be divisible by %s],
      q[%(modal_verb)s dapat dibagi oleh %s],
  
      q[%(modal_verb)s be odd],
      q[%(modal_verb)s ganjil],
  
      q[%(modal_verb)s be even],
      q[%(modal_verb)s genap],
  
      q[%(modal_verb)s leave a remainder of %2$s when divided by %1$s],
      q[jika dibagi %1$s %(modal_verb)s menyisakan %2$s],
  
  
      q[number],
      q[bilangan],
  
      q[numbers],
      q[bilangan],
  
  
      q[object],
      q[objek],
  
      q[objects],
      q[objek],
  
  
      q[regex pattern],
      q[pola regex],
  
      q[regex patterns],
      q[pola regex],
  
  
      q[text],
      q[teks],
  
      q[texts],
      q[teks],
  
      q[%(modal_verb)s match regex pattern %s],
      q[%(modal_verb)s cocok dengan pola regex %s],
  
      q[%(modal_verb)s be a regex pattern],
      q[%(modal_verb)s pola regex],
  
      q[each subscript of text %(modal_verb)s be],
      q[setiap subskrip dari teks %(modal_verb)s],
  
      q[each character of the text %(modal_verb)s be],
      q[setiap karakter dari teks %(modal_verb)s],
  
      q[character],
      q[karakter],
  
  
  
      q[buffer],
      q[buffer],
  
      q[buffers],
      q[buffer],
  
  
      q[Does not satisfy the following schema: %s],
      q[Tidak memenuhi skema ini: %s],
  
      q[Not of type %s],
      q[Tidak bertipe %s],
  
      q[Required but not specified],
      q[Wajib tapi belum diisi],
  
      q[Forbidden but specified],
      q[Dilarang tapi diisi],
  
      q[Structure contains unknown field(s) [%%s]],
      q[Struktur mengandung field yang tidak dikenal [%%s]],
  
  );
  
  1;
  
  __END__
  
DATA_SAH_LANG_ID_ID

$fatpacked{"Data/Sah/Lang/zh_CN.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'DATA_SAH_LANG_ZH_CN';
  package Data::Sah::Lang::zh_CN;
  
  our $DATE = '2015-04-14'; 
  our $VERSION = '0.51'; 
  
  use 5.010;
  use strict;
  use warnings;
  
  use Tie::IxHash;
  
  
  our %translations;
  tie %translations, 'Tie::IxHash', (
  
  
      q[ ], 
      q[],
  
      q[, ],
      q[ï¼],
  
      q[: ],
      q[ï¼],
  
      q[. ],
      q[ã],
  
      q[(],
      q[ï¼],
  
      q[)],
      q[ï¼],
  
  
      q[must],
      q[å¿é¡»],
  
      q[must not],
      q[å¿é¡»ä¸],
  
      q[should],
      q[åº],
  
      q[should not],
      q[åºä¸],
  
  
      q[%s and %s],
      q[%så%s],
  
      q[%s or %s],
      q[%sæ%s],
  
      q[one of %s],
      q[è¿äºå¼%sä¹ä¸],
  
      q[all of %s],
      q[ææè¿äºå¼%s],
  
      q[%(modal_verb)s satisfy all of the following],
      q[%(modal_verb)sæ»¡è¶³ææè¿äºæ¡ä»¶],
  
      q[%(modal_verb)s satisfy one of the following],
      q[%(modal_verb)sæ»¡è¶³è¿äºæ¡ä»¶ä¹ä¸],
  
      q[%(modal_verb)s satisfy none of the following],
      q[%(modal_verb_neg)sæ»¡è¶³ææè¿äºæ¡ä»¶],
  
  
  
  
  
  
  
      q[integer],
      q[æ´æ°],
  
      q[integers],
      q[æ´æ°],
  
      q[%(modal_verb)s be divisible by %s],
      q[%(modal_verb)sè¢«%sæ´é¤],
  
      q[%(modal_verb)s leave a remainder of %2$s when divided by %1$s],
      q[é¤ä»¥%1$sæ¶ä½æ°%(modal_verb)sä¸º%2$s],
  
  );
  
  1;
  
  __END__
  
DATA_SAH_LANG_ZH_CN

$fatpacked{"Data/Sah/Normalize.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'DATA_SAH_NORMALIZE';
  package Data::Sah::Normalize;
  
  use 5.010001;
  use strict;
  use warnings;
  
  our $DATE = '2014-07-08'; 
  our $VERSION = '0.01'; 
  
  require Exporter;
  our @ISA       = qw(Exporter);
  our @EXPORT_OK = qw(
                         normalize_clset
                         normalize_schema
  
                         $type_re
                         $clause_name_re
                         $clause_re
                         $attr_re
                         $funcset_re
                         $compiler_re
                 );
  
  our $type_re        = qr/\A(?:[A-Za-z_]\w*::)*[A-Za-z_]\w*\z/;
  our $clause_name_re = qr/\A[A-Za-z_]\w*\z/;
  our $clause_re      = qr/\A[A-Za-z_]\w*(?:\.[A-Za-z_]\w*)*\z/;
  our $attr_re        = $clause_re;
  our $funcset_re     = qr/\A(?:[A-Za-z_]\w*::)*[A-Za-z_]\w*\z/;
  our $compiler_re    = qr/\A[A-Za-z_]\w*\z/;
  our $clause_attr_on_empty_clause_re = qr/\A(?:\.[A-Za-z_]\w*)+\z/;
  
  sub normalize_clset {
      my ($clset0, $opts) = @_;
      $opts //= {};
  
      my $clset = {};
      for my $c (sort keys %$clset0) {
          my $c0 = $c;
  
          my $v = $clset0->{$c};
  
          my $expr;
          if ($c =~ s/=\z//) {
              $expr++;
              die "Conflict between '$c=' and '$c'" if exists $clset0->{$c};
              $clset->{"$c.is_expr"} = 1;
              }
  
          my $sc = "";
          my $cn;
          {
              my $errp = "Invalid clause name syntax '$c0'"; 
              if (!$expr && $c =~ s/\A!(?=.)//) {
                  die "$errp, syntax should be !CLAUSE"
                      unless $c =~ $clause_name_re;
                  $sc = "!";
              } elsif (!$expr && $c =~ s/(?<=.)\|\z//) {
                  die "$errp, syntax should be CLAUSE|"
                      unless $c =~ $clause_name_re;
                  $sc = "|";
              } elsif (!$expr && $c =~ s/(?<=.)\&\z//) {
                  die "$errp, syntax should be CLAUSE&"
                      unless $c =~ $clause_name_re;
                  $sc = "&";
              } elsif (!$expr && $c =~ /\A([^.]+)(?:\.(.+))?\((\w+)\)\z/) {
                  my ($c2, $a, $lang) = ($1, $2, $3);
                  die "$errp, syntax should be CLAUSE(LANG) or C.ATTR(LANG)"
                      unless $c2 =~ $clause_name_re &&
                          (!defined($a) || $a =~ $attr_re);
                  $sc = "(LANG)";
                  $cn = $c2 . (defined($a) ? ".$a" : "") . ".alt.lang.$lang";
              } elsif ($c !~ $clause_re &&
                           $c !~ $clause_attr_on_empty_clause_re) {
                  die "$errp, please use letter/digit/underscore only";
              }
          }
  
          if ($sc eq '!') {
              die "Conflict between clause shortcuts '!$c' and '$c'"
                  if exists $clset0->{$c};
              die "Conflict between clause shortcuts '!$c' and '$c|'"
                  if exists $clset0->{"$c|"};
              die "Conflict between clause shortcuts '!$c' and '$c&'"
                  if exists $clset0->{"$c&"};
              $clset->{$c} = $v;
              $clset->{"$c.op"} = "not";
          } elsif ($sc eq '&') {
              die "Conflict between clause shortcuts '$c&' and '$c'"
                  if exists $clset0->{$c};
              die "Conflict between clause shortcuts '$c&' and '$c|'"
                  if exists $clset0->{"$c|"};
              die "Clause 'c&' value must be an array"
                  unless ref($v) eq 'ARRAY';
              $clset->{$c} = $v;
              $clset->{"$c.op"} = "and";
          } elsif ($sc eq '|') {
              die "Conflict between clause shortcuts '$c|' and '$c'"
                  if exists $clset0->{$c};
              die "Clause 'c|' value must be an array"
                  unless ref($v) eq 'ARRAY';
              $clset->{$c} = $v;
              $clset->{"$c.op"} = "or";
          } elsif ($sc eq '(LANG)') {
              die "Conflict between clause '$c' and '$cn'"
                  if exists $clset0->{$cn};
              $clset->{$cn} = $v;
          } else {
              $clset->{$c} = $v;
          }
  
      }
      $clset->{req} = 1 if $opts->{has_req};
  
  
      $clset;
  }
  
  sub normalize_schema {
      my ($s) = @_;
  
      my $ref = ref($s);
      if (!defined($s)) {
  
          die "Schema is missing";
  
      } elsif (!$ref) {
  
          my $has_req = $s =~ s/\*\z//;
          $s =~ $type_re or die "Invalid type syntax $s, please use ".
              "letter/digit/underscore only";
          return [$s, $has_req ? {req=>1} : {}, {}];
  
      } elsif ($ref eq 'ARRAY') {
  
          my $t = $s->[0];
          my $has_req = $t && $t =~ s/\*\z//;
          if (!defined($t)) {
              die "For array form, at least 1 element is needed for type";
          } elsif (ref $t) {
              die "For array form, first element must be a string";
          }
          $t =~ $type_re or die "Invalid type syntax $s, please use ".
              "letter/digit/underscore only";
  
          my $clset0;
          my $extras;
          if (defined($s->[1])) {
              if (ref($s->[1]) eq 'HASH') {
                  $clset0 = $s->[1];
                  $extras = $s->[2];
                  die "For array form, there should not be more than 3 elements"
                      if @$s > 3;
              } else {
                  die "For array in the form of [t, c1=>1, ...], there must be ".
                      "3 elements (or 5, 7, ...)"
                          unless @$s % 2;
                  $clset0 = { @{$s}[1..@$s-1] };
              }
          } else {
              $clset0 = {};
          }
  
          my $clset = normalize_clset($clset0, {has_req=>$has_req});
          if (defined $extras) {
              die "For array form with 3 elements, extras must be hash"
                  unless ref($extras) eq 'HASH';
              die "'def' in extras must be a hash"
                  if exists $extras->{def} && ref($extras->{def}) ne 'HASH';
              return [$t, $clset, { %{$extras} }];
          } else {
              return [$t, $clset, {}];
          }
      }
  
      die "Schema must be a string or arrayref (not $ref)";
  }
  
  1;
  
  __END__
  
DATA_SAH_NORMALIZE

$fatpacked{"Data/Sah/Type/BaseType.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'DATA_SAH_TYPE_BASETYPE';
  package Data::Sah::Type::BaseType;
  
  our $DATE = '2015-04-14'; 
  our $VERSION = '0.51'; 
  
  
  use 5.010;
  use strict;
  use warnings;
  
  use Data::Sah::Util::Role 'has_clause';
  use Role::Tiny;
  
  requires 'handle_type';
  
  has_clause 'v',
      prio=>0, tags=>['meta', 'defhash'],
      arg=>['int*'=>{is=>1}];
  
  
  
  
  has_clause 'ok',
      tags       => ['constraint'],
      prio       => 1,
      arg        => 'any',
      allow_expr => 1,
      ;
  has_clause 'default',
      prio       => 1,
      tags       => [],
      arg        => 'any',
      allow_expr => 1,
      attrs      => {
          temp => {
              arg        => [bool => default=>0],
              allow_expr => 0,
          },
      },
      ;
  has_clause 'default_lang',
      tags       => ['meta', 'defhash'],
      prio       => 2,
      arg        => ['str*'=>{default=>'en_US'}],
      ;
  has_clause 'name',
      tags       => ['meta', 'defhash'],
      prio       => 2,
      arg        => 'str*'
      ;
  has_clause 'summary',
      prio       => 2,
      tags       => ['meta', 'defhash'],
      arg        => 'str*',
      ;
  has_clause 'description',
      tags       => ['meta', 'defhash'],
      prio       => 2,
      arg        => 'str*',
      ;
  has_clause 'tags',
      tags       => ['meta', 'defhash'],
      prio       => 2,
      arg        => ['array*', of=>'str*'],
      ;
  has_clause 'req',
      tags       => ['constraint'],
      prio       => 3,
      arg        => 'bool',
      allow_expr => 1,
      ;
  has_clause 'forbidden',
      tags       => ['constraint'],
      prio       => 3,
      arg        => 'bool',
      allow_expr => 1,
      ;
  
  
  
  
  
  
  has_clause 'clause',
      tags       => ['constraint'],
      prio       => 50,
      arg        => ['array*' => elems => ['clname*', 'any']],
      ;
  has_clause 'clset',
      prio=>50, tags=>['constraint'],
      arg=>['clset*']
      ;
  
  1;
  
  __END__
  
DATA_SAH_TYPE_BASETYPE

$fatpacked{"Data/Sah/Type/Comparable.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'DATA_SAH_TYPE_COMPARABLE';
  package Data::Sah::Type::Comparable;
  
  our $DATE = '2015-04-14'; 
  our $VERSION = '0.51'; 
  
  use Data::Sah::Util::Role 'has_clause';
  use Role::Tiny;
  
  requires 'superclause_comparable';
  
  has_clause 'in',
      tags       => ['constraint'],
      arg        => '(any[])*',
      allow_expr => 1,
      code       => sub {
          my ($self, $cd) = @_;
          $self->superclause_comparable('in', $cd);
      };
  has_clause 'is',
      tags       => ['constraint'],
      arg        => 'any',
      allow_expr => 1,
      code       => sub {
          my ($self, $cd) = @_;
          $self->superclause_comparable('is', $cd);
      };
  
  1;
  
  __END__
  
DATA_SAH_TYPE_COMPARABLE

$fatpacked{"Data/Sah/Type/HasElems.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'DATA_SAH_TYPE_HASELEMS';
  package Data::Sah::Type::HasElems;
  
  our $DATE = '2015-04-14'; 
  our $VERSION = '0.51'; 
  
  use Data::Sah::Util::Role 'has_clause';
  use Role::Tiny;
  
  requires 'superclause_has_elems';
  
  has_clause 'max_len',
      prio       => 51,
      arg        => ['int*' => {min=>0}],
      allow_expr => 1,
      code       => sub {
          my ($self, $cd) = @_;
          $self->superclause_has_elems('max_len', $cd);
      };
  
  has_clause 'min_len',
      arg        => ['int*' => {min=>0}],
      allow_expr => 1,
      code       => sub {
          my ($self, $cd) = @_;
          $self->superclause_has_elems('min_len', $cd);
      };
  
  has_clause 'len_between',
      arg        => ['array*' => {elems => ['int*', 'int*']}],
      allow_expr => 1,
      code       => sub {
          my ($self, $cd) = @_;
          $self->superclause_has_elems('len_between', $cd);
      };
  
  has_clause 'len',
      arg        => ['int*' => {min=>0}],
      allow_expr => 1,
      code       => sub {
          my ($self, $cd) = @_;
          $self->superclause_has_elems('len', $cd);
      };
  
  has_clause 'has',
      arg        => 'any',
      allow_expr => 1,
      code       => sub {
          my ($self, $cd) = @_;
          $self->superclause_has_elems('has', $cd);
      };
  
  has_clause 'each_index',
      arg        => 'schema*',
      allow_expr => 0,
      code       => sub {
          my ($self, $cd) = @_;
          $self->superclause_has_elems('each_index', $cd);
      };
  
  has_clause 'each_elem',
      arg        => 'schema*',
      allow_expr => 0,
      code       => sub {
          my ($self, $cd) = @_;
          $self->superclause_has_elems('each_elem', $cd);
      };
  
  has_clause 'check_each_index',
      arg        => 'schema*',
      allow_expr => 0,
      code       => sub {
          my ($self, $cd) = @_;
          $self->superclause_has_elems('check_each_index', $cd);
      };
  
  has_clause 'check_each_elem',
      arg        => 'schema*',
      allow_expr => 0,
      code       => sub {
          my ($self, $cd) = @_;
          $self->superclause_has_elems('check_each_elem', $cd);
      };
  
  has_clause 'uniq',
      arg        => 'schema*',
      allow_expr => 1,
      code       => sub {
          my ($self, $cd) = @_;
          $self->superclause_has_elems('uniq', $cd);
      };
  
  has_clause 'exists',
      arg        => 'schema*',
      allow_expr => 0,
      code       => sub {
          my ($self, $cd) = @_;
          $self->superclause_has_elems('exists', $cd);
      };
  
  
  
  
  1;
  
  __END__
  
DATA_SAH_TYPE_HASELEMS

$fatpacked{"Data/Sah/Type/Sortable.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'DATA_SAH_TYPE_SORTABLE';
  package Data::Sah::Type::Sortable;
  
  our $DATE = '2015-04-14'; 
  our $VERSION = '0.51'; 
  
  use Data::Sah::Util::Role 'has_clause';
  use Role::Tiny;
  
  requires 'superclause_sortable';
  
  has_clause 'min',
      tags       => ['constraint'],
      arg        => 'any*',
      allow_expr => 1,
      code       => sub {
          my ($self, $cd) = @_;
          $self->superclause_sortable('min', $cd);
      },
      ;
  has_clause 'xmin',
      tags       => ['constraint'],
      arg        => 'any*',
      allow_expr => 1,
      code       => sub {
          my ($self, $cd) = @_;
          $self->superclause_sortable('xmin', $cd);
      },
      ;
  has_clause 'max',
      prio       => 51,
      tags       => ['constraint'],
      arg        => 'any*',
      allow_expr => 1,
      code       => sub {
          my ($self, $cd) = @_;
          $self->superclause_sortable('max', $cd);
      },
      ;
  has_clause 'xmax',
      prio       => 51,
      tags       => ['constraint'],
      arg        => 'any*',
      allow_expr => 1,
      code       => sub {
          my ($self, $cd) = @_;
          $self->superclause_sortable('xmax', $cd);
      },
      ;
  has_clause 'between',
      tags       => ['constraint'],
      arg        => '[any*, any*]*',
      allow_expr => 1,
      code       => sub {
          my ($self, $cd) = @_;
          $self->superclause_sortable('between', $cd);
      },
      ;
  has_clause 'xbetween',
      tags       => ['constraint'],
      arg        => '[any*, any*]*',
      allow_expr => 1,
      code => sub {
          my ($self, $cd) = @_;
          $self->superclause_sortable('xbetween', $cd);
      },
      ;
  
  1;
  
  __END__
  
DATA_SAH_TYPE_SORTABLE

$fatpacked{"Data/Sah/Type/all.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'DATA_SAH_TYPE_ALL';
  package Data::Sah::Type::all;
  
  our $DATE = '2015-04-14'; 
  our $VERSION = '0.51'; 
  
  use Data::Sah::Util::Role 'has_clause';
  use Role::Tiny;
  use Role::Tiny::With;
  
  with 'Data::Sah::Type::BaseType';
  
  has_clause 'of',
      tags       => ['constraint'],
      arg        => ['array*' => {min_len=>1, each_elem => 'schema*'}],
      allow_expr => 0,
      ;
  
  1;
  
  __END__
  
DATA_SAH_TYPE_ALL

$fatpacked{"Data/Sah/Type/any.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'DATA_SAH_TYPE_ANY';
  package Data::Sah::Type::any;
  
  our $DATE = '2015-04-14'; 
  our $VERSION = '0.51'; 
  
  use Data::Sah::Util::Role 'has_clause';
  use Role::Tiny;
  use Role::Tiny::With;
  
  with 'Data::Sah::Type::BaseType';
  
  has_clause 'of',
      tags       => ['constraint'],
      arg        => ['array*' => {min_len=>1, each_elem => 'schema*'}],
      allow_expr => 0,
      ;
  
  1;
  
  __END__
  
DATA_SAH_TYPE_ANY

$fatpacked{"Data/Sah/Type/array.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'DATA_SAH_TYPE_ARRAY';
  package Data::Sah::Type::array;
  
  our $DATE = '2015-04-14'; 
  our $VERSION = '0.51'; 
  
  use Data::Sah::Util::Role 'has_clause', 'has_clause_alias';
  use Role::Tiny;
  use Role::Tiny::With;
  
  with 'Data::Sah::Type::BaseType';
  with 'Data::Sah::Type::Comparable';
  with 'Data::Sah::Type::HasElems';
  
  has_clause 'elems',
      tags       => ['constraint'],
      arg        => ['array*' => {of=>'schema*'}],
      allow_expr => 0,
      attrs      => {
          create_default => {
              arg        => [bool => default=>1],
              allow_expr => 0, 
          },
      },
      ;
  has_clause_alias each_elem => 'of';
  
  1;
  
  __END__
  
DATA_SAH_TYPE_ARRAY

$fatpacked{"Data/Sah/Type/bool.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'DATA_SAH_TYPE_BOOL';
  package Data::Sah::Type::bool;
  
  our $DATE = '2015-04-14'; 
  our $VERSION = '0.51'; 
  
  use Data::Sah::Util::Role 'has_clause';
  use Role::Tiny;
  use Role::Tiny::With;
  
  with 'Data::Sah::Type::BaseType';
  with 'Data::Sah::Type::Comparable';
  with 'Data::Sah::Type::Sortable';
  
  has_clause 'is_true',
      tags       => ['constraint'],
      arg        => 'bool',
      allow_expr => 1,
      ;
  
  1;
  
  __END__
  
DATA_SAH_TYPE_BOOL

$fatpacked{"Data/Sah/Type/buf.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'DATA_SAH_TYPE_BUF';
  package Data::Sah::Type::buf;
  
  our $DATE = '2015-04-14'; 
  our $VERSION = '0.51'; 
  
  use Role::Tiny;
  use Role::Tiny::With;
  
  with 'Data::Sah::Type::str';
  
  1;
  
  __END__
  
DATA_SAH_TYPE_BUF

$fatpacked{"Data/Sah/Type/cistr.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'DATA_SAH_TYPE_CISTR';
  package Data::Sah::Type::cistr;
  
  our $DATE = '2015-04-14'; 
  our $VERSION = '0.51'; 
  
  use Role::Tiny;
  use Role::Tiny::With;
  
  with 'Data::Sah::Type::str';
  
  1;
  
  __END__
  
DATA_SAH_TYPE_CISTR

$fatpacked{"Data/Sah/Type/code.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'DATA_SAH_TYPE_CODE';
  package Data::Sah::Type::code;
  
  our $DATE = '2015-04-14'; 
  our $VERSION = '0.51'; 
  
  use Role::Tiny;
  use Role::Tiny::With;
  
  with 'Data::Sah::Type::BaseType';
  
  1;
  
  __END__
  
DATA_SAH_TYPE_CODE

$fatpacked{"Data/Sah/Type/date.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'DATA_SAH_TYPE_DATE';
  package Data::Sah::Type::date;
  
  our $DATE = '2015-04-14'; 
  our $VERSION = '0.51'; 
  
  use Data::Sah::Util::Role 'has_clause';
  use Role::Tiny;
  use Role::Tiny::With;
  
  with 'Data::Sah::Type::BaseType';
  with 'Data::Sah::Type::Comparable';
  with 'Data::Sah::Type::Sortable';
  
  
  1;
  
  __END__
  
DATA_SAH_TYPE_DATE

$fatpacked{"Data/Sah/Type/float.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'DATA_SAH_TYPE_FLOAT';
  package Data::Sah::Type::float;
  
  our $DATE = '2015-04-14'; 
  our $VERSION = '0.51'; 
  
  use Data::Sah::Util::Role 'has_clause';
  use Role::Tiny;
  use Role::Tiny::With;
  
  with 'Data::Sah::Type::num';
  
  has_clause 'is_nan',
      tags        => ['constraint'],
      arg         => ['bool'],
      allow_expr  => 1,
      allow_multi => 0,
      ;
  
  has_clause 'is_inf',
      tags        => ['constraint'],
      arg         => ['bool'],
      allow_expr  => 1,
      allow_multi => 1,
      ;
  
  has_clause 'is_pos_inf',
      tags        => ['constraint'],
      arg         => ['bool'],
      allow_expr  => 1,
      allow_multi => 1,
      ;
  
  has_clause 'is_neg_inf',
      tags        => ['constraint'],
      arg         => ['bool'],
      allow_expr  => 1,
      allow_multi => 1,
      ;
  
  1;
  
  __END__
  
DATA_SAH_TYPE_FLOAT

$fatpacked{"Data/Sah/Type/hash.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'DATA_SAH_TYPE_HASH';
  package Data::Sah::Type::hash;
  
  our $DATE = '2015-04-14'; 
  our $VERSION = '0.51'; 
  
  use Data::Sah::Util::Role 'has_clause', 'has_clause_alias';
  use Role::Tiny;
  use Role::Tiny::With;
  
  with 'Data::Sah::Type::BaseType';
  with 'Data::Sah::Type::Comparable';
  with 'Data::Sah::Type::HasElems';
  
  has_clause_alias each_elem => 'of';
  
  has_clause "keys",
      tags       => ['constraint'],
      arg        => ['hash*' => {values => 'schema*'}],
      allow_expr => 0,
      attrs      => {
          restrict => {
              arg        => [bool => default=>1],
              allow_expr => 0, 
          },
          create_default => {
              arg        => [bool => default=>1],
              allow_expr => 0, 
          },
      },
      ;
  has_clause "re_keys",
      prio       => 51,
      tags       => ['constraint'],
      arg        => ['hash*' => {keys => 're*', values => 'schema*'}],
      allow_expr => 0,
      attrs      => {
          restrict => {
              arg        => [bool => default=>1],
              allow_expr => 0, 
          },
      },
      ;
  has_clause "req_keys",
      tags       => ['constraint'],
      arg        => ['array*'],
      allow_expr => 1,
      ;
  has_clause "allowed_keys",
      tags       => ['constraint'],
      arg        => ['array*'],
      allow_expr => 1,
      ;
  has_clause "allowed_keys_re",
      prio       => 51,
      tags       => ['constraint'],
      arg        => 're*',
      allow_expr => 1,
      ;
  has_clause "forbidden_keys",
      tags       => ['constraint'],
      arg        => ['array*'],
      allow_expr => 1,
      ;
  has_clause "forbidden_keys_re",
      prio       => 51,
      tags       => ['constraint'],
      arg        => 're*',
      allow_expr => 1,
      ;
  has_clause_alias each_index => 'each_key';
  has_clause_alias each_elem => 'each_value';
  has_clause_alias check_each_index => 'check_each_key';
  has_clause_alias check_each_elem => 'check_each_value';
  
  
  
  1;
  
  __END__
  
DATA_SAH_TYPE_HASH

$fatpacked{"Data/Sah/Type/int.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'DATA_SAH_TYPE_INT';
  package Data::Sah::Type::int;
  
  our $DATE = '2015-04-14'; 
  our $VERSION = '0.51'; 
  
  use Data::Sah::Util::Role 'has_clause';
  use Role::Tiny;
  use Role::Tiny::With;
  
  with 'Data::Sah::Type::num';
  
  has_clause 'mod',
      tags       => ['constraint'],
      arg        => ['array*' => {elems => [['int*' => {'!is'=>0}], 'int*']}],
      allow_expr => 1,
      ;
  has_clause 'div_by',
      tags       => ['constraint'],
      arg        => ['int*' => {'!is'=>0}],
      allow_expr => 1,
      ;
  
  1;
  
  __END__
  
DATA_SAH_TYPE_INT

$fatpacked{"Data/Sah/Type/num.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'DATA_SAH_TYPE_NUM';
  package Data::Sah::Type::num;
  
  our $DATE = '2015-04-14'; 
  our $VERSION = '0.51'; 
  
  use Role::Tiny;
  use Role::Tiny::With;
  
  with 'Data::Sah::Type::BaseType';
  with 'Data::Sah::Type::Comparable';
  with 'Data::Sah::Type::Sortable';
  
  1;
  
  __END__
  
DATA_SAH_TYPE_NUM

$fatpacked{"Data/Sah/Type/obj.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'DATA_SAH_TYPE_OBJ';
  package Data::Sah::Type::obj;
  
  our $DATE = '2015-04-14'; 
  our $VERSION = '0.51'; 
  
  use Data::Sah::Util::Role 'has_clause';
  use Role::Tiny;
  use Role::Tiny::With;
  
  with 'Data::Sah::Type::BaseType';
  
  has_clause 'can',
      tags       => ['constraint'],
      arg        => 'str*', 
      allow_expr => 1,
      ;
  has_clause 'isa',
      tags       => ['constraint'],
      arg        => 'str*', 
      allow_expr => 1,
      ;
  
  1;
  
  __END__
  
DATA_SAH_TYPE_OBJ

$fatpacked{"Data/Sah/Type/re.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'DATA_SAH_TYPE_RE';
  package Data::Sah::Type::re;
  
  our $DATE = '2015-04-14'; 
  our $VERSION = '0.51'; 
  
  use Data::Sah::Util::Role 'has_clause';
  use Role::Tiny;
  use Role::Tiny::With;
  
  with 'Data::Sah::Type::BaseType';
  
  1;
  
  __END__
  
DATA_SAH_TYPE_RE

$fatpacked{"Data/Sah/Type/str.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'DATA_SAH_TYPE_STR';
  package Data::Sah::Type::str;
  
  our $DATE = '2015-04-14'; 
  our $VERSION = '0.51'; 
  
  use Data::Sah::Util::Role 'has_clause';
  use Role::Tiny;
  use Role::Tiny::With;
  
  with 'Data::Sah::Type::BaseType';
  with 'Data::Sah::Type::Comparable';
  with 'Data::Sah::Type::Sortable';
  with 'Data::Sah::Type::HasElems';
  
  my $t_re = 'regex*|{*=>regex*}';
  
  has_clause 'encoding',
      tags       => ['constraint'],
      arg        => 'str*',
      allow_expr => 0,
      ;
  has_clause 'match',
      tags       => ['constraint'],
      arg        => $t_re,
      allow_expr => 1,
      ;
  has_clause 'is_re',
      tags       => ['constraint'],
      arg        => 'bool',
      allow_expr => 1,
      ;
  
  1;
  
  __END__
  
DATA_SAH_TYPE_STR

$fatpacked{"Data/Sah/Type/undef.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'DATA_SAH_TYPE_UNDEF';
  package Data::Sah::Type::undef;
  
  our $DATE = '2015-04-14'; 
  our $VERSION = '0.51'; 
  
  use Role::Tiny;
  use Data::Sah::Util::Role 'has_clause';
  
  1;
  
  __END__
  
DATA_SAH_TYPE_UNDEF

$fatpacked{"Data/Sah/Util/Func.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'DATA_SAH_UTIL_FUNC';
  package Data::Sah::Util::Func;
  
  our $DATE = '2015-04-14'; 
  our $VERSION = '0.51'; 
  
  use 5.010;
  use strict;
  use warnings;
  
  
  require Exporter;
  our @ISA = qw(Exporter);
  our @EXPORT_OK = qw(
                         add_func
                 );
  
  sub add_func {
      my ($funcset, $func, %opts) = @_;
  }
  
  1;
  
  __END__
  
DATA_SAH_UTIL_FUNC

$fatpacked{"Data/Sah/Util/Role.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'DATA_SAH_UTIL_ROLE';
  package Data::Sah::Util::Role;
  
  our $DATE = '2015-04-14'; 
  our $VERSION = '0.51'; 
  
  use 5.010;
  use strict;
  use warnings;
  
  use Sub::Install qw(install_sub);
  
  require Exporter;
  our @ISA = qw(Exporter);
  our @EXPORT_OK = qw(
                         has_clause has_clause_alias
                         has_func   has_func_alias
                 );
  
  sub has_clause {
      my ($name, %args) = @_;
      my $caller = caller;
      my $into   = $args{into} // $caller;
  
      if ($args{code}) {
          install_sub({code => $args{code}, into => $into,
                       as => "clause_$name"});
      } else {
          eval "package $into; use Role::Tiny; ".
              "requires 'clause_$name';";
      }
      install_sub({code => sub {
                       state $meta = {
                           names      => [$name],
                           tags       => $args{tags},
                           prio       => $args{prio} // 50,
                           arg        => $args{arg},
                           allow_expr => $args{allow_expr},
                           attrs      => $args{attrs} // {},
                       };
                       $meta;
                   },
                   into => $into,
                   as => "clausemeta_$name"});
      has_clause_alias($name, $args{alias}  , $into);
      has_clause_alias($name, $args{aliases}, $into);
  }
  
  sub has_clause_alias {
      my ($name, $aliases, $into) = @_;
      my $caller   = caller;
      $into      //= $caller;
      my @aliases = !$aliases ? () :
          ref($aliases) eq 'ARRAY' ? @$aliases : $aliases;
      my $meta = $into->${\("clausemeta_$name")};
  
      for my $alias (@aliases) {
          push @{ $meta->{names} }, $alias;
          eval
              "package $into;".
              "sub clause_$alias { shift->clause_$name(\@_) } ".
              "sub clausemeta_$alias { shift->clausemeta_$name(\@_) } ";
          $@ and die "Can't make clause alias $alias -> $name: $@";
      }
  }
  
  sub has_func {
      my ($name, %args) = @_;
      my $caller = caller;
      my $into   = $args{into} // $caller;
  
      if ($args{code}) {
          install_sub({code => $args{code}, into => $into, as => "func_$name"});
      } else {
          eval "package $into; use Role::Tiny; requires 'func_$name';";
      }
      install_sub({code => sub {
                       state $meta = {
                           names => [$name],
                           args  => $args{args},
                       };
                       $meta;
                   },
                   into => $into,
                   as => "funcmeta_$name"});
      my @aliases =
          map { (!$args{$_} ? () :
                     ref($args{$_}) eq 'ARRAY' ? @{ $args{$_} } : $args{$_}) }
              qw/alias aliases/;
      has_func_alias($name, $args{alias}  , $into);
      has_func_alias($name, $args{aliases}, $into);
  }
  
  sub has_func_alias {
      my ($name, $aliases, $into) = @_;
      my $caller   = caller;
      $into      //= $caller;
      my @aliases = !$aliases ? () :
          ref($aliases) eq 'ARRAY' ? @$aliases : $aliases;
      my $meta = $into->${\("funcmeta_$name")};
  
      for my $alias (@aliases) {
          push @{ $meta->{names} }, $alias;
          eval
              "package $into;".
              "sub func_$alias { shift->func_$name(\@_) } ".
              "sub funcmeta_$alias { shift->funcmeta_$name(\@_) } ";
          $@ and die "Can't make func alias $alias -> $name: $@";
      }
  }
  
  1;
  
  __END__
  
DATA_SAH_UTIL_ROLE

$fatpacked{"Data/Sah/Util/Type.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'DATA_SAH_UTIL_TYPE';
  package Data::Sah::Util::Type;
  
  our $DATE = '2015-01-20'; 
  our $VERSION = '0.42'; 
  
  use 5.010001;
  use strict;
  use warnings;
  
  require Exporter;
  our @ISA       = qw(Exporter);
  our @EXPORT_OK = qw(get_type is_simple is_numeric is_collection is_ref);
  
  my $type_metas = {
      all   => {scalar=>0, numeric=>0, ref=>0},
      any   => {scalar=>0, numeric=>0, ref=>0},
      array => {scalar=>0, numeric=>0, ref=>1},
      bool  => {scalar=>1, numeric=>0, ref=>0},
      buf   => {scalar=>1, numeric=>0, ref=>0},
      cistr => {scalar=>1, numeric=>0, ref=>0},
      code  => {scalar=>1, numeric=>0, ref=>1},
      float => {scalar=>1, numeric=>1, ref=>0},
      hash  => {scalar=>0, numeric=>0, ref=>1},
      int   => {scalar=>1, numeric=>1, ref=>0},
      num   => {scalar=>1, numeric=>1, ref=>0},
      obj   => {scalar=>1, numeric=>0, ref=>1},
      re    => {scalar=>1, numeric=>0, ref=>1, simple=>1},
      str   => {scalar=>1, numeric=>0, ref=>0},
      undef => {scalar=>1, numeric=>0, ref=>0},
  };
  
  sub get_type {
      my $sch = shift;
  
      if (ref($sch) eq 'ARRAY') {
          $sch = $sch->[0];
      }
  
      if (defined($sch) && !ref($sch)) {
          $sch =~ s/\*\z//;
          return $sch;
      } else {
          return undef;
      }
  }
  
  sub _normalize {
      require Data::Sah::Normalize;
  
      my ($sch, $opts) = @_;
      return $sch if $opts->{schema_is_normalized};
      return Data::Sah::Normalize::normalize_schema($sch);
  }
  
  sub _handle_any_all {
      my ($sch, $opts, $crit) = @_;
      $sch = _normalize($sch, $opts);
      return 0 if $sch->[1]{'of.op'};
      my $of = $sch->[1]{of};
      return 0 unless $of && ref($of) eq 'ARRAY' && @$of;
      for (@$of) {
          return 0 unless $crit->($_);
      }
      1;
  }
  
  sub is_simple {
      my ($sch, $opts) = @_;
      $opts //= {};
  
      my $type = get_type($sch) or return undef;
      my $tmeta = $type_metas->{$type} or return undef;
      if ($type eq 'any' || $type eq 'all') {
          return _handle_any_all($sch, $opts, sub { is_simple(shift) });
      }
      return $tmeta->{simple} // ($tmeta->{scalar} && !$tmeta->{ref});
  }
  
  sub is_collection {
      my ($sch, $opts) = @_;
      $opts //= {};
  
      my $type = get_type($sch) or return undef;
      my $tmeta = $type_metas->{$type} or return undef;
      if ($type eq 'any' || $type eq 'all') {
          return _handle_any_all($sch, $opts, sub { is_collection(shift) });
      }
      return !$tmeta->{scalar};
  }
  
  sub is_numeric {
      my ($sch, $opts) = @_;
      $opts //= {};
  
      my $type = get_type($sch) or return undef;
      my $tmeta = $type_metas->{$type} or return undef;
      if ($type eq 'any' || $type eq 'all') {
          return _handle_any_all($sch, $opts, sub { is_numeric(shift) });
      }
      return $tmeta->{numeric};
  }
  
  sub is_ref {
      my ($sch, $opts) = @_;
      $opts //= {};
  
      my $type = get_type($sch) or return undef;
      my $tmeta = $type_metas->{$type} or return undef;
      if ($type eq 'any' || $type eq 'all') {
          return _handle_any_all($sch, $opts, sub { is_ref(shift) });
      }
      return $tmeta->{ref};
  }
  
  1;
  
  __END__
  
DATA_SAH_UTIL_TYPE

$fatpacked{"Data/Sah/Util/Type/Date.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'DATA_SAH_UTIL_TYPE_DATE';
  package Data::Sah::Util::Type::Date;
  
  our $DATE = '2015-04-14'; 
  our $VERSION = '0.51'; 
  
  use 5.010;
  use strict;
  use warnings;
  
  use Scalar::Util qw(blessed looks_like_number);
  
  require Exporter;
  our @ISA = qw(Exporter);
  our @EXPORT_OK = qw(
                         coerce_date
                 );
  
  sub coerce_date {
      my $val = shift;
      if (!defined($val)) {
          return undef;
      } elsif (blessed($val) && $val->isa('DateTime')) {
          return $val;
      } elsif (looks_like_number($val) && $val >= 10**8 && $val <= 2**31) {
          require DateTime;
          return DateTime->from_epoch(epoch => $val);
      } elsif ($val =~ /\A([0-9]{4})-([0-9]{2})-([0-9]{2})\z/) {
          require DateTime;
          my $d;
          eval { $d = DateTime->new(year=>$1, month=>$2, day=>$3) };
          return undef if $@;
          return $d;
      } else {
          return undef;
      }
  }
  
  1;
  
  __END__
  
DATA_SAH_UTIL_TYPE_DATE

$fatpacked{"Data/Sah/Util/TypeX.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'DATA_SAH_UTIL_TYPEX';
  package Data::Sah::Util::TypeX;
  
  our $DATE = '2015-04-14'; 
  our $VERSION = '0.51'; 
  
  use 5.010;
  use strict;
  use warnings;
  
  
  require Exporter;
  our @ISA = qw(Exporter);
  our @EXPORT_OK = qw(
                         add_clause
                 );
  
  sub add_clause {
      my ($type, $clause, %opts) = @_;
  
  
  }
  
  1;
  
  __END__
  
DATA_SAH_UTIL_TYPEX

$fatpacked{"Date/Parse.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'DATE_PARSE';
  
  package Date::Parse;
  
  require 5.000;
  use strict;
  use vars qw($VERSION @ISA @EXPORT);
  use Time::Local;
  use Carp;
  use Time::Zone;
  use Exporter;
  
  @ISA = qw(Exporter);
  @EXPORT = qw(&strtotime &str2time &strptime);
  
  $VERSION = "2.30";
  
  my %month = (
  	january		=> 0,
  	february	=> 1,
  	march		=> 2,
  	april		=> 3,
  	may		=> 4,
  	june		=> 5,
  	july		=> 6,
  	august		=> 7,
  	september	=> 8,
  	sept		=> 8,
  	october		=> 9,
  	november	=> 10,
  	december	=> 11,
  	);
  
  my %day = (
  	sunday		=> 0,
  	monday		=> 1,
  	tuesday		=> 2,
  	tues		=> 2,
  	wednesday	=> 3,
  	wednes		=> 3,
  	thursday	=> 4,
  	thur		=> 4,
  	thurs		=> 4,
  	friday		=> 5,
  	saturday	=> 6,
  	);
  
  my @suf = (qw(th st nd rd th th th th th th)) x 3;
  @suf[11,12,13] = qw(th th th);
  
  
  map { $month{substr($_,0,3)} = $month{$_} } keys %month;
  map { $day{substr($_,0,3)}   = $day{$_} }   keys %day;
  
  my $strptime = <<'ESQ';
   my %month = map { lc $_ } %$mon_ref;
   my $daypat = join("|", map { lc $_ } reverse sort keys %$day_ref);
   my $monpat = join("|", reverse sort keys %month);
   my $sufpat = join("|", reverse sort map { lc $_ } @$suf_ref);
  
   my %ampm = (
  	'a' => 0,  # AM
  	'p' => 12, # PM
  	);
  
   my($AM, $PM) = (0,12);
  
  sub {
  
    my $dtstr = lc shift;
    my $merid = 24;
  
    my($year,$month,$day,$hh,$mm,$ss,$zone,$dst,$frac);
  
    $zone = tz_offset(shift) if @_;
  
    1 while $dtstr =~ s#\([^\(\)]*\)# #o;
  
    $dtstr =~ s#(\A|\n|\Z)# #sog;
  
    # ignore day names
    $dtstr =~ s#([\d\w\s])[\.\,]\s#$1 #sog;
    $dtstr =~ s/,/ /g;
    $dtstr =~ s#($daypat)\s*(den\s)?\b# #o;
    # Time: 12:00 or 12:00:00 with optional am/pm
  
    return unless $dtstr =~ /\S/;
    
    if ($dtstr =~ s/\s(\d{4})([-:]?)(\d\d?)\2(\d\d?)(?:[-Tt ](\d\d?)(?:([-:]?)(\d\d?)(?:\6(\d\d?)(?:[.,](\d+))?)?)?)?(?=\D)/ /) {
      ($year,$month,$day,$hh,$mm,$ss,$frac) = ($1,$3-1,$4,$5,$7,$8,$9);
    }
  
    unless (defined $hh) {
      if ($dtstr =~ s#[:\s](\d\d?):(\d\d?)(:(\d\d?)(?:\.\d+)?)?(z)?\s*(?:([ap])\.?m?\.?)?\s# #o) {
        ($hh,$mm,$ss) = ($1,$2,$4);
        $zone = 0 if $5;
        $merid = $ampm{$6} if $6;
      }
  
      # Time: 12 am
      
      elsif ($dtstr =~ s#\s(\d\d?)\s*([ap])\.?m?\.?\s# #o) {
        ($hh,$mm,$ss) = ($1,0,0);
        $merid = $ampm{$2};
      }
    }
      
    if (defined $hh and $hh <= 12 and $dtstr =~ s# ([ap])\.?m?\.?\s# #o) {
      $merid = $ampm{$1};
    }
  
  
    unless (defined $year) {
      # Date: 12-June-96 (using - . or /)
      
      if ($dtstr =~ s#\s(\d\d?)([\-\./])($monpat)(\2(\d\d+))?\s# #o) {
        ($month,$day) = ($month{$3},$1);
        $year = $5 if $5;
      }
      
      # Date: 12-12-96 (using '-', '.' or '/' )
      
      elsif ($dtstr =~ s#\s(\d+)([\-\./])(\d\d?)(\2(\d+))?\s# #o) {
        ($month,$day) = ($1 - 1,$3);
  
        if ($5) {
  	$year = $5;
  	# Possible match for 1995-01-24 (short mainframe date format);
  	($year,$month,$day) = ($1, $3 - 1, $5) if $month > 12;
  	return if length($year) > 2 and $year < 1901;
        }
      }
      elsif ($dtstr =~ s#\s(\d+)\s*($sufpat)?\s*($monpat)# #o) {
        ($month,$day) = ($month{$3},$1);
      }
      elsif ($dtstr =~ s#($monpat)\s*(\d+)\s*($sufpat)?\s# #o) {
        ($month,$day) = ($month{$1},$2);
      }
      elsif ($dtstr =~ s#($monpat)([\/-])(\d+)[\/-]# #o) {
        ($month,$day) = ($month{$1},$3);
      }
  
      # Date: 961212
  
      elsif ($dtstr =~ s#\s(\d\d)(\d\d)(\d\d)\s# #o) {
        ($year,$month,$day) = ($1,$2-1,$3);
      }
  
      $year = $1 if !defined($year) and $dtstr =~ s#\s(\d{2}(\d{2})?)[\s\.,]# #o;
  
    }
  
    # Zone
  
    $dst = 1 if $dtstr =~ s#\bdst\b##o;
  
    if ($dtstr =~ s#\s"?([a-z]{3,4})(dst|\d+[a-z]*|_[a-z]+)?"?\s# #o) {
      $dst = 1 if $2 and $2 eq 'dst';
      $zone = tz_offset($1);
      return unless defined $zone;
    }
    elsif ($dtstr =~ s#\s([a-z]{3,4})?([\-\+]?)-?(\d\d?):?(\d\d)?(00)?\s# #o) {
      my $m = defined($4) ? "$2$4" : 0;
      my $h = "$2$3";
      $zone = defined($1) ? tz_offset($1) : 0;
      return unless defined $zone;
      $zone += 60 * ($m + (60 * $h));
    }
  
    if ($dtstr =~ /\S/) {
      # now for some dumb dates
      if ($dtstr =~ s/^\s*(ut?|z)\s*$//) {
        $zone = 0;
      }
      elsif ($dtstr =~ s#\s([a-z]{3,4})?([\-\+]?)-?(\d\d?)(\d\d)?(00)?\s# #o) {
        my $m = defined($4) ? "$2$4" : 0;
        my $h = "$2$3";
        $zone = defined($1) ? tz_offset($1) : 0;
        return unless defined $zone;
        $zone += 60 * ($m + (60 * $h));
      }
  
      return if $dtstr =~ /\S/o;
    }
  
    if (defined $hh) {
      if ($hh == 12) {
        $hh = 0 if $merid == $AM;
      }
      elsif ($merid == $PM) {
        $hh += 12;
      }
    }
  
    $year -= 1900 if defined $year && $year > 1900;
  
    $zone += 3600 if defined $zone && $dst;
    $ss += "0.$frac" if $frac;
  
    return ($ss,$mm,$hh,$day,$month,$year,$zone);
  }
  ESQ
  
  use vars qw($day_ref $mon_ref $suf_ref $obj);
  
  sub gen_parser
  {
   local($day_ref,$mon_ref,$suf_ref,$obj) = @_;
  
   if($obj)
    {
     my $obj_strptime = $strptime;
     substr($obj_strptime,index($strptime,"sub")+6,0) = <<'ESQ';
   shift; # package
  ESQ
     my $sub = eval "$obj_strptime" or die $@;
     return $sub;
    }
  
   eval "$strptime" or die $@;
  
  }
  
  *strptime = gen_parser(\%day,\%month,\@suf);
  
  sub str2time
  {
   my @t = strptime(@_);
  
   return undef
  	unless @t;
  
   my($ss,$mm,$hh,$day,$month,$year,$zone) = @t;
   my @lt  = localtime(time);
  
   $hh    ||= 0;
   $mm    ||= 0;
   $ss    ||= 0;
  
   my $frac = $ss - int($ss);
   $ss = int $ss;
  
   $month = $lt[4]
  	unless(defined $month);
  
   $day  = $lt[3]
  	unless(defined $day);
  
   $year = ($month > $lt[4]) ? ($lt[5] - 1) : $lt[5]
  	unless(defined $year);
  
   return undef
  	unless($month <= 11 && $day >= 1 && $day <= 31
  		&& $hh <= 23 && $mm <= 59 && $ss <= 59);
  
   my $result;
  
   if (defined $zone) {
     $result = eval {
       local $SIG{__DIE__} = sub {}; 
       timegm($ss,$mm,$hh,$day,$month,$year);
     };
     return undef
       if !defined $result
          or $result == -1
             && join("",$ss,$mm,$hh,$day,$month,$year)
       	        ne "595923311169";
     $result -= $zone;
   }
   else {
     $result = eval {
       local $SIG{__DIE__} = sub {}; 
       timelocal($ss,$mm,$hh,$day,$month,$year);
     };
     return undef
       if !defined $result
          or $result == -1
             && join("",$ss,$mm,$hh,$day,$month,$year)
       	        ne join("",(localtime(-1))[0..5]);
   }
  
   return $result + $frac;
  }
  
  1;
  
  __END__
  
  
  
DATE_PARSE

$fatpacked{"Exporter/Tiny.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'EXPORTER_TINY';
  package Exporter::Tiny;
  
  use 5.006001;
  use strict;
  use warnings; no warnings qw(void once uninitialized numeric redefine);
  
  our $AUTHORITY = 'cpan:TOBYINK';
  our $VERSION   = '0.042';
  our @EXPORT_OK = qw< mkopt mkopt_hash _croak _carp >;
  
  sub _croak ($;@) { require Carp; my $fmt = shift; @_ = sprintf($fmt, @_); goto \&Carp::croak }
  sub _carp  ($;@) { require Carp; my $fmt = shift; @_ = sprintf($fmt, @_); goto \&Carp::carp }
  
  my $_process_optlist = sub
  {
  	my $class = shift;
  	my ($global_opts, $opts, $want, $not_want) = @_;
  	
  	while (@$opts)
  	{
  		my $opt = shift @{$opts};
  		my ($name, $value) = @$opt;
  		
  		($name =~ m{\A\!(/.+/[msixpodual]+)\z}) ?
  			do {
  				my @not = $class->_exporter_expand_regexp($1, $value, $global_opts);
  				++$not_want->{$_->[0]} for @not;
  			} :
  		($name =~ m{\A\!(.+)\z}) ?
  			(++$not_want->{$1}) :
  		($name =~ m{\A[:-](.+)\z}) ?
  			push(@$opts, $class->_exporter_expand_tag($1, $value, $global_opts)) :
  		($name =~ m{\A/.+/[msixpodual]+\z}) ?
  			push(@$opts, $class->_exporter_expand_regexp($name, $value, $global_opts)) :
  			push(@$want, $opt);
  	}
  };
  
  sub import
  {
  	my $class = shift;
  	my $global_opts = +{ @_ && ref($_[0]) eq q(HASH) ? %{+shift} : () };
  	$global_opts->{into} = caller unless exists $global_opts->{into};
  	
  	my @want;
  	my %not_want; $global_opts->{not} = \%not_want;
  	my @args = do { no strict qw(refs); @_ ? @_ : @{"$class\::EXPORT"} };
  	my $opts = mkopt(\@args);
  	$class->$_process_optlist($global_opts, $opts, \@want, \%not_want);
  	
  	my $permitted = $class->_exporter_permitted_regexp($global_opts);
  	$class->_exporter_validate_opts($global_opts);
  	
  	for my $wanted (@want)
  	{
  		next if $not_want{$wanted->[0]};
  		
  		my %symbols = $class->_exporter_expand_sub(@$wanted, $global_opts, $permitted);
  		$class->_exporter_install_sub($_, $wanted->[1], $global_opts, $symbols{$_})
  			for keys %symbols;
  	}
  }
  
  sub unimport
  {
  	my $class = shift;
  	my $global_opts = +{ @_ && ref($_[0]) eq q(HASH) ? %{+shift} : () };
  	$global_opts->{into} = caller unless exists $global_opts->{into};
  	$global_opts->{is_unimport} = 1;
  	
  	my @want;
  	my %not_want; $global_opts->{not} = \%not_want;
  	my @args = do { our %TRACKED; @_ ? @_ : keys(%{$TRACKED{$class}{$global_opts->{into}}}) };
  	my $opts = mkopt(\@args);
  	$class->$_process_optlist($global_opts, $opts, \@want, \%not_want);
  	
  	my $permitted = $class->_exporter_permitted_regexp($global_opts);
  	$class->_exporter_validate_unimport_opts($global_opts);
  	
  	my $expando = $class->can('_exporter_expand_sub');
  	$expando = undef if $expando == \&_exporter_expand_sub;
  	
  	for my $wanted (@want)
  	{
  		next if $not_want{$wanted->[0]};
  		
  		if ($wanted->[1])
  		{
  			_carp("Passing options to unimport '%s' makes no sense", $wanted->[0])
  				unless (ref($wanted->[1]) eq 'HASH' and not keys %{$wanted->[1]});
  		}
  		
  		my %symbols = defined($expando)
  			? $class->$expando(@$wanted, $global_opts, $permitted)
  			: ($wanted->[0] => sub { "dummy" });
  		$class->_exporter_uninstall_sub($_, $wanted->[1], $global_opts)
  			for keys %symbols;
  	}
  }
  
  sub _exporter_validate_opts          { 1 }
  sub _exporter_validate_unimport_opts { 1 }
  
  sub _exporter_merge_opts
  {
  	my $class = shift;
  	my ($tag_opts, $global_opts, @stuff) = @_;
  	
  	$tag_opts = {} unless ref($tag_opts) eq q(HASH);
  	_croak('Cannot provide an -as option for tags')
  		if exists $tag_opts->{-as};
  	
  	my $optlist = mkopt(\@stuff);
  	for my $export (@$optlist)
  	{
  		next if defined($export->[1]) && ref($export->[1]) ne q(HASH);
  		
  		my %sub_opts = ( %{ $export->[1] or {} }, %$tag_opts );
  		$sub_opts{-prefix} = sprintf('%s%s', $tag_opts->{-prefix}, $export->[1]{-prefix})
  			if exists($export->[1]{-prefix}) && exists($tag_opts->{-prefix});
  		$sub_opts{-suffix} = sprintf('%s%s', $export->[1]{-suffix}, $tag_opts->{-suffix})
  			if exists($export->[1]{-suffix}) && exists($tag_opts->{-suffix});
  		$export->[1] = \%sub_opts;
  	}
  	return @$optlist;
  }
  
  sub _exporter_expand_tag
  {
  	no strict qw(refs);
  	
  	my $class = shift;
  	my ($name, $value, $globals) = @_;
  	my $tags  = \%{"$class\::EXPORT_TAGS"};
  	
  	return $class->_exporter_merge_opts($value, $globals, $tags->{$name}->($class, @_))
  		if ref($tags->{$name}) eq q(CODE);
  	
  	return $class->_exporter_merge_opts($value, $globals, @{$tags->{$name}})
  		if exists $tags->{$name};
  	
  	return $class->_exporter_merge_opts($value, $globals, @{"$class\::EXPORT"}, @{"$class\::EXPORT_OK"})
  		if $name eq 'all';
  	
  	return $class->_exporter_merge_opts($value, $globals, @{"$class\::EXPORT"})
  		if $name eq 'default';
  	
  	$globals->{$name} = $value || 1;
  	return;
  }
  
  sub _exporter_expand_regexp
  {
  	no strict qw(refs);
  	our %TRACKED;
  	
  	my $class = shift;
  	my ($name, $value, $globals) = @_;
  	my $compiled = eval("qr$name");
  	
  	my @possible = $globals->{is_unimport}
  		? keys( %{$TRACKED{$class}{$globals->{into}}} )
  		: @{"$class\::EXPORT_OK"};
  	
  	$class->_exporter_merge_opts($value, $globals, grep /$compiled/, @possible);
  }
  
  sub _exporter_permitted_regexp
  {
  	no strict qw(refs);
  	my $class = shift;
  	my $re = join "|", map quotemeta, sort {
  		length($b) <=> length($a) or $a cmp $b
  	} @{"$class\::EXPORT"}, @{"$class\::EXPORT_OK"};
  	qr{^(?:$re)$}ms;
  }
  
  sub _exporter_expand_sub
  {
  	my $class = shift;
  	my ($name, $value, $globals, $permitted) = @_;
  	$permitted ||= $class->_exporter_permitted_regexp($globals);
  	
  	no strict qw(refs);
  	
  	if ($name =~ $permitted)
  	{
  		my $generator = $class->can("_generate_$name");
  		return $name => $class->$generator($name, $value, $globals) if $generator;
  		
  		my $sub = $class->can($name);
  		return $name => $sub if $sub;
  	}
  	
  	$class->_exporter_fail(@_);
  }
  
  sub _exporter_fail
  {
  	my $class = shift;
  	my ($name, $value, $globals) = @_;
  	return if $globals->{is_unimport};
  	_croak("Could not find sub '%s' exported by %s", $name, $class);
  }
  
  sub _exporter_install_sub
  {
  	my $class = shift;
  	my ($name, $value, $globals, $sym) = @_;
  	
  	my $into      = $globals->{into};
  	my $installer = $globals->{installer} || $globals->{exporter};
  	
  	$name = $value->{-as} || $name;
  	unless (ref($name) eq q(SCALAR))
  	{
  		my ($prefix) = grep defined, $value->{-prefix}, $globals->{prefix}, q();
  		my ($suffix) = grep defined, $value->{-suffix}, $globals->{suffix}, q();
  		$name = "$prefix$name$suffix";
  	}
  	
  	return ($$name = $sym)                       if ref($name) eq q(SCALAR);
  	return ($into->{$name} = $sym)               if ref($into) eq q(HASH);
  	
  	no strict qw(refs);
  	
  	if (exists &{"$into\::$name"} and \&{"$into\::$name"} != $sym)
  	{
  		my ($level) = grep defined, $value->{-replace}, $globals->{replace}, q(0);
  		my $action = {
  			carp     => \&_carp,
  			0        => \&_carp,
  			''       => \&_carp,
  			warn     => \&_carp,
  			nonfatal => \&_carp,
  			croak    => \&_croak,
  			fatal    => \&_croak,
  			die      => \&_croak,
  		}->{$level} || sub {};
  		
  		$action->(
  			$action == \&_croak
  				? "Refusing to overwrite existing sub '%s::%s' with sub '%s' exported by %s"
  				: "Overwriting existing sub '%s::%s' with sub '%s' exported by %s",
  			$into,
  			$name,
  			$_[0],
  			$class,
  		);
  	}
  	
  	our %TRACKED;
  	$TRACKED{$class}{$into}{$name} = $sym;
  	
  	no warnings qw(prototype);
  	$installer
  		? $installer->($globals, [$name, $sym])
  		: (*{"$into\::$name"} = $sym);
  }
  
  sub _exporter_uninstall_sub
  {
  	our %TRACKED;
  	my $class = shift;
  	my ($name, $value, $globals, $sym) = @_;
  	my $into = $globals->{into};
  	ref $into and return;
  	
  	no strict qw(refs);
  	
  	my $our_coderef = $TRACKED{$class}{$into}{$name};
  	my $cur_coderef = exists(&{"$into\::$name"}) ? \&{"$into\::$name"} : -1;
  	return unless $our_coderef == $cur_coderef;
  	
  	my $stash     = \%{"$into\::"};
  	my $old       = delete $stash->{$name};
  	my $full_name = join('::', $into, $name);
  	foreach my $type (qw(SCALAR HASH ARRAY IO)) 
  	{
  		next unless defined(*{$old}{$type});
  		*$full_name = *{$old}{$type};
  	}
  	
  	delete $TRACKED{$class}{$into}{$name};
  }
  
  sub mkopt
  {
  	my $in = shift or return [];
  	my @out;
  	
  	$in = [map(($_ => ref($in->{$_}) ? $in->{$_} : ()), sort keys %$in)]
  		if ref($in) eq q(HASH);
  	
  	for (my $i = 0; $i < @$in; $i++)
  	{
  		my $k = $in->[$i];
  		my $v;
  		
  		($i == $#$in)         ? ($v = undef) :
  		!defined($in->[$i+1]) ? (++$i, ($v = undef)) :
  		!ref($in->[$i+1])     ? ($v = undef) :
  		($v = $in->[++$i]);
  		
  		push @out, [ $k => $v ];
  	}
  	
  	\@out;
  }
  
  sub mkopt_hash
  {
  	my $in  = shift or return;
  	my %out = map +($_->[0] => $_->[1]), @{ mkopt($in) };
  	\%out;
  }
  
  1;
  
  __END__
  
EXPORTER_TINY

$fatpacked{"Function/Fallback/CoreOrPP.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'FUNCTION_FALLBACK_COREORPP';
  package Function::Fallback::CoreOrPP;
  
  use 5.010001;
  use strict;
  use warnings;
  
  our $VERSION = '0.06'; 
  
  our $USE_NONCORE_XS_FIRST = 1;
  
  require Exporter;
  our @ISA       = qw(Exporter);
  our @EXPORT_OK = qw(
                         clone
                         unbless
                         uniq
                 );
  
  sub clone {
      my $data = shift;
      goto FALLBACK unless $USE_NONCORE_XS_FIRST;
      goto FALLBACK unless eval { require Data::Clone; 1 };
  
    STANDARD:
      return Data::Clone::clone($data);
  
    FALLBACK:
      require Clone::PP;
      return Clone::PP::clone($data);
  }
  
  sub _unbless_fallback {
      my $ref = shift;
  
      my $r = ref($ref);
      return $ref unless $r;
  
      my ($r2, $r3) = "$ref" =~ /(.+)=(.+?)\(/
          or return $ref;
  
      if ($r3 eq 'HASH') {
          return { %$ref };
      } elsif ($r3 eq 'ARRAY') {
          return [ @$ref ];
      } elsif ($r3 eq 'SCALAR') {
          return \( my $copy = ${$ref} );
      } else {
          die "Can't handle $ref";
      }
  }
  
  sub unbless {
      my $ref = shift;
  
      goto FALLBACK unless $USE_NONCORE_XS_FIRST;
      goto FALLBACK unless eval { require Acme::Damn; 1 };
  
    STANDARD:
      return Acme::Damn::damn($ref);
  
    FALLBACK:
      return _unbless_fallback($ref);
  }
  
  sub uniq {
      goto FALLBACK unless $USE_NONCORE_XS_FIRST;
      goto FALLBACK unless eval { require List::MoreUtils; 1 };
  
    STANDARD:
      return List::MoreUtils::uniq(@_);
  
    FALLBACK:
      my %h;
      my @res;
      for (@_) {
          push @res, $_ unless $h{$_}++;
      }
      return @res;
  }
  
  1;
  
  __END__
  
FUNCTION_FALLBACK_COREORPP

$fatpacked{"Getopt/Long/Negate/EN.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'GETOPT_LONG_NEGATE_EN';
  package Getopt::Long::Negate::EN;
  
  our $DATE = '2015-03-19'; 
  our $VERSION = '0.01'; 
  
  use 5.010001;
  use strict;
  use warnings;
  
  use Exporter qw(import);
  our @EXPORT_OK = qw(negations_for_option);
  
  sub negations_for_option {
      my $word = shift;
      if    ($word =~ /\Awith([_-].+)/   ) { return ("without$1") }
      elsif ($word =~ /\Awithout([_-].+)/) { return ("with$1")    }
      elsif ($word =~ /\Ais([_-].+)/     ) { return ("isnt$1")    }
      elsif ($word =~ /\Aisnt([_-].+)/   ) { return ("is$1")      }
      elsif ($word =~ /\Aare([_-].+)/    ) { return ("arent$1")   }
      elsif ($word =~ /\Aarent([_-].+)/  ) { return ("are$1")     }
      elsif ($word =~ /\Ano[_-](.+)/     ) { return ($1)          }
      else {
          return ("no-$word", "no$word");
      }
  }
  
  1;
  
  __END__
  
GETOPT_LONG_NEGATE_EN

$fatpacked{"Getopt/Long/Util.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'GETOPT_LONG_UTIL';
  package Getopt::Long::Util;
  
  our $DATE = '2015-03-24'; 
  our $VERSION = '0.81'; 
  
  use 5.010001;
  use strict;
  use warnings;
  
  use List::Util qw(first);
  
  require Exporter;
  our @ISA       = qw(Exporter);
  our @EXPORT_OK = qw(
                         parse_getopt_long_opt_spec
                         humanize_getopt_long_opt_spec
                         detect_getopt_long_script
                 );
  
  our %SPEC;
  
  $SPEC{parse_getopt_long_opt_spec} = {
      v => 1.1,
      summary => 'Parse a single Getopt::Long option specification',
      description => <<'_',
  
  Will produce a hash with some keys: `opts` (array of option names, in the order
  specified in the opt spec), `type` (string, type name), `desttype` (either '',
  or '@' or '%'), `is_neg` (true for `--opt!`), `is_inc` (true for `--opt+`),
  `min_vals` (int, usually 0 or 1), `max_vals` (int, usually 0 or 1 except for
  option that requires multiple values),
  
  Will return undef if it can't parse the string.
  
  _
      args => {
          optspec => {
              schema => 'str*',
              req => 1,
              pos => 0,
          },
      },
      args_as => 'array',
      result_naked => 1,
      result => {
          schema => 'hash*',
      },
      examples => [
          {
              args => {optspec => 'help|h|?'},
              result => {dash_prefix=>'', opts=>['help', 'h', '?']},
          },
          {
              args => {optspec=>'--foo=s'},
              result => {dash_prefix=>'--', opts=>['foo'], type=>'s', desttype=>''},
          },
      ],
  };
  sub parse_getopt_long_opt_spec {
      my $optspec = shift;
      $optspec =~ qr/\A
                 (?P<dash_prefix>-{0,2})
                 (?P<name>[A-Za-z0-9_][A-Za-z0-9_-]*)
                 (?P<aliases> (?: \| (?:[^:|!+=:-][^:|!+=:]*) )*)?
                 (?:
                     (?P<is_neg>!) |
                     (?P<is_inc>\+) |
                     (?:
                         =
                         (?P<type>[siof])
                         (?P<desttype>|[%@])?
                         (?:
                             \{
                             (?: (?P<min_vals>\d+), )?
                             (?P<max_vals>\d+)
                             \}
                         )?
                     ) |
                     (?:
                         :
                         (?P<opttype>[siof])
                         (?P<desttype>|[%@])
                     ) |
                     (?:
                         :
                         (?P<optnum>\d+)
                         (?P<desttype>|[%@])
                     )
                     (?:
                         :
                         (?P<optplus>\+)
                         (?P<desttype>|[%@])
                     )
                 )?
                 \z/x
                     or return undef;
      my %res = %+;
  
      if ($res{aliases}) {
          my @als;
          for my $al (split /\|/, $res{aliases}) {
              next unless length $al;
              next if $al eq $res{name};
              next if first {$_ eq $al} @als;
              push @als, $al;
          }
          $res{opts} = [$res{name}, @als];
      } else {
          $res{opts} = [$res{name}];
      }
      delete $res{name};
      delete $res{aliases};
  
      $res{is_neg} = 1 if $res{is_neg};
      $res{is_inc} = 1 if $res{is_inc};
  
      \%res;
  }
  
  $SPEC{humanize_getopt_long_opt_spec} = {
      v => 1.1,
      description => <<'_',
  
  Convert `Getopt::Long` option specification like `help|h|?` or `--foo=s` or
  `debug!` into, respectively, `--help, -h, -?` or `--foo=s` or `--(no)debug`.
  Will die if can't parse the string. The output is suitable for including in
  help/usage text.
  
  _
      args => {
          optspec => {
              schema => 'str*',
              req => 1,
              pos => 0,
          },
      },
      args_as => 'array',
      result_naked => 1,
      result => {
          schema => 'str*',
      },
  };
  sub humanize_getopt_long_opt_spec {
      my $optspec = shift;
  
      my $parse = parse_getopt_long_opt_spec($optspec)
          or die "Can't parse opt spec $optspec";
  
      my $res = '';
      my $i = 0;
      for (@{ $parse->{opts} }) {
          $i++;
          $res .= ", " if length($res);
          if ($parse->{is_neg} && length($_) > 1) {
              $res .= "--(no)$_";
          } else {
              if (length($_) > 1) {
                  $res .= "--$_";
              } else {
                  $res .= "-$_";
              }
              $res .= "=$parse->{type}" if $i==1 && $parse->{type};
          }
      }
      $res;
  }
  
  $SPEC{detect_getopt_long_script} = {
      v => 1.1,
      summary => 'Detect whether a file is a Getopt::Long-based CLI script',
      description => <<'_',
  
  The criteria are:
  
  * the file must exist and readable;
  
  * (optional, if `include_noexec` is false) file must have its executable mode
    bit set;
  
  * content must start with a shebang C<#!>;
  
  * either: must be perl script (shebang line contains 'perl') and must contain
    something like `use Getopt::Long`;
  
  _
      args => {
          filename => {
              summary => 'Path to file to be checked',
              schema => 'str*',
              description => <<'_',
  
  Either `filename` or `string` must be specified.
  
  _
          },
          string => {
              summary => 'Path to file to be checked',
              schema => 'buf*',
              description => <<'_',
  
  Either `file` or `string` must be specified.
  
  _
          },
          include_noexec => {
              summary => 'Include scripts that do not have +x mode bit set',
              schema  => 'bool*',
              default => 1,
          },
      },
  };
  sub detect_getopt_long_script {
      my %args = @_;
  
      (defined($args{filename}) xor defined($args{string}))
          or return [400, "Please specify either filename or string"];
      my $include_noexec  = $args{include_noexec}  // 1;
  
      my $yesno = 0;
      my $reason = "";
  
      my $str = $args{string};
    DETECT:
      {
          if (defined $args{filename}) {
              my $fn = $args{filename};
              unless (-f $fn) {
                  $reason = "'$fn' is not a file";
                  last;
              };
              if (!$include_noexec && !(-x _)) {
                  $reason = "'$fn' is not an executable";
                  last;
              }
              my $fh;
              unless (open $fh, "<", $fn) {
                  $reason = "Can't be read";
                  last;
              }
              read $fh, $str, 2;
              unless ($str eq '#!') {
                  $reason = "Does not start with a shebang (#!) sequence";
                  last;
              }
              my $shebang = <$fh>;
              unless ($shebang =~ /perl/) {
                  $reason = "Does not have 'perl' in the shebang line";
                  last;
              }
              seek $fh, 0, 0;
              {
                  local $/;
                  $str = <$fh>;
              }
          }
          unless ($str =~ /\A#!/) {
              $reason = "Does not start with a shebang (#!) sequence";
              last;
          }
          unless ($str =~ /\A#!.*perl/) {
              $reason = "Does not have 'perl' in the shebang line";
              last;
          }
          if ($str =~ /^\s*(use|require)\s+Getopt::Long(\s|;)/m) {
              $yesno = 1;
              last DETECT;
          }
          $reason = "Can't find any statement requiring Getopt::Long module";
      } 
  
      [200, "OK", $yesno, {"func.reason"=>$reason}];
  }
  
  
  __END__
  
GETOPT_LONG_UTIL

$fatpacked{"IO/Socket/IP.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'IO_SOCKET_IP';
  
  package IO::Socket::IP;
  BEGIN {
     $VERSION = '0.37';
  }
  
  use strict;
  use warnings;
  use base qw( IO::Socket );
  
  use Carp;
  
  use Socket 1.97 qw(
     getaddrinfo getnameinfo
     sockaddr_family
     AF_INET
     AI_PASSIVE
     IPPROTO_TCP IPPROTO_UDP
     IPPROTO_IPV6 IPV6_V6ONLY
     NI_DGRAM NI_NUMERICHOST NI_NUMERICSERV NIx_NOHOST NIx_NOSERV
     SO_REUSEADDR SO_REUSEPORT SO_BROADCAST SO_ERROR
     SOCK_DGRAM SOCK_STREAM
     SOL_SOCKET
  );
  my $AF_INET6 = eval { Socket::AF_INET6() }; 
  my $AI_ADDRCONFIG = eval { Socket::AI_ADDRCONFIG() } || 0;
  use POSIX qw( dup2 );
  use Errno qw( EINVAL EINPROGRESS EISCONN ENOTCONN ETIMEDOUT EWOULDBLOCK );
  
  use constant HAVE_MSWIN32 => ( $^O eq "MSWin32" );
  
  use constant HAVE_GETPROTOBYNAME => defined eval { getprotobyname( "tcp" ) };
  
  my $IPv6_re = do {
     my $IPv4address = do {
        my $dec_octet = q<(?:[0-9]|[1-9][0-9]|1[0-9][0-9]|2[0-4][0-9]|25[0-5])>;
        qq<$dec_octet(?: \\. $dec_octet){3}>;
     };
     my $IPv6address = do {
        my $h16  = qq<[0-9A-Fa-f]{1,4}>;
        my $ls32 = qq<(?: $h16 : $h16 | $IPv4address)>;
        qq<(?:
                                              (?: $h16 : ){6} $ls32
           |                               :: (?: $h16 : ){5} $ls32
           | (?:                   $h16 )? :: (?: $h16 : ){4} $ls32
           | (?: (?: $h16 : ){0,1} $h16 )? :: (?: $h16 : ){3} $ls32
           | (?: (?: $h16 : ){0,2} $h16 )? :: (?: $h16 : ){2} $ls32
           | (?: (?: $h16 : ){0,3} $h16 )? ::     $h16 :      $ls32
           | (?: (?: $h16 : ){0,4} $h16 )? ::                 $ls32
           | (?: (?: $h16 : ){0,5} $h16 )? ::                 $h16
           | (?: (?: $h16 : ){0,6} $h16 )? ::
        )>
     };
     qr<$IPv6address>xo;
  };
  
  
  sub import
  {
     my $pkg = shift;
     my @symbols;
  
     foreach ( @_ ) {
        if( $_ eq "-register" ) {
           IO::Socket::IP::_ForINET->register_domain( AF_INET );
           IO::Socket::IP::_ForINET6->register_domain( $AF_INET6 ) if defined $AF_INET6;
        }
        else {
           push @symbols, $_;
        }
     }
  
     @_ = ( $pkg, @symbols );
     goto &IO::Socket::import;
  }
  
  {
     my $can_disable_v6only;
     sub CAN_DISABLE_V6ONLY
     {
        return $can_disable_v6only if defined $can_disable_v6only;
  
        socket my $testsock, Socket::PF_INET6(), SOCK_STREAM, 0 or
           die "Cannot socket(PF_INET6) - $!";
  
        if( setsockopt $testsock, IPPROTO_IPV6, IPV6_V6ONLY, 0 ) {
           return $can_disable_v6only = 1;
        }
        elsif( $! == EINVAL ) {
           return $can_disable_v6only = 0;
        }
        else {
           die "Cannot setsockopt() - $!";
        }
     }
  }
  
  
  
  sub new
  {
     my $class = shift;
     my %arg = (@_ == 1) ? (PeerHost => $_[0]) : @_;
     return $class->SUPER::new(%arg);
  }
  
  sub configure
  {
     my $self = shift;
     my ( $arg ) = @_;
  
     $arg->{PeerHost} = delete $arg->{PeerAddr}
        if exists $arg->{PeerAddr} && !exists $arg->{PeerHost};
  
     $arg->{PeerService} = delete $arg->{PeerPort}
        if exists $arg->{PeerPort} && !exists $arg->{PeerService};
  
     $arg->{LocalHost} = delete $arg->{LocalAddr}
        if exists $arg->{LocalAddr} && !exists $arg->{LocalHost};
  
     $arg->{LocalService} = delete $arg->{LocalPort}
        if exists $arg->{LocalPort} && !exists $arg->{LocalService};
  
     for my $type (qw(Peer Local)) {
        my $host    = $type . 'Host';
        my $service = $type . 'Service';
  
        if( defined $arg->{$host} ) {
           ( $arg->{$host}, my $s ) = $self->split_addr( $arg->{$host} );
           $arg->{$service} = $s if defined $s;
        }
     }
  
     $self->_io_socket_ip__configure( $arg );
  }
  
  sub _io_socket_ip__configure
  {
     my $self = shift;
     my ( $arg ) = @_;
  
     my %hints;
     my @localinfos;
     my @peerinfos;
  
     my $listenqueue = $arg->{Listen};
     if( defined $listenqueue and
         ( defined $arg->{PeerHost} || defined $arg->{PeerService} || defined $arg->{PeerAddrInfo} ) ) {
        croak "Cannot Listen with a peer address";
     }
  
     if( defined $arg->{GetAddrInfoFlags} ) {
        $hints{flags} = $arg->{GetAddrInfoFlags};
     }
     else {
        $hints{flags} = $AI_ADDRCONFIG;
     }
  
     if( defined( my $family = $arg->{Family} ) ) {
        $hints{family} = $family;
     }
  
     if( defined( my $type = $arg->{Type} ) ) {
        $hints{socktype} = $type;
     }
  
     if( defined( my $proto = $arg->{Proto} ) ) {
        unless( $proto =~ m/^\d+$/ ) {
           my $protonum = HAVE_GETPROTOBYNAME
              ? getprotobyname( $proto )
              : eval { Socket->${\"IPPROTO_\U$proto"}() };
           defined $protonum or croak "Unrecognised protocol $proto";
           $proto = $protonum;
        }
  
        $hints{protocol} = $proto;
     }
  
     if( !defined $hints{socktype} and !defined $hints{protocol} ) {
        $hints{socktype} = SOCK_STREAM;
        $hints{protocol} = IPPROTO_TCP;
     }
  
     if( !defined $hints{socktype} and defined $hints{protocol} ) {
        $hints{socktype} = SOCK_STREAM if $hints{protocol} == IPPROTO_TCP;
        $hints{socktype} = SOCK_DGRAM  if $hints{protocol} == IPPROTO_UDP;
     }
  
     if( my $info = $arg->{LocalAddrInfo} ) {
        ref $info eq "ARRAY" or croak "Expected 'LocalAddrInfo' to be an ARRAY ref";
        @localinfos = @$info;
     }
     elsif( defined $arg->{LocalHost} or
            defined $arg->{LocalService} or
            HAVE_MSWIN32 and $arg->{Listen} ) {
        my $host = $arg->{LocalHost};
        my $service = $arg->{LocalService};
  
        unless ( defined $host or defined $service ) {
           $service = 0;
        }
  
        local $1; 
        defined $service and $service =~ s/\((\d+)\)$// and
           my $fallback_port = $1;
  
        my %localhints = %hints;
        $localhints{flags} |= AI_PASSIVE;
        ( my $err, @localinfos ) = getaddrinfo( $host, $service, \%localhints );
  
        if( $err and defined $fallback_port ) {
           ( $err, @localinfos ) = getaddrinfo( $host, $fallback_port, \%localhints );
        }
  
        if( $err ) {
           $@ = "$err";
           $! = EINVAL;
           return;
        }
     }
  
     if( my $info = $arg->{PeerAddrInfo} ) {
        ref $info eq "ARRAY" or croak "Expected 'PeerAddrInfo' to be an ARRAY ref";
        @peerinfos = @$info;
     }
     elsif( defined $arg->{PeerHost} or defined $arg->{PeerService} ) {
        defined( my $host = $arg->{PeerHost} ) or
           croak "Expected 'PeerHost'";
        defined( my $service = $arg->{PeerService} ) or
           croak "Expected 'PeerService'";
  
        local $1; 
        defined $service and $service =~ s/\((\d+)\)$// and
           my $fallback_port = $1;
  
        ( my $err, @peerinfos ) = getaddrinfo( $host, $service, \%hints );
  
        if( $err and defined $fallback_port ) {
           ( $err, @peerinfos ) = getaddrinfo( $host, $fallback_port, \%hints );
        }
  
        if( $err ) {
           $@ = "$err";
           $! = EINVAL;
           return;
        }
     }
  
     my @sockopts_enabled;
     push @sockopts_enabled, SO_REUSEADDR if $arg->{ReuseAddr};
     push @sockopts_enabled, SO_REUSEPORT if $arg->{ReusePort};
     push @sockopts_enabled, SO_BROADCAST if $arg->{Broadcast};
  
     my $blocking = $arg->{Blocking};
     defined $blocking or $blocking = 1;
  
     my $v6only = $arg->{V6Only};
  
     if( defined $arg->{MultiHomed} and !$arg->{MultiHomed} ) {
        croak "Cannot disable the MultiHomed parameter";
     }
  
     my @infos;
     foreach my $local ( @localinfos ? @localinfos : {} ) {
        foreach my $peer ( @peerinfos ? @peerinfos : {} ) {
           next if defined $local->{family}   and defined $peer->{family}   and
              $local->{family} != $peer->{family};
           next if defined $local->{socktype} and defined $peer->{socktype} and
              $local->{socktype} != $peer->{socktype};
           next if defined $local->{protocol} and defined $peer->{protocol} and
              $local->{protocol} != $peer->{protocol};
  
           my $family   = $local->{family}   || $peer->{family}   or next;
           my $socktype = $local->{socktype} || $peer->{socktype} or next;
           my $protocol = $local->{protocol} || $peer->{protocol} || 0;
  
           push @infos, {
              family    => $family,
              socktype  => $socktype,
              protocol  => $protocol,
              localaddr => $local->{addr},
              peeraddr  => $peer->{addr},
           };
        }
     }
  
     if( !@infos ) {
        if( defined $hints{family} ) {
           @infos = ( {
              family   => $hints{family},
              socktype => $hints{socktype},
              protocol => $hints{protocol},
           } );
        }
        else {
           ( my $err, @infos ) = getaddrinfo( "", "0", \%hints );
           if( $err ) {
              $@ = "$err";
              $! = EINVAL;
              return;
           }
  
        }
     }
  
  
     ${*$self}{io_socket_ip_infos} = \@infos;
  
     ${*$self}{io_socket_ip_idx} = -1;
  
     ${*$self}{io_socket_ip_sockopts} = \@sockopts_enabled;
     ${*$self}{io_socket_ip_v6only} = $v6only;
     ${*$self}{io_socket_ip_listenqueue} = $listenqueue;
     ${*$self}{io_socket_ip_blocking} = $blocking;
  
     ${*$self}{io_socket_ip_errors} = [ undef, undef, undef ];
  
     $self->setup or !$blocking or return undef;
  
     return $self;
  }
  
  sub setup
  {
     my $self = shift;
  
     while(1) {
        ${*$self}{io_socket_ip_idx}++;
        last if ${*$self}{io_socket_ip_idx} >= @{ ${*$self}{io_socket_ip_infos} };
  
        my $info = ${*$self}{io_socket_ip_infos}->[${*$self}{io_socket_ip_idx}];
  
        $self->socket( @{$info}{qw( family socktype protocol )} ) or
           ( ${*$self}{io_socket_ip_errors}[2] = $!, next );
  
        $self->blocking( 0 ) unless ${*$self}{io_socket_ip_blocking};
  
        foreach my $sockopt ( @{ ${*$self}{io_socket_ip_sockopts} } ) {
           $self->setsockopt( SOL_SOCKET, $sockopt, pack "i", 1 ) or ( $@ = "$!", return undef );
        }
  
        if( defined ${*$self}{io_socket_ip_v6only} and defined $AF_INET6 and $info->{family} == $AF_INET6 ) {
           my $v6only = ${*$self}{io_socket_ip_v6only};
           $self->setsockopt( IPPROTO_IPV6, IPV6_V6ONLY, pack "i", $v6only ) or ( $@ = "$!", return undef );
        }
  
        if( defined( my $addr = $info->{localaddr} ) ) {
           $self->bind( $addr ) or
              ( ${*$self}{io_socket_ip_errors}[1] = $!, next );
        }
  
        if( defined( my $listenqueue = ${*$self}{io_socket_ip_listenqueue} ) ) {
           $self->listen( $listenqueue ) or ( $@ = "$!", return undef );
        }
  
        if( defined( my $addr = $info->{peeraddr} ) ) {
           if( $self->connect( $addr ) ) {
              $! = 0;
              return 1;
           }
  
           if( $! == EINPROGRESS or $! == EWOULDBLOCK ) {
              ${*$self}{io_socket_ip_connect_in_progress} = 1;
              return 0;
           }
  
           return 0 if ! $!;
  
           ${*$self}{io_socket_ip_errors}[0] = $!;
           next;
        }
  
        return 1;
     }
  
     $! = ( grep defined, @{ ${*$self}{io_socket_ip_errors}} )[0];
     $@ = "$!";
     return undef;
  }
  
  sub connect :method
  {
     my $self = shift;
  
  
     if( @_ ) {
        my ( $addr ) = @_;
  
        my $timeout = ${*$self}{'io_socket_timeout'};
  
        return connect( $self, $addr ) unless defined $timeout;
  
        my $was_blocking = $self->blocking( 0 );
  
        my $err = defined connect( $self, $addr ) ? 0 : $!+0;
  
        if( !$err ) {
           $self->blocking( $was_blocking );
           return 1;
        }
        elsif( not( $err == EINPROGRESS or $err == EWOULDBLOCK ) ) {
           return undef;
        }
        elsif( !$was_blocking ) {
           return undef;
        }
  
        my $vec = ''; vec( $vec, $self->fileno, 1 ) = 1;
        if( !select( undef, $vec, $vec, $timeout ) ) {
           $! = ETIMEDOUT;
           return undef;
        }
  
        $err = $self->getsockopt( SOL_SOCKET, SO_ERROR );
        $err = 0 if $err == EISCONN; 
  
        $self->blocking( $was_blocking );
  
        $! = $err, return undef if $err;
        return 1;
     }
  
     return 1 if !${*$self}{io_socket_ip_connect_in_progress};
  
     if( my $errno = $self->getsockopt( SOL_SOCKET, SO_ERROR ) ) {
        delete ${*$self}{io_socket_ip_connect_in_progress};
        ${*$self}{io_socket_ip_errors}[0] = $! = $errno;
        return $self->setup;
     }
  
     my $addr = ${*$self}{io_socket_ip_infos}[${*$self}{io_socket_ip_idx}]{peeraddr};
  
     if( connect( $self, $addr ) or $! == EISCONN ) {
        delete ${*$self}{io_socket_ip_connect_in_progress};
        $! = 0;
        return 1;
     }
     else {
        $! = EINPROGRESS;
        return 0;
     }
  }
  
  sub connected
  {
     my $self = shift;
     return defined $self->fileno &&
            !${*$self}{io_socket_ip_connect_in_progress} &&
            defined getpeername( $self ); 
  }
  
  
  sub _get_host_service
  {
     my $self = shift;
     my ( $addr, $flags, $xflags ) = @_;
  
     defined $addr or
        $! = ENOTCONN, return;
  
     $flags |= NI_DGRAM if $self->socktype == SOCK_DGRAM;
  
     my ( $err, $host, $service ) = getnameinfo( $addr, $flags, $xflags || 0 );
     croak "getnameinfo - $err" if $err;
  
     return ( $host, $service );
  }
  
  sub _unpack_sockaddr
  {
     my ( $addr ) = @_;
     my $family = sockaddr_family $addr;
  
     if( $family == AF_INET ) {
        return ( Socket::unpack_sockaddr_in( $addr ) )[1];
     }
     elsif( defined $AF_INET6 and $family == $AF_INET6 ) {
        return ( Socket::unpack_sockaddr_in6( $addr ) )[1];
     }
     else {
        croak "Unrecognised address family $family";
     }
  }
  
  
  sub sockhost_service
  {
     my $self = shift;
     my ( $numeric ) = @_;
  
     $self->_get_host_service( $self->sockname, $numeric ? NI_NUMERICHOST|NI_NUMERICSERV : 0 );
  }
  
  
  sub sockhost { my $self = shift; scalar +( $self->_get_host_service( $self->sockname, NI_NUMERICHOST, NIx_NOSERV ) )[0] }
  sub sockport { my $self = shift; scalar +( $self->_get_host_service( $self->sockname, NI_NUMERICSERV, NIx_NOHOST ) )[1] }
  
  sub sockhostname { my $self = shift; scalar +( $self->_get_host_service( $self->sockname, 0, NIx_NOSERV ) )[0] }
  sub sockservice  { my $self = shift; scalar +( $self->_get_host_service( $self->sockname, 0, NIx_NOHOST ) )[1] }
  
  
  sub sockaddr { my $self = shift; _unpack_sockaddr $self->sockname }
  
  
  sub peerhost_service
  {
     my $self = shift;
     my ( $numeric ) = @_;
  
     $self->_get_host_service( $self->peername, $numeric ? NI_NUMERICHOST|NI_NUMERICSERV : 0 );
  }
  
  
  sub peerhost { my $self = shift; scalar +( $self->_get_host_service( $self->peername, NI_NUMERICHOST, NIx_NOSERV ) )[0] }
  sub peerport { my $self = shift; scalar +( $self->_get_host_service( $self->peername, NI_NUMERICSERV, NIx_NOHOST ) )[1] }
  
  sub peerhostname { my $self = shift; scalar +( $self->_get_host_service( $self->peername, 0, NIx_NOSERV ) )[0] }
  sub peerservice  { my $self = shift; scalar +( $self->_get_host_service( $self->peername, 0, NIx_NOHOST ) )[1] }
  
  
  sub peeraddr { my $self = shift; _unpack_sockaddr $self->peername }
  
  sub accept
  {
     my $self = shift;
     my ( $new, $peer ) = $self->SUPER::accept( @_ ) or return;
  
     ${*$new}{$_} = ${*$self}{$_} for qw( io_socket_domain io_socket_type io_socket_proto );
  
     return wantarray ? ( $new, $peer )
                      : $new;
  }
  
  sub socket :method
  {
     my $self = shift;
     return $self->SUPER::socket(@_) if not defined $self->fileno;
  
     socket( my $tmph, $_[0], $_[1], $_[2] ) or return undef;
  
     dup2( $tmph->fileno, $self->fileno ) or die "Unable to dup2 $tmph onto $self - $!";
  }
  
  BEGIN {
     if( eval($IO::Socket::VERSION) < 1.35 ) {
        *socktype = sub {
           my $self = shift;
           my $type = $self->SUPER::socktype;
           if( !defined $type ) {
              $type = $self->sockopt( Socket::SO_TYPE() );
           }
           return $type;
        };
     }
  }
  
  
  sub as_inet
  {
     my $self = shift;
     croak "Cannot downgrade a non-PF_INET socket to IO::Socket::INET" unless $self->sockdomain == AF_INET;
     return IO::Socket::INET->new_from_fd( $self->fileno, "r+" );
  }
  
  
  
  sub split_addr
  {
     shift;
     my ( $addr ) = @_;
  
     local ( $1, $2 ); 
     if( $addr =~ m/\A\[($IPv6_re)\](?::([^\s:]*))?\z/ or
         $addr =~ m/\A([^\s:]*):([^\s:]*)\z/ ) {
        return ( $1, $2 ) if defined $2 and length $2;
        return ( $1, undef );
     }
  
     return ( $addr, undef );
  }
  
  
  sub join_addr
  {
     shift;
     my ( $host, $port ) = @_;
  
     $host = "[$host]" if $host =~ m/:/;
  
     return join ":", $host, $port if defined $port;
     return $host;
  }
  
  
  package 
     IO::Socket::IP::_ForINET;
  use base qw( IO::Socket::IP );
  
  sub configure
  {
     my $self = shift;
     my ( $arg ) = @_;
  
     bless $self, "IO::Socket::IP";
     $self->configure( { %$arg, Family => Socket::AF_INET() } );
  }
  
  package 
     IO::Socket::IP::_ForINET6;
  use base qw( IO::Socket::IP );
  
  sub configure
  {
     my $self = shift;
     my ( $arg ) = @_;
  
     bless $self, "IO::Socket::IP";
     $self->configure( { %$arg, Family => Socket::AF_INET6() } );
  }
  
  
  
  0x55AA;
IO_SOCKET_IP

$fatpacked{"Lingua/EN/PluralToSingular.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'LINGUA_EN_PLURALTOSINGULAR';
  package Lingua::EN::PluralToSingular;
  require Exporter;
  @ISA = qw(Exporter);
  @EXPORT_OK = qw/to_singular is_plural/;
  use warnings;
  use strict;
  our $VERSION = '0.14';
  
  
  
  
  my %irregular = (qw/
      analyses analysis
      children child
      corpora corpus
      craftsmen craftsman
      crises crisis
      criteria criterion
      curricula curriculum
      feet foot
      fungi fungus
      geese goose
      genera genus
      indices index
      lice louse
      matrices matrix
      memoranda memorandum
      men man
      mice mouse
      monies money
      neuroses neurosis
      nuclei nucleus
      oases oasis
      pence penny
      people person
      phenomena phenomenon
      quanta quantum
      strata stratum
      teeth tooth
      testes testis
      these this
      theses thesis
      those that
      women woman
  /);
  
  
  
  my %ves = (qw/
      calves calf
      dwarves dwarf
      elves elf
      halves half
      knives knife
      leaves leaf
      lives life
      loaves loaf
      scarves scarf
      sheaves sheaf
      shelves shelf
      wharves wharf 
      wives wife
      wolves wolf
  /);
  
  
  my %plural = (
      'menus' => 'menu',
      'buses' => 'bus',
      %ves,
      %irregular,
  );
  
  
  my @no_change = qw/
                        clothes
                        deer
                        ides
                        fish
                        means
                        offspring
                        series
                        sheep
                        species
                    /;
  
  @plural{@no_change} = @no_change;
  
  
  
  
  my @not_plural = (qw/
      Charles
      Texas
  Hades 
  Hercules 
  Hermes 
  Gonzales 
  Holmes 
  Hughes 
  Ives 
  Jacques 
  James 
  Keyes 
  Mercedes 
  Naples 
  Oates 
  Raines 
  
      dias
      iris
      molasses
      this
      yes
      chaos
      lens
      corps
      mews
      news
  
      athletics
      mathematics
      physics
      metaphysics
  
  
      bogus
      bus
      cactus
      citrus
      corpus
      hippopotamus
      homunculus
      minus
      narcissus
      octopus
      papyrus
      platypus
      plus
      pus
      stylus
      various
      previous
      devious
      metropolis
      miscellaneous
      perhaps
      thus
      famous
      mrs
  sometimes
  
  ourselves
  themselves
  cannabis
  /);
  
  my %not_plural;
  
  @not_plural{@not_plural} = (1) x @not_plural;
  
  
  
  my @oes = (qw/
  		 foes
  		 shoes
                   hoes
  		 throes
                   toes
  		 oboes
               /);
  
  my %oes;
  
  @oes{@oes} = (1) x @oes;
  
  
  
  my @ies = (qw/
  calories
  genies
  lies
  movies
  neckties
  pies
  ties
  /);
  
  my %ies;
  
  @ies{@ies} = (1) x @ies;
  
  
  my @ses = (qw/
  horses
  tenses
  /);
  
  my %ses;
  @ses{@ses} = (1) x @ses;
  
  
  my $es_re = qr/([^aeiou]s|ch|sh)es$/;
  
  
  sub to_singular
  {
      my ($word) = @_;
      my $singular = $word;
      if (! $not_plural{$word}) {
          if ($plural{$word}) {
              $singular = $plural{$word};
          }
          elsif ($word =~ /s$/) {
  	    if ($word =~ /'s$/) {
  		;
  	    }
  	    elsif (length ($word) <= 2) {
  		;
  	    }
  	    elsif ($word =~ /ss$/) {
  		;
  	    }
  	    elsif ($word =~ /sis$/) {
  		;
  	    }
              elsif ($word =~ /ies$/) {
                  if ($ies{$word}) {
                      $singular =~ s/ies$/ie/;
                  }
                  else {
                      $singular =~ s/ies$/y/;
                  }
              }
              elsif ($word =~ /oes$/) {
                  if ($oes{$word}) {
                      $singular =~ s/oes$/oe/;
                  }
                  else {
                      $singular =~ s/oes$/o/;
                  }
              }
              elsif ($word =~ /xes$/) {
  		$singular =~ s/xes$/x/;
              }
  	    elsif ($word =~ /ses$/) {
  		if ($ses{$word}) {
  		    $singular =~ s/ses$/se/;
  		}
  		else {
  		    $singular =~ s/ses$/s/;
  		}
  	    }
              elsif ($word =~ $es_re) {
                  $singular =~ s/$es_re/$1/;
              }
              else {
                  $singular =~ s/s$//;
              }
          }
      }            
      return $singular;
  }
  
  sub is_plural
  {
      my ($word) = @_;
      my $singular = to_singular ($word);
      my $is_plural;
      if ($singular ne $word) {
  	$is_plural = 1;
      }
      elsif ($plural{$singular} && $plural{$singular} eq $singular) {
  	$is_plural = 1;
      }
      else {
  	$is_plural = 0;
      }
      return $is_plural;
  }
  
  1;
  
LINGUA_EN_PLURALTOSINGULAR

$fatpacked{"List/MoreUtils.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'LIST_MOREUTILS';
  package List::MoreUtils;
  
  use 5.006;
  use strict;
  use warnings;
  
  BEGIN
  {
      our $VERSION = '0.408';
  }
  
  use Exporter::Tiny qw();
  use List::MoreUtils::XS qw();    
  
  my @junctions = qw(any all none notall);
  my @v0_22     = qw(
    true false
    firstidx lastidx
    insert_after insert_after_string
    apply indexes
    after after_incl before before_incl
    firstval lastval
    each_array each_arrayref
    pairwise natatime
    mesh uniq
    minmax part
  );
  my @v0_24  = qw(bsearch);
  my @v0_33  = qw(sort_by nsort_by);
  my @v0_400 = qw(one any_u all_u none_u notall_u one_u
    firstres onlyidx onlyval onlyres lastres
    singleton bsearchidx
  );
  
  my @all_functions = ( @junctions, @v0_22, @v0_24, @v0_33, @v0_400 );
  
  my %alias_list = (
      v0_22 => {
          first_index => "firstidx",
          last_index  => "lastidx",
          first_value => "firstval",
          last_value  => "lastval",
          zip         => "mesh",
      },
      v0_33 => {
          distinct => "uniq",
      },
      v0_400 => {
          first_result  => "firstres",
          only_index    => "onlyidx",
          only_value    => "onlyval",
          only_result   => "onlyres",
          last_result   => "lastres",
          bsearch_index => "bsearchidx",
      },
  );
  
  our @ISA         = qw(Exporter::Tiny);
  our @EXPORT_OK   = ( @all_functions, map { keys %$_ } values %alias_list );
  our %EXPORT_TAGS = (
      all         => \@EXPORT_OK,
      'like_0.22' => [
          any_u    => { -as => 'any' },
          all_u    => { -as => 'all' },
          none_u   => { -as => 'none' },
          notall_u => { -as => 'notall' },
          @v0_22,
          keys %{ $alias_list{v0_22} },
      ],
      'like_0.24' => [
          any_u    => { -as => 'any' },
          all_u    => { -as => 'all' },
          notall_u => { -as => 'notall' },
          'none',
          @v0_22,
          @v0_24,
          keys %{ $alias_list{v0_22} },
      ],
      'like_0.33' => [
          @junctions,
          @v0_22,
          @v0_33,
          keys %{ $alias_list{v0_22} },
          keys %{ $alias_list{v0_33} },
      ],
  );
  
  for my $set ( values %alias_list )
  {
      for my $alias ( keys %$set )
      {
          no strict qw(refs);
          *$alias = __PACKAGE__->can( $set->{$alias} );
      }
  }
  
  
  1;
LIST_MOREUTILS

$fatpacked{"List/MoreUtils/PP.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'LIST_MOREUTILS_PP';
  package List::MoreUtils::PP;
  
  use 5.006;
  use strict;
  use warnings;
  
  our $VERSION = '0.408';
  
  
  sub any (&@)
  {
      my $f = shift;
      foreach (@_)
      {
          return 1 if $f->();
      }
      return 0;
  }
  
  sub all (&@)
  {
      my $f = shift;
      foreach (@_)
      {
          return 0 unless $f->();
      }
      return 1;
  }
  
  sub none (&@)
  {
      my $f = shift;
      foreach (@_)
      {
          return 0 if $f->();
      }
      return 1;
  }
  
  sub notall (&@)
  {
      my $f = shift;
      foreach (@_)
      {
          return 1 unless $f->();
      }
      return 0;
  }
  
  sub one (&@)
  {
      my $f     = shift;
      my $found = 0;
      foreach (@_)
      {
          $f->() and $found++ and return 0;
      }
      $found;
  }
  
  sub any_u (&@)
  {
      my $f = shift;
      return if !@_;
      $f->() and return 1 foreach (@_);
      return 0;
  }
  
  sub all_u (&@)
  {
      my $f = shift;
      return if !@_;
      $f->() or return 0 foreach (@_);
      return 1;
  }
  
  sub none_u (&@)
  {
      my $f = shift;
      return if !@_;
      $f->() and return 0 foreach (@_);
      return 1;
  }
  
  sub notall_u (&@)
  {
      my $f = shift;
      return if !@_;
      $f->() or return 1 foreach (@_);
      return 0;
  }
  
  sub one_u (&@)
  {
      my $f = shift;
      return if !@_;
      my $found = 0;
      foreach (@_)
      {
          $f->() and $found++ and return 0;
      }
      $found;
  }
  
  sub true (&@)
  {
      my $f     = shift;
      my $count = 0;
      $f->() and ++$count foreach (@_);
      return $count;
  }
  
  sub false (&@)
  {
      my $f     = shift;
      my $count = 0;
      $f->() or ++$count foreach (@_);
      return $count;
  }
  
  sub firstidx (&@)
  {
      my $f = shift;
      foreach my $i ( 0 .. $#_ )
      {
          local *_ = \$_[$i];
          return $i if $f->();
      }
      return -1;
  }
  
  sub firstval (&@)
  {
      my $test = shift;
      foreach (@_)
      {
          return $_ if $test->();
      }
      return undef;
  }
  
  sub firstres (&@)
  {
      my $test = shift;
      foreach (@_)
      {
          my $testval = $test->();
          $testval and return $testval;
      }
      return undef;
  }
  
  sub onlyidx (&@)
  {
      my $f = shift;
      my $found;
      foreach my $i ( 0 .. $#_ )
      {
          local *_ = \$_[$i];
          $f->() or next;
          defined $found and return -1;
          $found = $i;
      }
      return defined $found ? $found : -1;
  }
  
  sub onlyval (&@)
  {
      my $test   = shift;
      my $result = undef;
      my $found  = 0;
      foreach (@_)
      {
          $test->() or next;
          $result = $_;
          $found++ and return undef;
      }
      return $result;
  }
  
  sub onlyres (&@)
  {
      my $test   = shift;
      my $result = undef;
      my $found  = 0;
      foreach (@_)
      {
          my $rv = $test->() or next;
          $result = $rv;
          $found++ and return undef;
      }
      return $found ? $result : undef;
  }
  
  sub lastidx (&@)
  {
      my $f = shift;
      foreach my $i ( reverse 0 .. $#_ )
      {
          local *_ = \$_[$i];
          return $i if $f->();
      }
      return -1;
  }
  
  sub lastval (&@)
  {
      my $test = shift;
      my $ix;
      for ( $ix = $#_; $ix >= 0; $ix-- )
      {
          local *_ = \$_[$ix];
          my $testval = $test->();
  
          $_[$ix] = $_;
          return $_ if $testval;
      }
      return undef;
  }
  
  sub lastres (&@)
  {
      my $test = shift;
      my $ix;
      for ( $ix = $#_; $ix >= 0; $ix-- )
      {
          local *_ = \$_[$ix];
          my $testval = $test->();
  
          $_[$ix] = $_;
          return $testval if $testval;
      }
      return undef;
  }
  
  sub insert_after (&$\@)
  {
      my ( $f, $val, $list ) = @_;
      my $c = &firstidx( $f, @$list );
      @$list = ( @{$list}[ 0 .. $c ], $val, @{$list}[ $c + 1 .. $#$list ], ) and return 1 if $c != -1;
      return 0;
  }
  
  sub insert_after_string ($$\@)
  {
      my ( $string, $val, $list ) = @_;
      my $c = firstidx { defined $_ and $string eq $_ } @$list;
      @$list = ( @{$list}[ 0 .. $c ], $val, @{$list}[ $c + 1 .. $#$list ], ) and return 1 if $c != -1;
      return 0;
  }
  
  sub apply (&@)
  {
      my $action = shift;
      &$action foreach my @values = @_;
      wantarray ? @values : $values[-1];
  }
  
  sub after (&@)
  {
      my $test = shift;
      my $started;
      my $lag;
      grep $started ||= do
      {
          my $x = $lag;
          $lag = $test->();
          $x;
      }, @_;
  }
  
  sub after_incl (&@)
  {
      my $test = shift;
      my $started;
      grep $started ||= $test->(), @_;
  }
  
  sub before (&@)
  {
      my $test = shift;
      my $more = 1;
      grep $more &&= !$test->(), @_;
  }
  
  sub before_incl (&@)
  {
      my $test = shift;
      my $more = 1;
      my $lag  = 1;
      grep $more &&= do
      {
          my $x = $lag;
          $lag = !$test->();
          $x;
      }, @_;
  }
  
  sub indexes (&@)
  {
      my $test = shift;
      grep {
          local *_ = \$_[$_];
          $test->()
      } 0 .. $#_;
  }
  
  sub pairwise (&\@\@)
  {
      my $op = shift;
  
      use vars qw{ @A @B };
      local ( *A, *B ) = @_;
  
      my ( $caller_a, $caller_b ) = do
      {
          my $pkg = caller();
          no strict 'refs';
          \*{ $pkg . '::a' }, \*{ $pkg . '::b' };
      };
  
      my $limit = $#A > $#B ? $#A : $#B;
  
      local ( *$caller_a, *$caller_b );
      map {
          ( *$caller_a, *$caller_b ) = \( $A[$_], $B[$_] );
  
          $op->();
      } 0 .. $limit;
  }
  
  sub each_array (\@;\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@)
  {
      return each_arrayref(@_);
  }
  
  sub each_arrayref
  {
      my @list  = @_;    
      my $index = 0;     
      my $max   = 0;     
  
      foreach (@list)
      {
          unless ( ref $_ eq 'ARRAY' )
          {
              require Carp;
              Carp::croak("each_arrayref: argument is not an array reference\n");
          }
          $max = @$_ if @$_ > $max;
      }
  
      return sub {
          if (@_)
          {
              my $method = shift;
              unless ( $method eq 'index' )
              {
                  require Carp;
                  Carp::croak("each_array: unknown argument '$method' passed to iterator.");
              }
  
              return undef if $index == 0 || $index > $max;
              return $index - 1;
          }
  
          return if $index >= $max;
          my $i = $index++;
  
          return map $_->[$i], @list;
        }
  }
  
  sub natatime ($@)
  {
      my $n    = shift;
      my @list = @_;
      return sub {
          return splice @list, 0, $n;
        }
  }
  
  sub mesh (\@\@;\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@)
  {
      my $max = -1;
      $max < $#$_ && ( $max = $#$_ ) foreach @_;
      map {
          my $ix = $_;
          map $_->[$ix], @_;
      } 0 .. $max;
  }
  
  sub uniq (@)
  {
      my %seen = ();
      my $k;
      my $seen_undef;
      grep { defined $_ ? not $seen{ $k = $_ }++ : not $seen_undef++ } @_;
  }
  
  sub singleton (@)
  {
      my %seen = ();
      my $k;
      my $seen_undef;
      grep { 1 == ( defined $_ ? $seen{ $k = $_ } : $seen_undef ) }
        grep { defined $_ ? not $seen{ $k = $_ }++ : not $seen_undef++ } @_;
  }
  
  sub minmax (@)
  {
      return unless @_;
      my $min = my $max = $_[0];
  
      for ( my $i = 1; $i < @_; $i += 2 )
      {
          if ( $_[ $i - 1 ] <= $_[$i] )
          {
              $min = $_[ $i - 1 ] if $min > $_[ $i - 1 ];
              $max = $_[$i]       if $max < $_[$i];
          }
          else
          {
              $min = $_[$i]       if $min > $_[$i];
              $max = $_[ $i - 1 ] if $max < $_[ $i - 1 ];
          }
      }
  
      if ( @_ & 1 )
      {
          my $i = $#_;
          if ( $_[ $i - 1 ] <= $_[$i] )
          {
              $min = $_[ $i - 1 ] if $min > $_[ $i - 1 ];
              $max = $_[$i]       if $max < $_[$i];
          }
          else
          {
              $min = $_[$i]       if $min > $_[$i];
              $max = $_[ $i - 1 ] if $max < $_[ $i - 1 ];
          }
      }
  
      return ( $min, $max );
  }
  
  sub part (&@)
  {
      my ( $code, @list ) = @_;
      my @parts;
      push @{ $parts[ $code->($_) ] }, $_ foreach @list;
      return @parts;
  }
  
  sub bsearch(&@)
  {
      my $code = shift;
  
      my $rc;
      my $i = 0;
      my $j = @_;
      do
      {
          my $k = int( ( $i + $j ) / 2 );
  
          $k >= @_ and return;
  
          local *_ = \$_[$k];
          $rc = $code->();
  
          $rc == 0
            and return wantarray ? $_ : 1;
  
          if ( $rc < 0 )
          {
              $i = $k + 1;
          }
          else
          {
              $j = $k - 1;
          }
      } until $i > $j;
  
      return;
  }
  
  sub bsearchidx(&@)
  {
      my $code = shift;
  
      my $rc;
      my $i = 0;
      my $j = @_;
      do
      {
          my $k = int( ( $i + $j ) / 2 );
  
          $k >= @_ and return -1;
  
          local *_ = \$_[$k];
          $rc = $code->();
  
          $rc == 0 and return $k;
  
          if ( $rc < 0 )
          {
              $i = $k + 1;
          }
          else
          {
              $j = $k - 1;
          }
      } until $i > $j;
  
      return -1;
  }
  
  sub sort_by(&@)
  {
      my ( $code, @list ) = @_;
      return map { $_->[0] }
        sort     { $a->[1] cmp $b->[1] }
        map { [ $_, scalar( $code->() ) ] } @list;
  }
  
  sub nsort_by(&@)
  {
      my ( $code, @list ) = @_;
      return map { $_->[0] }
        sort     { $a->[1] <=> $b->[1] }
        map { [ $_, scalar( $code->() ) ] } @list;
  }
  
  sub _XScompiled { 0 }
  
  
  1;
LIST_MOREUTILS_PP

$fatpacked{"List/MoreUtils/XS.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'LIST_MOREUTILS_XS';
  package List::MoreUtils::XS;
  
  use 5.006;
  use strict;
  use warnings;
  
  use vars qw{$VERSION @ISA};
  
  BEGIN
  {
      $VERSION = '0.408';
  
      my $ldr = <<EOLDR;
  	package List::MoreUtils;
  
  	# PERL_DL_NONLAZY must be false, or any errors in loading will just
  	# cause the perl code to be tested
  	local \$ENV{PERL_DL_NONLAZY} = 0 if \$ENV{PERL_DL_NONLAZY};
  
  	use XSLoader ();
  	XSLoader::load("List::MoreUtils", "$VERSION");
  
  	1;
  EOLDR
  
      eval $ldr unless $ENV{LIST_MOREUTILS_PP};
  
      my @pp_imp = map { "List::MoreUtils->can(\"$_\") or *$_ = \\&List::MoreUtils::PP::$_;" }
        qw(any all none notall one any_u all_u none_u notall_u one_u true false
        firstidx firstval firstres lastidx lastval lastres onlyidx onlyval onlyres
        insert_after insert_after_string
        apply after after_incl before before_incl
        each_array each_arrayref pairwise
        natatime mesh uniq singleton minmax part indexes bsearch bsearchidx
        sort_by nsort_by _XScompiled);
      my $pp_stuff = join( "\n", "use List::MoreUtils::PP;", "package List::MoreUtils;", @pp_imp );
      eval $pp_stuff;
      die $@ if $@;
  }
  
  
  1;
LIST_MOREUTILS_XS

$fatpacked{"Log/Any.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'LOG_ANY';
  use 5.008001;
  use strict;
  use warnings;
  
  package Log::Any;
  
  our $VERSION = '1.032';
  
  use Log::Any::Manager;
  use Log::Any::Adapter::Util qw(
    require_dynamic
    detection_aliases
    detection_methods
    log_level_aliases
    logging_aliases
    logging_and_detection_methods
    logging_methods
  );
  
  our $OverrideDefaultAdapterClass;
  our $OverrideDefaultProxyClass;
  
  {
      my $manager = Log::Any::Manager->new();
      sub _manager { return $manager }
  }
  
  sub import {
      my $class  = shift;
      my $caller = caller();
  
      my @export_params = ( $caller, @_ );
      $class->_export_to_caller(@export_params);
  }
  
  sub _export_to_caller {
      my $class  = shift;
      my $caller = shift;
  
      my $saw_log_param;
      my @params;
      while ( my $param = shift @_ ) {
          if ( $param eq '$log' ) {
              $saw_log_param = 1;    
              next;                  
          }
          else {
              push @params, $param, shift @_;    
          }
      }
  
      unless ( @params % 2 == 0 ) {
          require Carp;
          Carp::croak("Argument list not balanced: @params");
      }
  
      if ($saw_log_param) {
          no strict 'refs';
          my $proxy = $class->get_logger( category => $caller, @params );
          my $varname = "$caller\::log";
          *$varname = \$proxy;
      }
  }
  
  sub get_logger {
      my ( $class, %params ) = @_;
      no warnings 'once';
  
      my $proxy_class = $class->_get_proxy_class( delete $params{proxy_class} );
      my $category =
        defined $params{category} ? delete $params{'category'} : caller;
  
      if ( my $default = delete $params{'default_adapter'} ) {
          $class->_manager->set_default( $category, $default );
      }
  
      my $adapter = $class->_manager->get_adapter( $category );
  
      require_dynamic($proxy_class);
      return $proxy_class->new(
          %params, adapter => $adapter, category => $category,
      );
  }
  
  sub _get_proxy_class {
      my ( $self, $proxy_name ) = @_;
      return $Log::Any::OverrideDefaultProxyClass
        if $Log::Any::OverrideDefaultProxyClass;
      return "Log::Any::Proxy" unless $proxy_name;
      my $proxy_class = (
            substr( $proxy_name, 0, 1 ) eq '+'
          ? substr( $proxy_name, 1 )
          : "Log::Any::Proxy::$proxy_name"
      );
      return $proxy_class;
  }
  
  sub set_adapter {
      my $class = shift;
      Log::Any->_manager->set(@_);
  }
  
  1;
  
  __END__
  
LOG_ANY

$fatpacked{"Log/Any/Adapter.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'LOG_ANY_ADAPTER';
  use 5.008001;
  use strict;
  use warnings;
  
  package Log::Any::Adapter;
  
  our $VERSION = '1.032';
  
  use Log::Any;
  
  sub import {
      my $pkg = shift;
      Log::Any->_manager->set(@_) if (@_);
  }
  
  sub set {
      my $pkg = shift;
      Log::Any->_manager->set(@_)
  }
  
  sub remove {
      my $pkg = shift;
      Log::Any->_manager->remove(@_)
  }
  
  1;
  
  __END__
  
LOG_ANY_ADAPTER

$fatpacked{"Log/Any/Adapter/Base.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'LOG_ANY_ADAPTER_BASE';
  use 5.008001;
  use strict;
  use warnings;
  
  package Log::Any::Adapter::Base;
  
  our $VERSION = '1.032';
  
  use Log::Any::Adapter::Util qw/make_method dump_one_line/;
  
  sub new {
      my $class = shift;
      my $self  = {@_};
      bless $self, $class;
      $self->init(@_);
      return $self;
  }
  
  sub init { }
  
  for my $method ( Log::Any::Adapter::Util::logging_and_detection_methods() ) {
      no strict 'refs';
      *$method = sub {
          my $class = ref( $_[0] ) || $_[0];
          die "$class does not implement $method";
      };
  }
  
  sub delegate_method_to_slot {
      my ( $class, $slot, $method, $adapter_method ) = @_;
  
      make_method( $method,
          sub { my $self = shift; return $self->{$slot}->$adapter_method(@_) },
          $class );
  }
  
  1;
LOG_ANY_ADAPTER_BASE

$fatpacked{"Log/Any/Adapter/Null.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'LOG_ANY_ADAPTER_NULL';
  use 5.008001;
  use strict;
  use warnings;
  
  package Log::Any::Adapter::Null;
  
  our $VERSION = '1.032';
  
  use base qw/Log::Any::Adapter::Base/;
  
  use Log::Any::Adapter::Util ();
  
  
  foreach my $method (Log::Any::Adapter::Util::logging_and_detection_methods()) {
      no strict 'refs';
      *{$method} = sub { return '' }; 
  }
  
  1;
  
  __END__
  
LOG_ANY_ADAPTER_NULL

$fatpacked{"Log/Any/Adapter/ScreenColoredLevel.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'LOG_ANY_ADAPTER_SCREENCOLOREDLEVEL';
  package Log::Any::Adapter::ScreenColoredLevel;
  
  our $DATE = '2015-01-28'; 
  our $VERSION = '0.07'; 
  
  use 5.010001;
  use strict;
  use warnings;
  
  use Log::Any;
  use Log::Any::Adapter::Util qw(make_method);
  use base qw(Log::Any::Adapter::Base);
  use Term::ANSIColor;
  
  my @logging_methods = Log::Any->logging_methods;
  our %logging_levels;
  for my $i (0..@logging_methods-1) {
      $logging_levels{$logging_methods[$i]} = $i;
  }
  $logging_levels{warn} = $logging_levels{warning};
  
  sub _default_level {
      return $ENV{LOG_LEVEL}
          if $ENV{LOG_LEVEL} && $logging_levels{$ENV{LOG_LEVEL}};
      return 'trace' if $ENV{TRACE};
      return 'debug' if $ENV{DEBUG};
      return 'info'  if $ENV{VERBOSE};
      return 'error' if $ENV{QUIET};
      'warning';
  }
  
  sub init {
      my ($self) = @_;
      $self->{stderr}    //= 1;
      $self->{use_color} //= (-t STDOUT);
      $self->{colors}    //= {
          trace     => 'yellow',
          debug     => '',
          info      => 'green',
          notice    => 'green',
          warning   => 'bold blue',
          error     => 'magenta',
          critical  => 'red',
          alert     => 'red',
          emergency => 'red',
      };
      $self->{min_level} //= _default_level();
  
      $self->{_fh} = $self->{stderr} ? \*STDERR : \*STDOUT;
  }
  
  sub hook_before_log {
      return;
  }
  
  sub hook_after_log {
      my ($self, $msg) = @_;
      print { $self->{_fh} } "\n" unless $msg =~ /\n\z/;
  }
  
  for my $method (Log::Any->logging_methods()) {
      make_method(
          $method,
          sub {
              my ($self, $msg) = @_;
  
              return if $logging_levels{$method} <
                  $logging_levels{$self->{min_level}};
  
              $self->hook_before_log($msg);
  
              if ($self->{formatter}) {
                  $msg = $self->{formatter}->($self, $msg);
              }
  
              if ($self->{use_color} && $self->{colors}{$method}) {
                  $msg = Term::ANSIColor::colored($msg, $self->{colors}{$method});
              }
  
              print { $self->{_fh} } $msg;
  
              $self->hook_after_log($msg);
          }
      );
  }
  
  for my $method (Log::Any->detection_methods()) {
      my $level = $method; $level =~ s/^is_//;
      make_method(
          $method,
          sub {
              my $self = shift;
              $logging_levels{$level} >= $logging_levels{$self->{min_level}};
          }
      );
  }
  
  1;
  
  __END__
  
LOG_ANY_ADAPTER_SCREENCOLOREDLEVEL

$fatpacked{"Log/Any/Adapter/Util.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'LOG_ANY_ADAPTER_UTIL';
  use 5.008001;
  use strict;
  use warnings;
  
  package Log::Any::Adapter::Util;
  
  our $VERSION = '1.032';
  
  use Data::Dumper;
  use base qw(Exporter);
  
  my %LOG_LEVELS;
  BEGIN {
      %LOG_LEVELS = (
          EMERGENCY => 0,
          ALERT     => 1,
          CRITICAL  => 2,
          ERROR     => 3,
          WARNING   => 4,
          NOTICE    => 5,
          INFO      => 6,
          DEBUG     => 7,
          TRACE     => 8,
      );
  }
  
  use constant \%LOG_LEVELS;
  
  our @EXPORT_OK = qw(
    cmp_deeply
    detection_aliases
    detection_methods
    dump_one_line
    log_level_aliases
    logging_aliases
    logging_and_detection_methods
    logging_methods
    make_method
    numeric_level
    read_file
    require_dynamic
  );
  
  push @EXPORT_OK, keys %LOG_LEVELS;
  
  our %EXPORT_TAGS = ( 'levels' => [ keys %LOG_LEVELS ] );
  
  my ( %LOG_LEVEL_ALIASES, @logging_methods, @logging_aliases, @detection_methods,
      @detection_aliases, @logging_and_detection_methods );
  
  BEGIN {
      %LOG_LEVEL_ALIASES = (
          inform => 'info',
          warn   => 'warning',
          err    => 'error',
          crit   => 'critical',
          fatal  => 'critical'
      );
      @logging_methods =
        qw(trace debug info notice warning error critical alert emergency);
      @logging_aliases               = keys(%LOG_LEVEL_ALIASES);
      @detection_methods             = map { "is_$_" } @logging_methods;
      @detection_aliases             = map { "is_$_" } @logging_aliases;
      @logging_and_detection_methods = ( @logging_methods, @detection_methods );
  }
  
  
  sub logging_methods               { @logging_methods }
  
  
  sub detection_methods             { @detection_methods }
  
  
  sub logging_and_detection_methods { @logging_and_detection_methods }
  
  
  sub log_level_aliases             { %LOG_LEVEL_ALIASES }
  
  
  sub logging_aliases               { @logging_aliases }
  
  
  sub detection_aliases             { @detection_aliases }
  
  
  sub numeric_level {
      my ($level) = @_;
      my $canonical =
        exists $LOG_LEVEL_ALIASES{$level} ? $LOG_LEVEL_ALIASES{$level} : $level;
      return $LOG_LEVELS{ uc($canonical) };
  }
  
  
  sub dump_one_line {
      my ($value) = @_;
  
      return Data::Dumper->new( [$value] )->Indent(0)->Sortkeys(1)->Quotekeys(0)
        ->Terse(1)->Dump();
  }
  
  
  sub make_method {
      my ( $method, $code, $pkg ) = @_;
  
      $pkg ||= caller();
      no strict 'refs';
      *{ $pkg . "::$method" } = $code;
  }
  
  
  sub require_dynamic {
      my ($class) = @_;
  
      return 1 if $class->can('new'); 
  
      unless ( defined( eval "require $class; 1" ) )
      {    
          die $@;
      }
  }
  
  
  sub read_file {
      my ($file) = @_;
  
      local $/ = undef;
      open( my $fh, '<', $file )
        or die "cannot open '$file': $!";
      my $contents = <$fh>;
      return $contents;
  }
  
  
  sub cmp_deeply {
      my ( $ref1, $ref2, $name ) = @_;
  
      my $tb = Test::Builder->new();
      $tb->is_eq( dump_one_line($ref1), dump_one_line($ref2), $name );
  }
  
  require Log::Any;
  
  1;
  
  
  
  __END__
  
LOG_ANY_ADAPTER_UTIL

$fatpacked{"Log/Any/IfLOG.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'LOG_ANY_IFLOG';
  package Log::Any::IfLOG;
  
  our $DATE = '2015-04-05'; 
  our $VERSION = '0.05'; 
  
  my $log_singleton;
  
  our $DEBUG;
  our $ENABLE_LOG;
  
  sub import {
      my $self = shift;
  
      my $log_enabled;
      if (defined $ENABLE_LOG) {
          $log_enabled = $ENABLE_LOG;
      } elsif ($INC{'Log/Any.pm'}) {
          $log_enabled = 1;
      } else {
          $log_enabled =
              $ENV{LOG} || $ENV{TRACE} || $ENV{DEBUG} ||
              $ENV{VERBOSE} || $ENV{QUIET} || $ENV{LOG_LEVEL};
      }
  
      my $caller = caller();
      if ($log_enabled) {
          require Log::Any;
          Log::Any->_export_to_caller($caller, @_);
      } else {
          my $saw_log_param = grep { $_ eq '$log' } @_;
          if ($saw_log_param) {
              if (!$log_singleton) { $log_singleton = Object::Dumb->new }
              *{"$caller\::log"} = \$log_singleton;
          }
      }
  }
  
  package
      Object::Dumb;
  sub new { my $o = ""; bless \$o, shift }
  sub AUTOLOAD { 0 }
  
  1;
  
  __END__
  
LOG_ANY_IFLOG

$fatpacked{"Log/Any/Manager.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'LOG_ANY_MANAGER';
  use 5.008001;
  use strict;
  use warnings;
  
  package Log::Any::Manager;
  
  our $VERSION = '1.032';
  
  sub new {
      my $class = shift;
      my $self  = {
          entries         => [],
          category_cache  => {},
          default_adapter => {},
      };
      bless $self, $class;
  
      return $self;
  }
  
  sub get_adapter {
      my ( $self, $category ) = @_;
  
      my $category_cache = $self->{category_cache};
      if ( !defined( $category_cache->{$category} ) ) {
          my $entry = $self->_choose_entry_for_category($category);
          my $adapter = $self->_new_adapter_for_entry( $entry, $category );
          $category_cache->{$category} = { entry => $entry, adapter => $adapter };
      }
      return $category_cache->{$category}->{adapter};
  }
  
  {
      no warnings 'once';
      *get_logger = \&get_adapter;    
  }
  
  sub _choose_entry_for_category {
      my ( $self, $category ) = @_;
  
      foreach my $entry ( @{ $self->{entries} } ) {
          if ( $category =~ $entry->{pattern} ) {
              return $entry;
          }
      }
      my $default = $self->{default_adapter}{$category}
          || [ $self->_get_adapter_class("Null"), [] ];
      my ($adapter_class, $adapter_params) = @$default;
      _require_dynamic($adapter_class);
      return {
          adapter_class  => $adapter_class,
          adapter_params => $adapter_params,
      };
  }
  
  sub _new_adapter_for_entry {
      my ( $self, $entry, $category ) = @_;
  
      return $entry->{adapter_class}
        ->new( @{ $entry->{adapter_params} }, category => $category );
  }
  
  sub set_default {
      my ( $self, $category, $adapter_name, @adapter_params ) = @_;
      my $adapter_class = $self->_get_adapter_class($adapter_name);
      $self->{default_adapter}{$category} = [$adapter_class, \@adapter_params];
  }
  
  sub set {
      my $self = shift;
      my $options;
      if ( ref( $_[0] ) eq 'HASH' ) {
          $options = shift(@_);
      }
      my ( $adapter_name, @adapter_params ) = @_;
  
      unless ( defined($adapter_name) && $adapter_name =~ /\S/ ) {
          require Carp;
          Carp::croak("expected adapter name");
      }
  
      my $pattern = $options->{category};
      if ( !defined($pattern) ) {
          $pattern = qr/.*/;
      }
      elsif ( !ref($pattern) ) {
          $pattern = qr/^\Q$pattern\E$/;
      }
  
      my $adapter_class = $self->_get_adapter_class($adapter_name);
      _require_dynamic($adapter_class);
  
      my $entry = $self->_new_entry( $pattern, $adapter_class, \@adapter_params );
      unshift( @{ $self->{entries} }, $entry );
  
      $self->_reselect_matching_adapters($pattern);
  
      if ( my $lex_ref = $options->{lexically} ) {
          $$lex_ref = Log::Any::Manager::_Guard->new(
              sub { $self->remove($entry) unless _in_global_destruction() } );
      }
  
      return $entry;
  }
  
  sub remove {
      my ( $self, $entry ) = @_;
  
      my $pattern = $entry->{pattern};
      $self->{entries} = [ grep { $_ ne $entry } @{ $self->{entries} } ];
      $self->_reselect_matching_adapters($pattern);
  }
  
  sub _new_entry {
      my ( $self, $pattern, $adapter_class, $adapter_params ) = @_;
  
      return {
          pattern        => $pattern,
          adapter_class  => $adapter_class,
          adapter_params => $adapter_params,
      };
  }
  
  sub _reselect_matching_adapters {
      my ( $self, $pattern ) = @_;
  
      return if _in_global_destruction();
  
      while ( my ( $category, $category_info ) =
          each( %{ $self->{category_cache} } ) )
      {
          my $new_entry = $self->_choose_entry_for_category($category);
          if ( $new_entry ne $category_info->{entry} ) {
              my $new_adapter =
                $self->_new_adapter_for_entry( $new_entry, $category );
              %{ $category_info->{adapter} } = %$new_adapter;
              bless( $category_info->{adapter}, ref($new_adapter) );
              $category_info->{entry} = $new_entry;
          }
      }
  }
  
  sub _get_adapter_class {
      my ( $self, $adapter_name ) = @_;
      return $Log::Any::OverrideDefaultAdapterClass if $Log::Any::OverrideDefaultAdapterClass;
      $adapter_name =~ s/^Log:://;    
      my $adapter_class = (
            substr( $adapter_name, 0, 1 ) eq '+'
          ? substr( $adapter_name, 1 )
          : "Log::Any::Adapter::$adapter_name"
      );
      return $adapter_class;
  }
  
  if ( defined ${^GLOBAL_PHASE} ) {
      eval 'sub _in_global_destruction () { ${^GLOBAL_PHASE} eq q[DESTRUCT] }; 1' 
        or die $@;
  }
  else {
      require B;
      my $started = !B::main_start()->isa(q[B::NULL]);
      unless ($started) {
          eval '0 && $started; CHECK { $started = 1 }; 1' 
            or die $@;
      }
      eval 
        '0 && $started; sub _in_global_destruction () { $started && B::main_start()->isa(q[B::NULL]) }; 1'
        or die $@;
  }
  
  sub _require_dynamic {
      my ($class) = @_;
  
      return 1 if $class->can('new'); 
  
      unless ( defined( eval "require $class; 1" ) )
      {    
          die $@;
      }
  }
  
  package    
    Log::Any::Manager::_Guard;
  
  sub new { bless $_[1], $_[0] }
  
  sub DESTROY { $_[0]->() }
  
  1;
LOG_ANY_MANAGER

$fatpacked{"Log/Any/Proxy.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'LOG_ANY_PROXY';
  use 5.008001;
  use strict;
  use warnings;
  
  package Log::Any::Proxy;
  
  our $VERSION = '1.032';
  
  use Log::Any::Adapter::Util ();
  
  sub _default_formatter {
      my ( $cat, $lvl, $format, @params ) = @_;
      my @new_params =
        map { !defined($_) ? '<undef>' : ref($_) ? _dump_one_line($_) : $_ }
        @params;
      return sprintf( $format, @new_params );
  }
  
  sub _dump_one_line {
      my ($value) = @_;
  
      return Data::Dumper->new( [$value] )->Indent(0)->Sortkeys(1)->Quotekeys(0)
        ->Terse(1)->Useqq(1)->Dump();
  }
  
  sub new {
      my $class = shift;
      my $self = { formatter => \&_default_formatter, @_ };
      unless ( $self->{adapter} ) {
          require Carp;
          Carp::croak("$class requires an 'adapter' parameter");
      }
      unless ( $self->{category} ) {
          require Carp;
          Carp::croak("$class requires an 'category' parameter")
      }
      bless $self, $class;
      $self->init(@_);
      return $self;
  }
  
  sub init { }
  
  for my $attr (qw/adapter filter formatter prefix/) {
      no strict 'refs';
      *{$attr} = sub { return $_[0]->{$attr} };
  }
  
  my %aliases = Log::Any::Adapter::Util::log_level_aliases();
  
  foreach my $name ( Log::Any::Adapter::Util::logging_methods(), keys(%aliases) )
  {
      my $realname    = $aliases{$name} || $name;
      my $namef       = $name . "f";
      my $is_name     = "is_$name";
      my $is_realname = "is_$realname";
      my $numeric     = Log::Any::Adapter::Util::numeric_level($realname);
      no strict 'refs';
      *{$is_name} = sub {
          my ($self) = @_;
          return $self->{adapter}->$is_realname;
      };
      *{$name} = sub {
          my ( $self, @parts ) = @_;
          my $message = join(" ", grep { defined($_) && length($_) } @parts );
          return unless length $message;
          $message = $self->{filter}->( $self->{category}, $numeric, $message )
            if defined $self->{filter};
          return unless defined $message and length $message;
          $message = "$self->{prefix}$message"
            if defined $self->{prefix} && length $self->{prefix};
          return $self->{adapter}->$realname($message);
      };
      *{$namef} = sub {
          my ( $self, @args ) = @_;
          return unless $self->{adapter}->$is_realname;
          my $message =
            $self->{formatter}->( $self->{category}, $numeric, @args );
          return unless defined $message and length $message;
          return $self->$name($message);
      };
  }
  
  1;
  
  
  
  __END__
  
LOG_ANY_PROXY

$fatpacked{"Mo.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'MO';
  package Mo;
  $VERSION=0.39;
  no warnings;my$M=__PACKAGE__.'::';*{$M.Object::new}=sub{my$c=shift;my$s=bless{@_},$c;my%n=%{$c.::.':E'};map{$s->{$_}=$n{$_}->()if!exists$s->{$_}}keys%n;$s};*{$M.import}=sub{import warnings;$^H|=1538;my($P,%e,%o)=caller.'::';shift;eval"no Mo::$_",&{$M.$_.::e}($P,\%e,\%o,\@_)for@_;return if$e{M};%e=(extends,sub{eval"no $_[0]()";@{$P.ISA}=$_[0]},has,sub{my$n=shift;my$m=sub{$#_?$_[0]{$n}=$_[1]:$_[0]{$n}};@_=(default,@_)if!($#_%2);$m=$o{$_}->($m,$n,@_)for sort keys%o;*{$P.$n}=$m},%e,);*{$P.$_}=$e{$_}for keys%e;@{$P.ISA}=$M.Object};
MO

$fatpacked{"Mo/build.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'MO_BUILD';
  package Mo::build;my$M="Mo::";
  $VERSION=0.39;
  *{$M.'build::e'}=sub{my($P,$e)=@_;$e->{new}=sub{$c=shift;my$s=&{$M.Object::new}($c,@_);my@B;do{@B=($c.::BUILD,@B)}while($c)=@{$c.::ISA};exists&$_&&&$_($s)for@B;$s}};
MO_BUILD

$fatpacked{"Mo/default.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'MO_DEFAULT';
  package Mo::default;my$M="Mo::";
  $VERSION=0.39;
  *{$M.'default::e'}=sub{my($P,$e,$o)=@_;$o->{default}=sub{my($m,$n,%a)=@_;exists$a{default}or return$m;my($d,$r)=$a{default};my$g='HASH'eq($r=ref$d)?sub{+{%$d}}:'ARRAY'eq$r?sub{[@$d]}:'CODE'eq$r?$d:sub{$d};my$i=exists$a{lazy}?$a{lazy}:!${$P.':N'};$i or ${$P.':E'}{$n}=$g and return$m;sub{$#_?$m->(@_):!exists$_[0]{$n}?$_[0]{$n}=$g->(@_):$m->(@_)}}};
MO_DEFAULT

$fatpacked{"PERLANCAR/File/HomeDir.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PERLANCAR_FILE_HOMEDIR';
  package PERLANCAR::File::HomeDir;
  
  our $DATE = '2015-04-08'; 
  our $VERSION = '0.02'; 
  
  use 5.010001;
  use strict;
  use warnings;
  
  use Exporter qw(import);
  our @EXPORT_OK = qw(
                         get_my_home_dir
                 );
  
  our $DIE_ON_FAILURE = 0;
  
  sub get_my_home_dir {
      if ($^O eq 'MSWin32') {
          return $ENV{HOME} if $ENV{HOME};
          return $ENV{USERPROFILE} if $ENV{USERPROFILE};
          return join($ENV{HOMEDRIVE}, "\\", $ENV{HOMEPATH})
              if $ENV{HOMEDRIVE} && $ENV{HOMEPATH};
      } else {
          return $ENV{HOME} if $ENV{HOME};
          my @pw = getpwuid($>);
          return $pw[7] if @pw;
      }
  
      if ($DIE_ON_FAILURE) {
          die "Can't get home directory";
      } else {
          return undef;
      }
  }
  
  1;
  
  __END__
  
PERLANCAR_FILE_HOMEDIR

$fatpacked{"Perinci/Access/Lite.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PERINCI_ACCESS_LITE';
  package Perinci::Access::Lite;
  
  our $DATE = '2015-01-22'; 
  our $VERSION = '0.09'; 
  
  use 5.010001;
  use strict;
  use warnings;
  
  use Perinci::AccessUtil qw(strip_riap_stuffs_from_res);
  
  sub new {
      my ($class, %args) = @_;
      $args{riap_version} //= 1.1;
      bless \%args, $class;
  }
  
  sub __package_exists {
      no strict 'refs';
  
      my $pkg = shift;
  
      return unless $pkg =~ /\A\w+(::\w+)*\z/;
      if ($pkg =~ s/::(\w+)\z//) {
          return !!${$pkg . "::"}{$1 . "::"};
      } else {
          return !!$::{$pkg . "::"};
      }
  }
  
  sub request {
      my ($self, $action, $url, $extra) = @_;
  
  
      $extra //= {};
  
      my $v = $extra->{v} // 1.1;
      if ($v ne '1.1' && $v ne '1.2') {
          return [501, "Riap protocol not supported, must be 1.1 or 1.2"];
      }
  
      my $res;
      if ($url =~ m!\A(?:pl:)?/(\w+(?:/\w+)*)/(\w*)\z!) {
          my ($modpath, $func) = ($1, $2);
          (my $pkg = $modpath) =~ s!/!::!g;
          my $pkg_exists = __package_exists($pkg);
          unless ($pkg_exists) {
              eval { require "$modpath.pm" };
              return [500, "Can't load module $pkg: $@"] if $@;
          }
  
          if ($action eq 'list') {
              return [501, "Action 'list' not implemented for ".
                          "non-package entities"]
                  if length($func);
              no strict 'refs';
              my $spec = \%{"$pkg\::SPEC"};
              return [200, "OK (list)", [grep {/\A\w+\z/} sort keys %$spec]];
          } elsif ($action eq 'info') {
              my $data = {
                  uri => "$modpath/$func",
                  type => (!length($func) ? "package" :
                               $func =~ /\A\w+\z/ ? "function" :
                                   $func =~ /\A[\@\$\%]/ ? "variable" :
                                       "?"),
              };
              return [200, "OK (info)", $data];
          } elsif ($action eq 'meta' || $action eq 'call') {
              return [501, "Action 'call' not implemented for package entity"]
                  if !length($func) && $action eq 'call';
              my $meta;
              {
                  no strict 'refs';
                  if (length $func) {
                      $meta = ${"$pkg\::SPEC"}{$func}
                          or return [
                              500, "No metadata for '$url' (".
                                  ($pkg_exists ? "package '$pkg' exists, perhaps you mentioned '$pkg' somewhere without actually loading the module, or perhaps '$func' is a typo?" :
                                       "package '$pkg' doesn't exist, perhaps '$modpath' or '$func' is a typo?") .
                                  ")"];
                  } else {
                      $meta = ${"$pkg\::SPEC"}{':package'} // {v=>1.1};
                  }
                  $meta->{entity_v}    //= ${"$pkg\::VERSION"};
                  $meta->{entity_date} //= ${"$pkg\::DATE"};
              }
  
              require Perinci::Sub::Normalize;
              $meta = Perinci::Sub::Normalize::normalize_function_metadata($meta);
              return [200, "OK ($action)", $meta] if $action eq 'meta';
  
              my $args = { %{$extra->{args} // {}} }; 
              if ($meta->{features} && $meta->{features}{progress}) {
                  require Progress::Any;
                  $args->{-progress} = Progress::Any->get_indicator;
              }
  
              my $aa = $meta->{args_as} // 'hash';
              my @args;
              if ($aa =~ /array/) {
                  require Perinci::Sub::ConvertArgs::Array;
                  my $convres = Perinci::Sub::ConvertArgs::Array::convert_args_to_array(
                      args => $args, meta => $meta,
                  );
                  return $convres unless $convres->[0] == 200;
                  if ($aa =~ /ref/) {
                      @args = ($convres->[2]);
                  } else {
                      @args = @{ $convres->[2] };
                  }
              } elsif ($aa eq 'hashref') {
                  @args = ({ %$args });
              } else {
                  @args = %$args;
              }
  
              {
                  no strict 'refs';
                  $res = &{"$pkg\::$func"}(@args);
              }
  
              if ($meta->{result_naked}) {
                  $res = [200, "OK (envelope added by ".__PACKAGE__.")", $res];
              }
  
              if (defined $res->[2]) {
                  if ($meta->{result} && $meta->{result}{schema} &&
                          $meta->{result}{schema}[0] eq 'buf') {
                      $res->[3]{'x.hint.result_binary'} = 1;
                  }
              }
  
          } else {
              return [501, "Unknown/unsupported action '$action'"];
          }
      } elsif ($url =~ m!\Ahttps?:/(/?)!i) {
          my $is_unix = !$1;
          my $ht;
          require JSON;
          state $json = JSON->new->allow_nonref;
          if ($is_unix) {
              require HTTP::Tiny::UNIX;
              $ht = HTTP::Tiny::UNIX->new;
          } else {
              require HTTP::Tiny;
              $ht = HTTP::Tiny->new;
          }
          my %headers = (
              "x-riap-v" => $self->{riap_version},
              "x-riap-action" => $action,
              "x-riap-fmt" => "json",
              "content-type" => "application/json",
          );
          my $args = $extra->{args} // {};
          for (keys %$extra) {
              next if /\Aargs\z/;
              $headers{"x-riap-$_"} = $extra->{$_};
          }
          my $htres = $ht->post(
              $url, {
                  headers => \%headers,
                  content => $json->encode($args),
              });
          return [500, "Network error: $htres->{status} - $htres->{reason}"]
              if $htres->{status} != 200;
          return [500, "Server error: didn't return JSON (".$htres->{headers}{'content-type'}.")"]
              unless $htres->{headers}{'content-type'} eq 'application/json';
          return [500, "Server error: didn't return Riap 1.1 response (".$htres->{headers}{'x-riap-v'}.")"]
              unless $htres->{headers}{'x-riap-v'} =~ /\A1\.1(\.\d+)?\z/;
          $res = $json->decode($htres->{content});
      } else {
          return [501, "Unsupported scheme or bad URL '$url'"];
      }
  
      strip_riap_stuffs_from_res($res);
  }
  
  1;
  
  __END__
  
PERINCI_ACCESS_LITE

$fatpacked{"Perinci/AccessUtil.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PERINCI_ACCESSUTIL';
  package Perinci::AccessUtil;
  
  our $DATE = '2014-10-24'; 
  our $VERSION = '0.05'; 
  
  use 5.010001;
  use strict;
  use warnings;
  
  use MIME::Base64;
  
  require Exporter;
  our @ISA = qw(Exporter);
  our @EXPORT_OK = qw(insert_riap_stuffs_to_res
                      strip_riap_stuffs_from_res
                      decode_args_in_riap_req);
  
  sub insert_riap_stuffs_to_res {
      my ($res, $def_ver, $nmeta, $encode) = @_;
  
      $res->[3]{'riap.v'} //= $def_ver // 1.1;
      if ($res->[3]{'riap.v'} >= 1.2) {
          {
              last unless $encode // 1;
              last if $res->[3]{'riap.result_encoding'};
              if ($nmeta) {
                  last unless $nmeta->{result}{schema} &&
                      $nmeta->{result}{schema}[0] eq 'buf';
              }
              last unless defined($res->[2]) && !ref($res->[2]) &&
                  $res->[2] =~ /[^\x20-\x7f]/;
              $res->[2] = encode_base64($res->[2]);
              $res->[3]{'riap.result_encoding'} = 'base64';
          }
      }
      $res;
  }
  
  sub strip_riap_stuffs_from_res {
      my $res = shift;
  
      my $ver = $res->[3]{'riap.v'} // 1.1;
      return [501, "Riap version returned by server ($ver) is not supported, ".
                  "only recognize v1.1 and v1.2"]
          unless $ver == 1.1 || $ver == 1.2;
  
      if ($ver >= 1.2) {
          for my $k (keys %{$res->[3]}) {
              next unless $k =~ /\Ariap\./;
              my $val = $res->[3]{$k};
              if ($k eq 'riap.v') {
              } elsif ($k eq 'riap.result_encoding') {
                  return [501, "Unknown result_encoding returned by server ".
                              "($val), only base64 is supported"]
                      unless $val eq 'base64';
                  $res->[2] = decode_base64($res->[2]//'');
              } else {
                  return [501, "Unknown Riap attribute in result metadata ".
                              "returned by server ($k)"];
              }
              delete $res->[3]{$k};
          }
      }
  
      $res;
  }
  
  sub decode_args_in_riap_req {
      my $req = shift;
  
      my $v = $req->{v} // 1.1;
      if ($v >= 1.2) {
          if ($req->{args}) {
              my $args = $req->{args};
              for (keys %$args) {
                  next unless /\A(.+):base64\z/;
                  $args->{$1} = decode_base64($args->{$_});
                  delete $args->{$_};
              }
          }
      }
      $req;
  }
  
  1;
  
  __END__
  
PERINCI_ACCESSUTIL

$fatpacked{"Perinci/CmdLine/Base.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PERINCI_CMDLINE_BASE';
  package Perinci::CmdLine::Base;
  
  our $DATE = '2015-04-12'; 
  our $VERSION = '1.10'; 
  
  use 5.010001;
  use strict;
  use warnings;
  use Log::Any::IfLOG '$log';
  
  
  BEGIN {
      if ($INC{'Perinci/CmdLine/Classic.pm'}) {
          require Moo; Moo->import;
      } else {
          require Mo; Mo->import(qw(build default));
      }
  }
  
  has actions => (is=>'rw');
  has common_opts => (is=>'rw');
  has completion => (is=>'rw');
  has default_subcommand => (is=>'rw');
  has get_subcommand_from_arg => (is=>'rw', default=>1);
  has description => (is=>'rw');
  has exit => (is=>'rw', default=>1);
  has formats => (is=>'rw');
  has pass_cmdline_object => (is=>'rw', default=>0);
  has per_arg_json => (is=>'rw');
  has per_arg_yaml => (is=>'rw');
  has program_name => (
      is=>'rw',
      default => sub {
          my $pn = $ENV{PERINCI_CMDLINE_PROGRAM_NAME};
          if (!defined($pn)) {
              $pn = $0; $pn =~ s!.+/!!;
          }
          $pn;
      });
  has riap_version => (is=>'rw', default=>1.1);
  has riap_client => (is=>'rw');
  has riap_client_args => (is=>'rw');
  has subcommands => (is=>'rw');
  has summary => (is=>'rw');
  has tags => (is=>'rw');
  has url => (is=>'rw');
  
  has read_env => (is=>'rw', default=>1);
  has env_name => (
      is => 'rw',
      default => sub {
          my $self = shift;
          __default_env_name($self->program_name);
      },
  );
  
  has read_config => (is=>'rw', default=>1);
  has config_filename => (is=>'rw');
  has config_dirs => (
      is=>'rw',
      default => sub {
          require Perinci::CmdLine::Util::Config;
          Perinci::CmdLine::Util::Config::get_default_config_dirs();
      },
  );
  
  has cleanser => (
      is => 'rw',
      lazy => 1,
      default => sub {
          require Data::Clean::JSON;
          Data::Clean::JSON->get_cleanser;
      },
  );
  
  
  
  our %copts = (
  
      version => {
          getopt  => "version|v",
          summary => "Display program's version and exit",
          usage   => "--version (or -v)",
          handler => sub {
              my ($go, $val, $r) = @_;
              $r->{action} = 'version';
              $r->{skip_parse_subcommand_argv} = 1;
          },
      },
  
      help => {
          getopt  => 'help|h|?',
          summary => 'Display help message and exit',
          usage   => "--help (or -h, -?)",
          handler => sub {
              my ($go, $val, $r) = @_;
              $r->{action} = 'help';
              $r->{skip_parse_subcommand_argv} = 1;
          },
          order => 0, 
      },
  
      format => {
          getopt  => 'format=s',
          summary => 'Choose output format, e.g. json, text',
          handler => sub {
              my ($go, $val, $r) = @_;
              $r->{format} = $val;
          },
          default => undef,
          tags => ['category:output'],
          is_settable_via_config => 1,
      },
      json => {
          getopt  => 'json',
          summary => 'Set output format to json',
          handler => sub {
              my ($go, $val, $r) = @_;
              $r->{format} = 'json';
          },
          tags => ['category:output'],
      },
  
      naked_res => {
          getopt  => 'naked-res!',
          summary => 'When outputing as JSON, strip result envelope',
          'summary.alt.bool.not' => 'When outputing as JSON, add result envelope',
          description => <<'_',
  
  By default, when outputing as JSON, the full enveloped result is returned, e.g.:
  
      [200,"OK",[1,2,3],{"func.extra"=>4}]
  
  The reason is so you can get the status (1st element), status message (2nd
  element) as well as result metadata/extra result (4th element) instead of just
  the result (3rd element). However, sometimes you want just the result, e.g. when
  you want to pipe the result for more post-processing. In this case you can use
  `--naked-res` so you just get:
  
      [1,2,3]
  
  _
          handler => sub {
              my ($go, $val, $r) = @_;
              $r->{naked_res} = $val ? 1:0;
          },
          default => 0,
          tags => ['category:output'],
          is_settable_via_config => 1,
      },
  
      subcommands => {
          getopt  => 'subcommands',
          summary => 'List available subcommands',
          usage   => "--subcommands",
          show_in_usage => sub {
              my ($self, $r) = @_;
              !$r->{subcommand_name};
          },
          handler => sub {
              my ($go, $val, $r) = @_;
              $r->{action} = 'subcommands';
              $r->{skip_parse_subcommand_argv} = 1;
          },
      },
  
      cmd => {
          getopt  => "cmd=s",
          summary => 'Select subcommand',
          handler => sub {
              my ($go, $val, $r) = @_;
              $r->{subcommand_name} = $val;
              $r->{subcommand_name_from} = '--cmd';
          },
          completion => sub {
              require Complete::Util;
              my %args = @_;
              my $cmdline = $args{cmdline};
              Complete::Util::complete_array_elem(
                  array => [keys %{ $cmdline->list_subcommands }],
                  word  => $args{word},
                  ci    => 1,
              );
          },
      },
  
      config_path => {
          getopt  => 'config-path=s@',
          schema  => ['array*', of => 'str*'],
          'x.schema.element_entity' => 'filename',
          summary => 'Set path to configuration file',
          handler => sub {
              my ($go, $val, $r) = @_;
              $r->{config_paths} //= [];
              push @{ $r->{config_paths} }, $val;
          },
          tags => ['category:configuration'],
      },
      no_config => {
          getopt  => 'no-config',
          summary => 'Do not use any configuration file',
          handler => sub {
              my ($go, $val, $r) = @_;
              $r->{read_config} = 0;
          },
          tags => ['category:configuration'],
      },
      no_env => {
          getopt  => 'no-env',
          summary => 'Do not read environment for default options',
          handler => sub {
              my ($go, $val, $r) = @_;
              $r->{read_env} = 0;
          },
          tags => ['category:environment'],
      },
      config_profile => {
          getopt  => 'config-profile=s',
          summary => 'Set configuration profile to use',
          handler => sub {
              my ($go, $val, $r) = @_;
              $r->{config_profile} = $val;
          },
          completion => sub {
  
              my %args = @_;
              my $word    = $args{word} // '';
              my $cmdline = $args{cmdline};
              my $r       = $args{r};
  
              return undef unless $cmdline;
  
              {
                  $r->{read_config} = 1;
  
                  my $res = $cmdline->parse_argv($r);
              }
  
              return [] unless $r->{config};
  
              my @profiles;
              for (keys %{$r->{config}}) {
                  if (length $r->{subcommand_name}) {
                      push @profiles, $1
                          if /\A\Q$r->{subcommand_name}\E \s+ profile=(.+)/x;
                  } else {
                      push @profiles, $1 if /\Aprofile=(.+)/;
                  }
              }
  
              require Complete::Util;
              Complete::Util::complete_array_elem(
                  array=>[sort @profiles], word=>$word, ci=>1);
          },
          tags => ['category:configuration'],
      },
  
      log_level => {
          getopt  => 'log-level=s',
          summary => 'Set log level',
          schema  => ['str*' => in => [
              qw/trace debug info warn warning error fatal/]],
          handler => sub {
              my ($go, $val, $r) = @_;
              $r->{log_level} = $val;
              $ENV{LOG_LEVEL} = $val;
          },
          is_settable_via_config => 1,
          tags => ['category:logging'],
      },
      trace => {
          getopt  => "trace",
          summary => "Set log level to trace",
          handler => sub {
              my ($go, $val, $r) = @_;
              $ENV{TRACE} = 1;
          },
          tags => ['category:logging'],
      },
      debug => {
          getopt  => "debug",
          summary => "Set log level to debug",
          handler => sub {
              my ($go, $val, $r) = @_;
              $ENV{DEBUG} = 1;
          },
          tags => ['category:logging'],
      },
      verbose => {
          getopt  => "verbose",
          summary => "Set log level to info",
          handler => sub {
              my ($go, $val, $r) = @_;
              $ENV{VERBOSE} = 1;
              $r->{_help_verbose} = 1;
          },
          tags => ['category:logging'],
      },
      quiet => {
          getopt  => "quiet",
          summary => "Set log level to quiet",
          handler => sub {
              my ($go, $val, $r) = @_;
              $ENV{QUIET} = 1;
          },
          tags => ['category:logging'],
      },
  
  );
  
  sub __default_env_name {
      my ($prog) = @_;
  
      for ($prog) {
          $_ //= "PROG"; 
          $_ = uc($_);
          s/[^A-Z0-9]+/_/g;
      }
      "${prog}_OPT";
  }
  
  sub hook_before_run {}
  
  sub hook_before_read_config_file {}
  
  sub hook_after_read_config_file {}
  
  sub hook_before_action {}
  
  sub hook_after_action {}
  
  sub get_meta {
      my ($self, $r, $url) = @_;
  
      my $res = $self->riap_client->request(meta => $url);
      die $res unless $res->[0] == 200;
      my $meta = $res->[2];
      $r->{meta} = $meta;
      $log->tracef("[pericmd] Running hook_after_get_meta ...");
      $self->hook_after_get_meta($r);
      $meta;
  }
  
  sub get_program_and_subcommand_name {
      my ($self, $r) = @_;
      my $res = ($self->program_name // "") . " " .
          ($r->{subcommand_name} // "");
      $res =~ s/\s+$//;
      $res;
  }
  
  sub get_subcommand_data {
      my ($self, $name) = @_;
  
      my $scs = $self->subcommands;
      return undef unless $scs;
  
      if (ref($scs) eq 'CODE') {
          return $scs->($self, name=>$name);
      } else {
          return $scs->{$name};
      }
  }
  
  sub list_subcommands {
      my ($self) = @_;
      return $self->{_cache_subcommands} if $self->{_cache_subcommands};
  
      my $scs = $self->subcommands;
      my $res;
      if ($scs) {
          if (ref($scs) eq 'CODE') {
              $scs = $scs->($self);
              die [500, "BUG: Subcommands code didn't return a hashref"]
                  unless ref($scs) eq 'HASH';
          }
          $res = $scs;
      } else {
          $res = {};
      }
      $self->{_cache_subcommands} = $res;
      $res;
  }
  
  sub status2exitcode {
      my ($self, $status) = @_;
      return 0 if $status =~ /^2..|304/;
      $status - 300;
  }
  
  sub _detect_completion {
      my ($self, $r) = @_;
  
      if ($ENV{COMP_SHELL}) {
          $r->{shell} = $ENV{COMP_SHELL};
          return 1;
      } elsif ($ENV{COMP_LINE}) {
          $r->{shell} = 'bash';
          return 1;
      } elsif ($ENV{COMMAND_LINE}) {
          $r->{shell} = 'tcsh';
          return 1;
      }
  
      $r->{shell} //= 'bash';
  
      0;
  }
  
  sub _read_env {
      my ($self, $r) = @_;
  
      return [] unless $self->read_env;
      my $env_name = $self->env_name;
      my $env = $ENV{$env_name};
      $log->tracef("[pericmd] Checking env %s: %s", $env_name, $env);
      return [] unless defined $env;
  
  
      my $words;
      if ($r->{shell} eq 'bash') {
          require Complete::Bash;
          ($words, undef) = @{ Complete::Bash::parse_cmdline($env, 0) };
      } elsif ($r->{shell} eq 'fish') {
          require Complete::Fish;
          ($words, undef) = @{ Complete::Fish::parse_cmdline($env) };
      } elsif ($r->{shell} eq 'tcsh') {
          require Complete::Tcsh;
          ($words, undef) = @{ Complete::Tcsh::parse_cmdline($env) };
      } elsif ($r->{shell} eq 'zsh') {
          require Complete::Zsh;
          ($words, undef) = @{ Complete::Zsh::parse_cmdline($env) };
      } else {
          die "Unsupported shell '$r->{shell}'";
      }
      $log->tracef("[pericmd] Words from env: %s", $words);
      $words;
  }
  
  sub do_completion {
      my ($self, $r) = @_;
  
      local $r->{in_completion} = 1;
  
      my ($words, $cword);
      if ($r->{shell} eq 'bash') {
          require Complete::Bash;
          ($words, $cword) = @{ Complete::Bash::parse_cmdline() };
      } elsif ($r->{shell} eq 'fish') {
          require Complete::Fish;
          ($words, $cword) = @{ Complete::Fish::parse_cmdline() };
      } elsif ($r->{shell} eq 'tcsh') {
          require Complete::Tcsh;
          ($words, $cword) = @{ Complete::Tcsh::parse_cmdline() };
      } elsif ($r->{shell} eq 'zsh') {
          require Complete::Zsh;
          ($words, $cword) = @{ Complete::Zsh::parse_cmdline() };
      } else {
          die "Unsupported shell '$r->{shell}'";
      }
  
      shift @$words; $cword--; 
  
      @ARGV = @$words;
  
      $self->_parse_argv1($r);
  
      if ($r->{read_env}) {
          my $env_words = $self->_read_env($r);
          unshift @ARGV, @$env_words;
          $cword += @$env_words;
      }
  
  
      $r->{format} = 'text';
  
      my $scd = $r->{subcommand_data};
      my $meta = $self->get_meta($r, $scd->{url} // $self->{url});
  
      my $subcommand_name_from = $r->{subcommand_name_from} // '';
  
      require Perinci::Sub::Complete;
      my $compres = Perinci::Sub::Complete::complete_cli_arg(
          meta            => $meta, 
          words           => $words,
          cword           => $cword,
          common_opts     => $self->common_opts,
          riap_server_url => $scd->{url},
          riap_uri        => undef,
          riap_client     => $self->riap_client,
          extras          => {r=>$r, cmdline=>$self},
          func_arg_starts_at => ($subcommand_name_from eq 'arg' ? 1:0),
          completion      => sub {
              my %args = @_;
              my $type = $args{type};
  
              if ($self->completion) {
                  my $res = $self->completion(%args);
                  return $res if $res;
              }
              if ($self->subcommands &&
                      $subcommand_name_from ne '--cmd' &&
                           $args{type} eq 'arg' && $args{argpos}==0) {
                  require Complete::Util;
                  return Complete::Util::complete_array_elem(
                      array => [keys %{ $self->list_subcommands }],
                      word  => $words->[$cword]);
              }
  
              return undef;
          },
      );
  
      my $formatted;
      if ($r->{shell} eq 'bash') {
          $formatted = Complete::Bash::format_completion(
              $compres, {word=>$words->[$cword]});
      } elsif ($r->{shell} eq 'fish') {
          $formatted = Complete::Fish::format_completion($compres);
      } elsif ($r->{shell} eq 'tcsh') {
          $formatted = Complete::Tcsh::format_completion($compres);
      } elsif ($r->{shell} eq 'zsh') {
          $formatted = Complete::Zsh::format_completion($compres);
      }
  
      [200, "OK", $formatted,
       {
           "func.words" => $words,
           "func.cword" => $cword,
           "cmdline.skip_format" => 1,
       }];
  }
  
  sub _read_config {
      require Perinci::CmdLine::Util::Config;
  
      my ($self, $r) = @_;
  
      $log->tracef("[pericmd] Finding config files ...");
      my $res = Perinci::CmdLine::Util::Config::read_config(
          config_paths    => $r->{config_paths},
          config_filename => $self->config_filename,
          config_dirs     => $self->config_dirs,
          program_name    => $self->program_name,
      );
      die $res unless $res->[0] == 200;
      $r->{config} = $res->[2];
      $r->{read_config_files} = $res->[3]{'func.read_files'};
      $log->tracef("[pericmd] Read config files: %s",
                   $r->{'read_config_files'});
  }
  
  sub _parse_argv1 {
      my ($self, $r) = @_;
  
      {
  
          require Getopt::Long;
          my $old_go_conf = Getopt::Long::Configure(
              'pass_through', 'permute', 'no_ignore_case', 'no_auto_abbrev');
          my @go_spec;
          my $co = $self->common_opts // {};
          for my $k (keys %$co) {
              push @go_spec, $co->{$k}{getopt} => sub {
                  my ($go, $val) = @_;
                  $co->{$k}{handler}->($go, $val, $r);
              };
          }
          Getopt::Long::GetOptions(@go_spec);
          Getopt::Long::Configure($old_go_conf);
      }
  
      {
          my $scn = $r->{subcommand_name};
          my $scn_from = $r->{subcommand_name_from};
          if (!defined($scn) && defined($self->{default_subcommand})) {
              if ($self->get_subcommand_from_arg == 1) {
                  $scn = $self->{default_subcommand};
                  $scn_from = 'default_subcommand';
              } elsif ($self->get_subcommand_from_arg == 2 && !@ARGV) {
                  $scn = $self->{default_subcommand};
                  $scn_from = 'default_subcommand';
              }
          }
          if (!defined($scn) && $self->{subcommands} && @ARGV) {
              if ($ARGV[0] =~ /\A-/) {
                  if ($r->{in_completion}) {
                      $scn = shift @ARGV;
                      $scn_from = 'arg';
                  } else {
                      die [400, "Unknown option: $ARGV[0]"];
                  }
              } else {
                  $scn = shift @ARGV;
                  $scn_from = 'arg';
              }
          }
  
          my $scd;
          if (defined $scn) {
              $scd = $self->get_subcommand_data($scn);
              unless ($r->{in_completion}) {
                  die [500, "Unknown subcommand: $scn"] unless $scd;
              }
          } elsif (!$r->{action} && $self->{subcommands}) {
              $r->{action} = 'help';
              $r->{skip_parse_subcommand_argv} = 1;
          } else {
              $scn = '';
              $scd = {
                  url => $self->url,
                  summary => $self->summary,
                  description => $self->description,
                  pass_cmdline_object => $self->pass_cmdline_object,
                  tags => $self->tags,
              };
          }
          $r->{subcommand_name} = $scn;
          $r->{subcommand_name_from} = $scn_from;
          $r->{subcommand_data} = $scd;
      }
  
      $r->{dry_run} = 1 if $ENV{DRY_RUN};
  
      $r->{_parse_argv1_done} = 1;
  }
  
  sub _parse_argv2 {
      require Perinci::CmdLine::Util::Config;
  
      my ($self, $r) = @_;
  
      my %args;
  
      if ($r->{read_env}) {
          my $env_words = $self->_read_env($r);
          unshift @ARGV, @$env_words;
      }
  
      if ($r->{skip_parse_subcommand_argv}) {
          return [200, "OK (subcommand options parsing skipped)"];
      } else {
          my $scd = $r->{subcommand_data};
          my $meta = $self->get_meta($r, $scd->{url});
  
          if ($scd->{args}) {
              $args{$_} = $scd->{args}{$_} for keys %{ $scd->{args} };
          }
  
          if ($r->{read_config}) {
  
              $log->tracef("[pericmd] Running hook_before_read_config_file ...");
              $self->hook_before_read_config_file($r);
  
              $self->_read_config($r);
  
              $log->tracef("[pericmd] Running hook_after_read_config_file ...");
              $self->hook_after_read_config_file($r);
  
              my $res = Perinci::CmdLine::Util::Config::get_args_from_config(
                  r                  => $r,
                  config             => $r->{config},
                  args               => \%args,
                  subcommand_name    => $r->{subcommand_name},
                  config_profile     => $r->{config_profile},
                  common_opts        => $self->common_opts,
                  meta               => $meta,
                  meta_is_normalized => 1,
              );
              die $res unless $res->[0] == 200;
              $log->tracef("[pericmd] args after reading config files: %s",
                           \%args);
              my $found = $res->[3]{'func.found'};
              if (defined($r->{config_profile}) && !$found &&
                      defined($r->{read_config_files}) &&
                          @{$r->{read_config_files}} &&
                              !$r->{ignore_missing_config_profile_section}) {
                  return [412, "Profile '$r->{config_profile}' not found ".
                              "in configuration file"];
              }
  
          }
  
  
          my $copts = $self->common_opts;
          my %old_handlers;
          for (keys %$copts) {
              my $h = $copts->{$_}{handler};
              $copts->{$_}{handler} = sub {
                  my ($go, $val) = @_;
                  $h->($go, $val, $r);
              };
              $old_handlers{$_} = $h;
          }
  
          my $has_cmdline_src;
          for my $ak (keys %{$meta->{args} // {}}) {
              my $av = $meta->{args}{$ak};
              if ($av->{cmdline_src}) {
                  $has_cmdline_src = 1;
                  last;
              }
              if ($av->{stream}) {
                  unless ($av->{cmdline_src} &&
                              $av->{cmdline_src} =~
                                  /\A(stdin|file|stdin_or_files?)\z/) {
                      die "BUG: stream argument '$ak' needs to have cmdline_src ".
                          "set to stdin, file, stdin_or_file, or stdin_or_files";
                  }
              }
          }
  
          require Perinci::Sub::GetArgs::Argv;
          my $ga_res = Perinci::Sub::GetArgs::Argv::get_args_from_argv(
              argv                => \@ARGV,
              args                => \%args,
              meta                => $meta,
              meta_is_normalized  => 1,
              allow_extra_elems   => $has_cmdline_src ? 1:0,
              per_arg_json        => $self->{per_arg_json},
              per_arg_yaml        => $self->{per_arg_yaml},
              common_opts         => $copts,
              strict              => $r->{in_completion} ? 0:1,
              on_missing_required_args => sub {
                  my %a = @_;
  
                  my ($an, $aa, $as) = ($a{arg}, $a{args}, $a{spec});
                  my $src = $as->{cmdline_src};
                  if ($src && $as->{req}) {
                      return 1;
                  } else {
                      return 0;
                  }
              },
          );
  
          return $ga_res unless $ga_res->[0] == 200;
  
          require Perinci::Sub::CoerceArgs;
          my $coerce_res = Perinci::Sub::CoerceArgs::coerce_args(
              meta                => $meta,
              meta_is_normalized  => 1,
              args                => $ga_res->[2],
          );
  
          return $coerce_res unless $coerce_res->[0] == 200;
  
          for (keys %$copts) {
              $copts->{$_}{handler} = $old_handlers{$_};
          }
  
          return $ga_res;
      }
  }
  
  sub parse_argv {
      my ($self, $r) = @_;
  
      $log->tracef("[pericmd] Parsing \@ARGV: %s", \@ARGV);
  
  
      $self->_parse_argv1($r) unless $r->{_parse_argv1_done};
      $self->_parse_argv2($r);
  }
  
  sub __gen_iter {
      require Data::Sah::Util::Type;
  
      my ($fh, $sch, $argname) = @_;
      my $type = Data::Sah::Util::Type::get_type($sch);
  
      if (Data::Sah::Util::Type::is_simple($sch)) {
          return sub {
              local $/ = \(64*1024) if $type eq 'buf';
  
              state $eof;
              return undef if $eof;
              my $l = <$fh>;
              unless (defined $l) {
                  $eof++; return undef;
              }
              $l;
          };
      } else {
          require JSON;
          state $json = JSON->new->allow_nonref;
          my $i = -1;
          return sub {
              state $eof;
              return undef if $eof;
              $i++;
              my $l = <$fh>;
              unless (defined $l) {
                  $eof++; return undef;
              }
              eval { $l = $json->decode($l) };
              if ($@) {
                  die "Invalid JSON in stream argument '$argname' record #$i: $@";
              }
              $l;
          };
      }
  }
  
  sub parse_cmdline_src {
      my ($self, $r) = @_;
  
      my $action = $r->{action};
      my $meta   = $r->{meta};
  
      my $url = $r->{subcommand_data}{url} // $self->{url} // '';
      my $is_network = $url =~ m!^(https?|riap[^:]+):!;
  
      if ($action eq 'call') {
          my $args_p = $meta->{args} // {};
          my $stdin_seen;
          for my $an (sort {
              my $csa  = $args_p->{$a}{cmdline_src};
              my $csb  = $args_p->{$b}{cmdline_src};
              my $posa = $args_p->{$a}{pos} // 9999;
              my $posb = $args_p->{$b}{pos} // 9999;
  
              (
                  !$csa || !$csb ? 0 :
                      $csa eq 'stdin_line' && $csb eq 'stdin_line' ? 0 :
                      $csa eq 'stdin_line' && $csb =~ /^(stdin|stdin_or_files?)/ ? -1 :
                      $csb eq 'stdin_line' && $csa =~ /^(stdin|stdin_or_files?)/ ? 1 : 0
              )
              ||
  
              ($posa <=> $posb)
  
              ||
              ($a cmp $b)
          } keys %$args_p) {
              my $as = $args_p->{$an};
              my $src = $as->{cmdline_src};
              my $type = $as->{schema}[0]
                  or die "BUG: No schema is defined for arg '$an'";
              my $do_stream = $as->{stream} && $url !~ /^https?:/;
              if ($src) {
                  die [531,
                       "Invalid 'cmdline_src' value for argument '$an': $src"]
                      unless $src =~ /\A(stdin|file|stdin_or_files?|stdin_line)\z/;
                  die [531,
                       "Sorry, argument '$an' is set cmdline_src=$src, but type ".
                           "is not str/buf/array, only those are supported now"]
                      unless $do_stream || $type =~ /\A(str|buf|array)\z/;
                  if ($src =~ /\A(stdin|stdin_or_files?)\z/) {
                      die [531, "Only one argument can be specified ".
                               "cmdline_src stdin/stdin_or_file/stdin_or_files"]
                          if $stdin_seen++;
                  }
                  my $is_ary = $type eq 'array';
                  if ($src eq 'stdin_line' && !exists($r->{args}{$an})) {
                      require Perinci::Object;
                      require Term::ReadKey;
                      my $prompt = Perinci::Object::rimeta($as)->langprop('cmdline_prompt') //
                          sprintf($self->default_prompt_template, $an);
                      print $prompt;
                      my $iactive = (-t STDOUT);
                      Term::ReadKey::ReadMode('noecho')
                            if $iactive && $as->{is_password};
                      chomp($r->{args}{$an} = <STDIN>);
                      do { print "\n"; Term::ReadKey::ReadMode(0) }
                          if $iactive && $as->{is_password};
                      $r->{args}{"-cmdline_src_$an"} = 'stdin_line';
                  } elsif ($src eq 'stdin' || $src eq 'file' &&
                          ($r->{args}{$an}//"") eq '-') {
                      die [400, "Argument $an must be set to '-' which means ".
                               "from stdin"]
                          if defined($r->{args}{$an}) &&
                              $r->{args}{$an} ne '-';
                      $r->{args}{$an} = $do_stream ?
                          __gen_iter(\*STDIN, $as->{schema}, $an) :
                              $is_ary ? [<STDIN>] :
                                  do {local $/; ~~<STDIN>};
                      $r->{args}{"-cmdline_src_$an"} = 'stdin';
                  } elsif ($src eq 'stdin_or_file' || $src eq 'stdin_or_files') {
                      local @ARGV = @ARGV;
                      unshift @ARGV, $r->{args}{$an}
                          if defined $r->{args}{$an};
  
                      splice @ARGV, 1
                          if @ARGV > 1 && $src eq 'stdin_or_file';
  
  
                      for (@ARGV) {
                          next if $_ eq '-';
                          die [500, "Can't read file '$_': $!"] if !(-r $_);
                      }
  
                      $r->{args}{"-cmdline_srcfilenames_$an"} = [@ARGV];
                      $r->{args}{$an} = $do_stream ?
                          __gen_iter(\*ARGV, $as->{schema}, $an) :
                              $is_ary ? [<>] :
                                  do {local $/; ~~<>};
                      $r->{args}{"-cmdline_src_$an"} = $src;
                  } elsif ($src eq 'file') {
                      unless (exists $r->{args}{$an}) {
                          if ($as->{req}) {
                              die [400,
                                   "Please specify filename for argument '$an'"];
                          } else {
                              next;
                          }
                      }
                      die [400, "Please specify filename for argument '$an'"]
                          unless defined $r->{args}{$an};
                      my $fh;
                      my $fname = $r->{args}{$an};
                      unless (open $fh, "<", $fname) {
                          die [500, "Can't open file '$fname' for argument '$an'".
                                   ": $!"];
                      }
                      $r->{args}{$an} = $do_stream ?
                          __gen_iter($fh, $as->{schema}, $an) :
                              $is_ary ? [<$fh>] :
                                  do { local $/; ~~<$fh> };
                      $r->{args}{"-cmdline_src_$an"} = 'file';
                      $r->{args}{"-cmdline_srcfilenames_$an"} = [$fname];
                  }
              }
  
              if ($self->riap_version == 1.2 && $is_network &&
                      defined($r->{args}{$an}) && $args_p->{$an}{schema} &&
                          $args_p->{$an}{schema}[0] eq 'buf' &&
                              !$r->{args}{"$an:base64"}) {
                  require MIME::Base64;
                  $r->{args}{"$an:base64"} =
                      MIME::Base64::encode_base64($r->{args}{$an}, "");
                  delete $r->{args}{$an};
              }
          } 
      }
  }
  
  sub select_output_handle {
      my ($self, $r) = @_;
  
      my $resmeta = $r->{res}[3] // {};
  
      my $handle;
      if ($resmeta->{"cmdline.page_result"}) {
          require File::Which;
          my $pager = $resmeta->{"cmdline.pager"} //
              $ENV{PAGER};
          unless (defined $pager) {
              $pager = "less -FRSX" if File::Which::which("less");
          }
          unless (defined $pager) {
              $pager = "more" if File::Which::which("more");
          }
          unless (defined $pager) {
              die [500, "Can't determine PAGER"];
          }
          last unless $pager; 
          open $handle, "| $pager";
      }
      $handle //= \*STDOUT;
      $r->{output_handle} = $handle;
  }
  
  sub display_result {
      require Data::Sah::Util::Type;
  
      my ($self, $r) = @_;
  
      my $meta = $r->{meta};
      my $res = $r->{res};
      my $fres = $r->{fres};
      my $resmeta = $res->[3] // {};
  
      my $handle = $r->{output_handle};
  
      my $sch = $meta->{result}{schema};
      my $type = Data::Sah::Util::Type::get_type($sch) // '';
  
      if ($resmeta->{stream} // $meta->{result}{stream}) {
          my $x = $res->[2];
          if (ref($x) eq 'CODE') {
              if (Data::Sah::Util::Type::is_simple($sch)) {
                  while (defined(my $l = $x->())) {
                      print $l;
                      print "\n" unless $type eq 'buf';
                  }
              } else {
                  require JSON;
                  state $json = JSON->new->allow_nonref;
                  while (defined(my $rec = $x->())) {
                      print $json->encode($rec), "\n";
                  }
              }
          } else {
              die [500, "Invalid stream in result (not a coderef)"];
          }
      } else {
          print $handle $fres;
      }
  }
  
  sub run {
      my ($self) = @_;
      $log->tracef("[pericmd] -> run(), \@ARGV=%s", \@ARGV);
  
      my $co = $self->common_opts;
  
      my $r = {
          orig_argv   => [@ARGV],
          common_opts => $co,
      };
  
      if ($self->_detect_completion($r)) {
          $r->{res} = $self->do_completion($r);
          goto FORMAT;
      }
  
      $r->{naked_res} = $co->{naked_res}{default} if $co->{naked_res};
      $r->{format}    = $co->{format}{default} if $co->{format};
  
      if ($self->read_config) {
          $r->{read_config} = 1;
      }
  
      if ($self->read_env) {
          $r->{read_env} = 1;
      }
  
      eval {
          $log->tracef("[pericmd] Running hook_before_run ...");
          $self->hook_before_run($r);
  
          my $parse_res = $self->parse_argv($r);
          if ($parse_res->[0] == 501) {
              $r->{send_argv} = 1;
          } elsif ($parse_res->[0] != 200) {
              die $parse_res;
          }
          $r->{parse_argv_res} = $parse_res;
          $r->{args} = $parse_res->[2] // {};
  
          $r->{action} //= 'call';
  
          $log->tracef("[pericmd] Running hook_after_parse_argv ...");
          $self->hook_after_parse_argv($r);
  
          $self->parse_cmdline_src($r);
  
  
          my $missing = $parse_res->[3]{"func.missing_args"};
          die [400, "Missing required argument(s): ".join(", ", @$missing)]
              if $missing && @$missing;
  
          my $scd = $r->{subcommand_data};
          if ($scd->{pass_cmdline_object} // $self->pass_cmdline_object) {
              $r->{args}{-cmdline} = $self;
              $r->{args}{-cmdline_r} = $r;
          }
  
          $log->tracef("[pericmd] Running hook_before_action ...");
          $self->hook_before_action($r);
  
          my $meth = "action_$r->{action}";
          die [500, "Unknown action $r->{action}"] unless $self->can($meth);
          $log->tracef("[pericmd] Running %s() ...", $meth);
          $r->{res} = $self->$meth($r);
  
          $log->tracef("[pericmd] Running hook_after_action ...");
          $self->hook_after_action($r);
      };
      my $err = $@;
      if ($err || !$r->{res}) {
          if ($err) {
              $err =~ s/\n+$//;
              $err = [500, "Died: $err"] unless ref($err) eq 'ARRAY';
              $r->{res} = $err;
          } else {
              $r->{res} = [500, "Bug: no response produced"];
          }
      } elsif (ref($r->{res}) ne 'ARRAY') {
          $log->tracef("[pericmd] res=%s", $r->{res}); 
          $r->{res} = [500, "Bug in program: result not an array"];
      } elsif (!$r->{res}[0] || $r->{res}[0] < 200 || $r->{res}[0] > 555) {
          $log->tracef("[pericmd] res=%s", $r->{res}); 
          $r->{res} = [500, "Bug in program: invalid result status, ".
                           "must be 200 <= x <= 555"];
      }
      $r->{format} //= $r->{res}[3]{'cmdline.default_format'};
      $r->{format} //= $r->{meta}{'cmdline.default_format'};
      my $restore_orig_result;
      my $orig_result;
      if (exists $r->{res}[3]{'cmdline.result'}) {
          $restore_orig_result = 1;
          $orig_result = $r->{res}[2];
          $r->{res}[2] = $r->{res}[3]{'cmdline.result'};
      }
    FORMAT:
      if ($r->{res}[3]{'cmdline.skip_format'}) {
          $r->{fres} = $r->{res}[2];
      } elsif ($r->{res}[3]{stream} // $r->{meta}{result}{stream}) {
      } else {
          $log->tracef("[pericmd] Running hook_format_result ...");
          $r->{fres} = $self->hook_format_result($r) // '';
      }
      $self->select_output_handle($r);
      $log->tracef("[pericmd] Running hook_display_result ...");
      $self->hook_display_result($r);
      $log->tracef("[pericmd] Running hook_after_run ...");
      $self->hook_after_run($r);
  
      if ($restore_orig_result) {
          $r->{res}[2] = $orig_result;
      }
  
      my $exitcode;
      if ($r->{res}[3] && defined($r->{res}[3]{'cmdline.exit_code'})) {
          $exitcode = $r->{res}[3]{'cmdline.exit_code'};
      } else {
          $exitcode = $self->status2exitcode($r->{res}[0]);
      }
      if ($self->exit) {
          $log->tracef("[pericmd] exit(%s)", $exitcode);
          exit $exitcode;
      } else {
          $log->tracef("[pericmd] <- run(), exitcode=%s", $exitcode);
          $r->{res}[3]{'x.perinci.cmdline.base.exit_code'} = $exitcode;
          return $r->{res};
      }
  }
  
  1;
  
  __END__
  
PERINCI_CMDLINE_BASE

$fatpacked{"Perinci/CmdLine/Help.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PERINCI_CMDLINE_HELP';
  package Perinci::CmdLine::Help;
  
  our $DATE = '2015-04-11'; 
  our $VERSION = '0.06'; 
  
  use 5.010001;
  use strict;
  use warnings;
  
  require Exporter;
  our @ISA = qw(Exporter);
  our @EXPORT_OK = qw(gen_help);
  
  our %SPEC;
  
  $SPEC{gen_help} = {
      v => 1.1,
      summary => 'Generate help message for Perinci::CmdLine-based app',
      args => {
          program_name => {
              schema => 'str*',
              req => 1,
          },
          program_summary => {
              schema => 'str*',
          },
          subcommands => {
              schema => 'hash',
          },
          meta => {
              summary => 'Function metadata, must be normalized',
              schema => 'hash*',
              req => 1,
          },
          common_opts => {
              schema => 'hash*',
              default => {},
          },
          per_arg_json => {
              schema => 'bool*',
          },
          per_arg_yaml => {
              schema => 'bool*',
          },
      },
  };
  sub gen_help {
      my %args = @_;
  
      my $meta = $args{meta};
      my $common_opts = $args{common_opts} // {};
  
      my @help;
  
      my $progname = $args{program_name};
      push @help, $progname;
      {
          my $sum = $args{program_summary} // $meta->{summary};
          last unless $sum;
          push @help, " - ", $sum, "\n";
      }
  
      my $clidocdata;
  
      push @help, "\nUsage:\n";
      {
          for (sort {
              ($common_opts->{$a}{order} // 99) <=>
                  ($common_opts->{$b}{order} // 99) ||
                      $a cmp $b
              } keys %$common_opts) {
              my $co = $common_opts->{$_};
              next unless $co->{usage};
              push @help, "  $progname $co->{usage}\n";
          }
  
          require Perinci::Sub::To::CLIDocData;
          my $res = Perinci::Sub::To::CLIDocData::gen_cli_doc_data_from_meta(
              meta => $meta, meta_is_normalized => 1,
              common_opts  => $common_opts,
              per_arg_json => $args{per_arg_json},
              per_arg_yaml => $args{per_arg_yaml},
          );
          die [500, "gen_cli_doc_data_from_meta failed: ".
                   "$res->[0] - $res->[1]"] unless $res->[0] == 200;
          $clidocdata = $res->[2];
          my $usage = $clidocdata->{usage_line};
          $usage =~ s/\[\[prog\]\]/$progname/;
          push @help, "  $usage\n";
      }
  
      {
          my $subcommands = $args{subcommands} or last;
          push @help, "\nSubcommands:\n";
          if (keys(%$subcommands) >= 12) {
              no warnings 'once';
              require Text::Wrap;
              local $Text::Wrap::columns = $ENV{COLUMNS} // 80;
              push @help, Text::Wrap::wrap(
                  "  ", "  ", join(", ", sort keys %$subcommands)), "\n";
          } else {
              for my $sc_name (sort keys %$subcommands) {
                  my $sc_spec = $subcommands->{$sc_name};
                  next unless $sc_spec->{show_in_help} //1;
                  push @help, "  $sc_name\n";
              }
          }
      }
  
      {
          last unless @{ $clidocdata->{examples} };
          push @help, "\nExamples:\n";
          my $i = 0;
          my $egs = $clidocdata->{examples};
          for my $eg (@$egs) {
              $i++;
              my $cmdline = $eg->{cmdline};
              $cmdline =~ s/\[\[prog\]\]/$progname/;
              push @help, "  $eg->{summary}:\n" if $eg->{summary};
              push @help, "  % $cmdline\n";
              push @help, "\n" if $eg->{summary} && $i < @$egs;
          }
      }
  
      {
          my $desc = $args{program_description} // $meta->{description};
          last unless $desc;
          $desc =~ s/\A\n+//;
          $desc =~ s/\n+\z//;
          push @help, "\n", $desc, "\n" if $desc =~ /\S/;
      }
  
      {
          require Data::Dmp;
  
          my $opts = $clidocdata->{opts};
          last unless keys %$opts;
  
          my %options_by_cat; 
          for (keys %$opts) {
              push @{ $options_by_cat{$opts->{$_}{category}} }, $_;
          }
  
          my $cats_spec = $clidocdata->{option_categories};
          for my $cat (sort {
              ($cats_spec->{$a}{order} // 50) <=> ($cats_spec->{$b}{order} // 50)
                  || $a cmp $b }
                           keys %options_by_cat) {
              my @opts = sort {length($b)<=>length($a)}
                  @{ $options_by_cat{$cat} };
              my $len = length($opts[0]);
              @opts = sort {
                  (my $a_without_dash = $a) =~ s/^-+//;
                  (my $b_without_dash = $b) =~ s/^-+//;
                  lc($a) cmp lc($b);
              } @opts;
              push @help, "\n$cat:\n";
              for my $opt (@opts) {
                  my $ospec = $opts->{$opt};
                  my $arg_spec = $ospec->{arg_spec};
                  my $is_bool = $arg_spec->{schema} &&
                      $arg_spec->{schema}[0] eq 'bool';
                  my $show_default = exists($ospec->{default}) &&
                      !$is_bool && !$ospec->{is_base64} &&
                          !$ospec->{is_json} && !$ospec->{is_yaml} &&
                              !$ospec->{is_alias};
  
                  my $add_sum = '';
                  if ($ospec->{is_base64}) {
                      $add_sum = " (base64-encoded)";
                  } elsif ($ospec->{is_json}) {
                      $add_sum = " (JSON-encoded)";
                  } elsif ($ospec->{is_yaml}) {
                      $add_sum = " (YAML-encoded)";
                  }
  
                  my $argv = '';
                  if (!$ospec->{main_opt} && defined($ospec->{pos})) {
                      if ($ospec->{greedy}) {
                          $argv = " (=arg[$ospec->{pos}-])";
                      } else {
                          $argv = " (=arg[$ospec->{pos}])";
                      }
                  }
  
                  my $cmdline_src = '';
                  if (!$ospec->{main_opt} && defined($arg_spec->{cmdline_src})) {
                      $cmdline_src = " (or from $arg_spec->{cmdline_src})";
                      $cmdline_src =~ s!_or_!/!g;
                  }
  
                  push @help, sprintf(
                      "  %-${len}s  %s%s%s%s%s\n",
                      $opt,
                      $ospec->{summary}//'',
                      $add_sum,
                      $argv,
                      $cmdline_src,
                      ($show_default && defined($ospec->{default}) ?
                           " [".Data::Dmp::dmp($ospec->{default})."]":""),
  
                  );
              }
          }
      }
  
      [200, "OK", join("", @help)];
  }
  
  1;
  
  __END__
  
PERINCI_CMDLINE_HELP

$fatpacked{"Perinci/CmdLine/Lite.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PERINCI_CMDLINE_LITE';
  package Perinci::CmdLine::Lite;
  
  our $DATE = '2015-04-12'; 
  our $VERSION = '1.10'; 
  
  use 5.010001;
  use Log::Any::IfLOG '$log';
  
  use List::Util qw(first);
  use Mo qw(build default);
  extends 'Perinci::CmdLine::Base';
  
  
  has default_prompt_template => (
      is=>'rw',
      default => 'Enter %s: ',
  );
  has log => (
      is=>'rw',
      default => sub {
          if (defined $ENV{LOG}) {
              return $ENV{LOG};
          } elsif ($ENV{LOG_LEVEL} && $ENV{LOG_LEVEL} =~ /^(off|none)$/) {
              return 0;
          } elsif ($ENV{LOG_LEVEL} || $ENV{TRACE} || $ENV{DEBUG} ||
                       $ENV{VERBOSE} || $ENV{QUIET}) {
              return 0;
          }
          0;
      },
  );
  has log_level => (
      is=>'rw',
      default => sub {
          if ($ENV{LOG_LEVEL}) {
              return $ENV{LOG_LEVEL};
          } elsif ($ENV{TRACE}) {
              return 'trace';
          } elsif ($ENV{DEBUG}) {
              return 'debug';
          } elsif ($ENV{VERBOSE}) {
              return 'info';
          } elsif ($ENV{QUIET}) {
              return 'error';
          }
          'warning';
      },
  );
  
  my $formats = [qw/text text-simple text-pretty json json-pretty/];
  
  sub BUILD {
      my ($self, $args) = @_;
  
      if (!$self->{riap_client}) {
          require Perinci::Access::Lite;
          my %rcargs = (
              riap_version => $self->{riap_version} // 1.1,
              %{ $self->{riap_client_args} // {} },
          );
          $self->{riap_client} = Perinci::Access::Lite->new(%rcargs);
      }
  
      if (!$self->{actions}) {
          $self->{actions} = {
              call => {},
              version => {},
              subcommands => {},
              help => {},
          };
      }
  
      my $_t = sub {
          no warnings;
          my $co_name = shift;
          my $href = $Perinci::CmdLine::Base::copts{$co_name};
          %$href;
      };
  
      if (!$self->{common_opts}) {
          my $copts = {};
  
          $copts->{version}   = { $_t->('version'), };
          $copts->{help}      = { $_t->('help'), };
          $copts->{format}    = {
              $_t->('format'),
              schema => ['str*' => in => $formats],
          };
          $copts->{json}      = { $_t->('json'), };
          $copts->{naked_res} = { $_t->('naked_res'), };
          if ($self->subcommands) {
              $copts->{subcommands} = { $_t->('subcommands'), };
          }
          if ($self->default_subcommand) {
              $copts->{cmd} = { $_t->('cmd') };
          }
          if ($self->read_config) {
              $copts->{config_path}    = { $_t->('config_path') };
              $copts->{no_config}      = { $_t->('no_config') };
              $copts->{config_profile} = { $_t->('config_profile') };
          }
          if ($self->read_env) {
              $copts->{no_env} = { $_t->('no_env') };
          }
          if ($self->log) {
              $copts->{log_level} = { $_t->('log_level'), };
              $copts->{trace}     = { $_t->('trace'), };
              $copts->{debug}     = { $_t->('debug'), };
              $copts->{verbose}   = { $_t->('verbose'), };
              $copts->{quiet}     = { $_t->('quiet'), };
          }
          $self->{common_opts} = $copts;
      }
  
      $self->{formats} //= $formats;
  
      $self->{per_arg_json} //= 1;
  }
  
  my $setup_progress;
  sub _setup_progress_output {
      my $self = shift;
  
      return unless $ENV{PROGRESS} // (-t STDOUT);
  
      require Progress::Any::Output;
      Progress::Any::Output->set("TermProgressBarColor");
      $setup_progress = 1;
  }
  
  sub _unsetup_progress_output {
      my $self = shift;
  
      return unless $setup_progress;
      my $out = $Progress::Any::outputs{''}[0];
      $out->cleanup if $out->can("cleanup");
      $setup_progress = 0;
  }
  
  sub hook_after_parse_argv {
      my ($self, $r) = @_;
  
      my $ass  = $r->{meta}{args} // {};
      my $args = $r->{args};
      for (keys %$ass) {
          next if exists $args->{$_};
          my $as = $ass->{$_};
          if (exists $as->{default}) {
              $args->{$_} = $as->{default};
          } elsif ($as->{schema} && exists $as->{schema}[1]{default}) {
              $args->{$_} = $as->{schema}[1]{default};
          }
      }
  
      if ($self->log) {
          require Log::Any::Adapter;
          Log::Any::Adapter->set(
              'ScreenColoredLevel',
              min_level => $r->{log_level} // $self->log_level,
              formatter => sub { $self->program_name . ": $_[1]" },
          );
      }
  }
  
  sub hook_before_action {
      my ($self, $r) = @_;
  
    VALIDATE_ARGS:
      {
          last unless $r->{action} eq 'call';
  
          my $meta = $r->{meta};
  
          last if $meta->{'x.perinci.sub.wrapper.logs'} &&
              (grep { $_->{validate_args} }
               @{ $meta->{'x.perinci.sub.wrapper.logs'} });
  
          require Data::Sah;
  
          my %validators; 
  
          for my $arg (sort keys %{ $meta->{args} // {} }) {
              next unless exists($r->{args}{$arg});
  
              next if $meta->{args}{$arg}{stream};
  
              my $schema = $meta->{args}{$arg}{schema};
              next unless $schema;
              unless ($validators{"$schema"}) {
                  my $v = Data::Sah::gen_validator($schema, {
                      return_type => 'str',
                      schema_is_normalized => 1,
                  });
                  $validators{"$schema"} = $v;
              }
              my $res = $validators{"$schema"}->($r->{args}{$arg});
              if ($res) {
                  die [400, "Argument '$arg' fails validation: $res"];
              }
          }
      }
  }
  
  sub __json {
      state $json = do {
          require JSON;
          JSON->new->canonical(1)->allow_nonref;
      };
      $json;
  }
  
  sub __gen_table {
      my ($data, $header_row, $resmeta, $is_pretty) = @_;
  
      $resmeta //= {};
  
      my @columns;
      if ($header_row) {
          @columns = @{$data->[0]};
      } else {
          @columns = map {"col$_"} 0..@{$data->[0]}-1;
      }
  
      my $column_orders; 
    SET_COLUMN_ORDERS: {
  
          my $tcos;
          if ($ENV{FORMAT_PRETTY_TABLE_COLUMN_ORDERS}) {
              $tcos = __json->decode($ENV{FORMAT_PRETTY_TABLE_COLUMN_ORDERS});
          } elsif (my $rfos = ($resmeta->{'cmdline.format_options'} //
                                   $resmeta->{format_options})) {
              my $rfo = $rfos->{'text-pretty'} // $rfos->{text} // $rfos->{any};
              if ($rfo) {
                  $tcos = $rfo->{table_column_orders};
              }
          }
          if ($tcos) {
            COLS:
              for my $cols (@$tcos) {
                  for my $col (@$cols) {
                      next COLS unless first {$_ eq $col} @columns;
                  }
                  $column_orders = $cols;
                  last SET_COLUMN_ORDERS;
              }
          }
  
          $column_orders = $resmeta->{'table.fields'};
      }
  
      if ($column_orders) {
          require List::MoreUtils;
  
          my @map0 = sort {
              my $idx_a = List::MoreUtils::firstidx(sub {$_ eq $a->[1]},
                                                    @$column_orders) // 9999;
              my $idx_b = List::MoreUtils::firstidx(sub {$_ eq $b->[1]},
                                                    @$column_orders) // 9999;
              $idx_a <=> $idx_b || $a->[1] cmp $b->[1];
          } map {[$_, $columns[$_]]} 0..@columns-1;
          my @map;
          for (0..@map0-1) {
              $map[$_] = $map0[$_][0];
          }
          my $newdata = [];
          for my $row (@$data) {
              my @newrow;
              for (0..@map-1) { $newrow[$_] = $row->[$map[$_]] }
              push @$newdata, \@newrow;
          }
          $data = $newdata;
      }
  
      if ($is_pretty) {
          require Text::Table::Tiny;
          Text::Table::Tiny::table(rows=>$data, header_row=>$header_row) . "\n";
      } else {
          no warnings 'uninitialized';
          shift @$data if $header_row;
          join("", map {join("\t", @$_)."\n"} @$data);
      }
  }
  
  sub hook_format_result {
      my ($self, $r) = @_;
  
      my $res    = $r->{res};
      my $format = $r->{format} // 'text';
      my $meta   = $r->{meta};
  
      if ($format =~ /\Atext(-simple|-pretty)?\z/) {
          my $is_pretty = $format eq 'text-pretty' ? 1 :
              $format eq 'text-simple' ? 0 : (-t STDOUT);
          no warnings 'uninitialized';
          if ($res->[0] !~ /^(2|304)/) {
              my $fres = "ERROR $res->[0]: $res->[1]";
              if (my $prev = $res->[3]{prev}) {
                  $fres .= " ($prev->[0]: $prev->[1])";
              }
              return "$fres\n";
          } elsif ($res->[3] && $res->[3]{"x.hint.result_binary"}) {
              return $res->[2];
          } else {
              require Data::Check::Structure;
              my $data = $res->[2];
              my $max = 5;
              if (!ref($data)) {
                  $data //= "";
                  $data .= "\n" unless !length($data) || $data =~ /\n\z/;
                  return $data;
              } elsif (ref($data) eq 'ARRAY' && !@$data) {
                  return "";
              } elsif (Data::Check::Structure::is_aos($data, {max=>$max})) {
                  return join("", map {"$_\n"} @$data);
              } elsif (Data::Check::Structure::is_aoaos($data, {max=>$max})) {
                  return __gen_table($data, 0, $res->[3], $is_pretty);
              } elsif (Data::Check::Structure::is_hos($data, {max=>$max})) {
                  $data = [map {[$_, $data->{$_}]} sort keys %$data];
                  unshift @$data, ["key", "value"];
                  return __gen_table($data, 1, $res->[3], $is_pretty);
              } elsif (Data::Check::Structure::is_aohos($data, {max=>$max})) {
                  my %fieldnames;
                  for my $row (@$data) {
                      $fieldnames{$_}++ for keys %$row;
                  }
                  my @fieldnames = sort keys %fieldnames;
                  my $newdata = [];
                  for my $row (@$data) {
                      push @$newdata, [map {$row->{$_}} @fieldnames];
                  }
                  unshift @$newdata, \@fieldnames;
                  return __gen_table($newdata, 1, $res->[3], $is_pretty);
              } else {
                  $format = 'json-pretty';
              }
          }
      }
  
      $res = $res->[2] if $r->{naked_res};
  
      warn "Unknown format '$format', fallback to json-pretty"
          unless $format =~ /\Ajson(-pretty)?\z/;
      $self->cleanser->clean_in_place($res);
      if ($format eq 'json') {
          return __json->encode($res) . "\n";
      } else {
          return __json->canonical(1)->pretty->encode($res);
      }
  }
  
  sub hook_format_row {
      my ($self, $r, $row) = @_;
  
      if (ref($row) eq 'ARRAY') {
          return join("\t", @$row) . "\n";
      } else {
          return ($row // "") . "\n";
      }
  }
  
  sub hook_display_result {
      my ($self, $r) = @_;
      $self->display_result($r);
  }
  
  sub hook_after_run {
      my ($self, $r) = @_;
      $self->_unsetup_progress_output;
  }
  
  sub hook_after_get_meta {
      my ($self, $r) = @_;
  
      require Perinci::Object;
      if (Perinci::Object::risub($r->{meta})->can_dry_run) {
          $self->common_opts->{dry_run} = {
              getopt  => 'dry-run',
              summary => "Run in simulation mode (also via DRY_RUN=1)",
              handler => sub {
                  my ($go, $val, $r) = @_;
                  $log->debugf("[pericmd] Dry-run mode is activated");
                  $r->{dry_run} = 1;
              },
          };
      }
  
      if ($r->{meta}{deps}) {
          require Perinci::Sub::DepChecker;
          my $res = Perinci::Sub::DepChecker::check_deps($r->{meta}{deps});
          if ($res) {
              die [412, "Dependency failed: $res"];
          }
      }
  }
  
  sub action_subcommands {
      my ($self, $r) = @_;
  
      if (!$self->subcommands) {
          say "There are no subcommands.";
          return 0;
      }
  
      say "Available subcommands:";
      my $scs = $self->list_subcommands;
      my $longest = 6;
      for (keys %$scs) { my $l = length; $longest = $l if $l > $longest }
      [200, "OK",
       join("",
            (map { sprintf("  %-${longest}s  %s\n",$_,$scs->{$_}{summary}//"") }
                 sort keys %$scs),
        )];
  }
  
  sub action_version {
      my ($self, $r) = @_;
  
      my $meta = $r->{meta} = $self->get_meta($r, $self->url);
  
      [200, "OK",
       join("",
            $self->get_program_and_subcommand_name($r),
            " version ", ($meta->{entity_v} // "?"),
            ($meta->{entity_date} ? " ($meta->{entity_date})" : ''),
            "\n",
            "  ", __PACKAGE__,
            " version ", ($Perinci::CmdLine::Lite::VERSION // "?"),
            ($Perinci::CmdLine::Lite::DATE ?
                 " ($Perinci::CmdLine::Lite::DATE)":''),
        )];
  }
  
  sub action_help {
      require Perinci::CmdLine::Help;
  
      my ($self, $r) = @_;
  
      my @help;
      my $scn    = $r->{subcommand_name};
      my $scd    = $r->{subcommand_data};
  
      my $common_opts = { %{$self->common_opts} };
      my $has_sc_no_sc = $self->subcommands && !length($r->{subcommand_name});
      delete $common_opts->{subcommands} if $self->subcommands && !$has_sc_no_sc;
  
      my $meta = $self->get_meta($r, $scd->{url} // $self->{url});
  
      my $res = Perinci::CmdLine::Help::gen_help(
          program_name => $self->get_program_and_subcommand_name($r),
          program_summary => ($scd ? $scd->{summary}:undef ) // $meta->{summary},
          program_description => $scd ? $scd->{description} : undef,
          meta => $meta,
          subcommands => $has_sc_no_sc ? $self->list_subcommands : undef,
          common_opts => $common_opts,
          per_arg_json => $self->per_arg_json,
          per_arg_yaml => $self->per_arg_yaml,
      );
  
      $res->[3]{"cmdline.skip_format"} = 1;
      $res;
  }
  
  sub action_call {
      my ($self, $r) = @_;
  
      my %extra;
      if ($r->{send_argv}) {
          $log->tracef("[pericmd] Sending argv to server: %s", $extra{argv});
          $extra{argv} = $r->{orig_argv};
      } else {
          my %extra_args;
          $extra_args{-dry_run} = 1 if $r->{dry_run};
          $extra{args} = {%extra_args, %{$r->{args}}};
      }
  
      $extra{stream_arg} = 1 if $r->{stream_arg};
  
      my $url = $r->{subcommand_data}{url};
  
      $log->tracef("[pericmd] Riap request: action=call, url=%s", $url);
  
  
      if ($r->{meta}{features}{progress}) {
          $self->_setup_progress_output;
      }
  
      $self->riap_client->request(
          call => $url, \%extra);
  }
  
  1;
  
  __END__
  
PERINCI_CMDLINE_LITE

$fatpacked{"Perinci/CmdLine/Util/Config.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PERINCI_CMDLINE_UTIL_CONFIG';
  package Perinci::CmdLine::Util::Config;
  
  our $DATE = '2015-04-12'; 
  our $VERSION = '1.10'; 
  
  use 5.010;
  use strict;
  use warnings;
  use Log::Any::IfLOG '$log';
  
  use PERLANCAR::File::HomeDir qw(get_my_home_dir);
  
  our %SPEC;
  
  $SPEC{get_default_config_dirs} = {
      v => 1.1,
      args => {},
  };
  sub get_default_config_dirs {
      my @dirs;
      local $PERLANCAR::File::HomeDir::DIE_ON_FAILURE = 1;
      my $home = get_my_home_dir();
      if ($^O eq 'MSWin32') {
          push @dirs, $home;
      } else {
          push @dirs, "$home/.config", $home, "/etc";
      }
      \@dirs;
  }
  
  $SPEC{read_config} = {
      v => 1.1,
      args => {
          config_paths => {},
          config_filenames => {},
          config_dirs => {},
          program_name => {},
      },
  };
  sub read_config {
      require Config::IOD::Reader;
  
      my %args = @_;
  
      my $config_dirs = $args{config_dirs} // get_default_config_dirs();
  
      my $paths;
      if ($args{config_paths}) {
          $paths = $args{config_paths};
      } else {
          my $name = $args{config_filename} //
              $args{program_name} . ".conf";
          for my $dir (@$config_dirs) {
              my $path = "$dir/" . $name;
              push @$paths, $path if -e $path;
          }
      }
  
      my $reader = Config::IOD::Reader->new;
      my %res;
      my @read;
      for my $path (@$paths) {
          my $hoh = $reader->read_file($path);
          push @read, $path;
          for my $section (keys %$hoh) {
              my $hash = $hoh->{$section};
              for (keys %$hash) {
                  $res{$section}{$_} = $hash->{$_};
              }
          }
      }
      [200, "OK", \%res, {'func.read_files' => \@read}];
  }
  
  $SPEC{get_args_from_config} = {
      v => 1.1,
      args => {
          r => {},
          config => {},
          args => {},
          subcommand_name => {},
          config_profile => {},
          common_opts => {},
          meta => {},
          meta_is_normalized => {},
      },
  };
  sub get_args_from_config {
      my %fargs = @_;
  
      my $r       = $fargs{r};
      my $conf    = $fargs{config};
      my $scn     = $fargs{subcommand_name} // '';
      my $profile = $fargs{config_profile};
      my $args    = $fargs{args} // {};
      my $copts   = $fargs{common_opts};
      my $meta    = $fargs{meta};
      my $found;
  
      unless ($fargs{meta_is_normalized}) {
          require Perinci::Sub::Normalize;
          $meta = Perinci::Sub::Normalize::normalize_function_metadata($meta);
      }
  
      my @sections = sort {
          ($a eq 'GLOBAL' ? 0:1) <=> ($b eq 'GLOBAL' ? 0:1) ||
              $a cmp $b
          } keys %$conf;
  
      my %seen_profiles; 
      for my $section (@sections) {
          my ($sect_scn, $sect_profile);
          if ($section =~ /\Aprofile=(.*)\z/) {
              $sect_scn = 'GLOBAL';
              $sect_profile = $1;
          } elsif ($section =~ /\A\S+\z/) {
              $sect_scn = $section;
          } elsif ($section =~ /\A(\S+)\s+profile=(.*)\z/) {
              $sect_scn = $1;
              $sect_profile = $2;
          } else {
              die [412, "Error in config file: invalid section name ".
                       "'$section', please use subcommand name + optional ".
                           "' profile=PROFILE' only"];
          }
          $seen_profiles{$sect_profile}++ if defined $sect_profile;
          if (length $scn) {
              next if $sect_scn ne 'GLOBAL' && $sect_scn ne $scn;
          } else {
              next if $sect_scn ne 'GLOBAL';
          }
          if (defined $profile) {
              next if defined($sect_profile) && $sect_profile ne $profile;
              $found++ if defined($sect_profile) && $sect_profile eq $profile;
          } else {
              next if defined($sect_profile);
          }
  
          my $as = $meta->{args} // {};
          for my $k (keys %{ $conf->{$section} }) {
              my $v = $conf->{$section}{$k};
              if ($copts->{$k} && $copts->{$k}{is_settable_via_config}) {
                  my $sch = $copts->{$k}{schema};
                  if ($sch) {
                      require Data::Sah::Normalize;
                      $sch = Data::Sah::Normalize::normalize_schema($sch);
                      if (ref($v) ne 'ARRAY' && $sch->[0] eq 'array') {
                          $v = [$v];
                      }
                  }
                  $copts->{$k}{handler}->(undef, $v, $r);
              } else {
                  $k =~ s/\.arg\z//;
  
                  if (ref($v) ne 'ARRAY' && $as->{$k} && $as->{$k}{schema} &&
                          $as->{$k}{schema}[0] eq 'array') {
                      $v = [$v];
                  }
                  $args->{$k} = $v;
              }
          }
      }
      $log->tracef("[pericmd] Seen config profiles: %s",
                   [sort keys %seen_profiles]);
  
      [200, "OK", $args, {'func.found'=>$found}];
  }
  
  1;
  
  __END__
  
PERINCI_CMDLINE_UTIL_CONFIG

$fatpacked{"Perinci/CmdLine/pause.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PERINCI_CMDLINE_PAUSE';
  package Perinci::CmdLine::pause;
  
  our $DATE = '2015-04-15'; 
  our $VERSION = '0.25'; 
  
  use 5.010;
  use strict;
  use warnings;
  use Log::Any::IfLOG qw($log);
  
  use parent qw(Perinci::CmdLine::Lite);
  
  use PERLANCAR::File::HomeDir qw(get_my_home_dir);
  
  sub hook_after_read_config_file {
      my ($self, $r) = @_;
  
      return unless $self->read_config;
      return if $r->{read_config_files} && @{$r->{read_config_files}};
  
      my $path = get_my_home_dir() . "/.pause";
      return unless -f $path;
  
      open my($fh), "<", $path or die [500, "Can't read $path: $!"];
      $log->tracef("[pericmd-pause] Reading %s ...", $path);
      $r->{read_config_files} = [$path];
      while (<$fh>) {
          if (/^user\s+(.+)/) { $r->{config}{GLOBAL}{username} = $1 }
          elsif (/^password\s+(.+)/) { $r->{config}{GLOBAL}{password} = $1 }
      }
  }
  
  1;
  
  __END__
  
PERINCI_CMDLINE_PAUSE

$fatpacked{"Perinci/Object.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PERINCI_OBJECT';
  package Perinci::Object;
  
  our $DATE = '2014-12-11'; 
  our $VERSION = '0.21'; 
  
  use 5.010001;
  use strict;
  use warnings;
  
  require Exporter;
  our @ISA    = qw(Exporter);
  our @EXPORT = qw(rimeta risub rivar ripkg envres envresmulti riresmeta);
  
  sub rimeta {
      require Perinci::Object::Metadata;
      Perinci::Object::Metadata->new(@_);
  }
  
  sub risub {
      require Perinci::Object::Function;
      Perinci::Object::Function->new(@_);
  }
  
  sub rivar {
      require Perinci::Object::Variable;
      Perinci::Object::Variable->new(@_);
  }
  
  sub ripkg {
      require Perinci::Object::Package;
      Perinci::Object::Package->new(@_);
  }
  
  sub envres {
      require Perinci::Object::EnvResult;
      Perinci::Object::EnvResult->new(@_);
  }
  
  sub envresmulti {
      require Perinci::Object::EnvResultMulti;
      Perinci::Object::EnvResultMulti->new(@_);
  }
  
  sub riresmeta {
      require Perinci::Object::ResMeta;
      Perinci::Object::ResMeta->new(@_);
  }
  
  1;
  
  __END__
  
PERINCI_OBJECT

$fatpacked{"Perinci/Object/Function.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PERINCI_OBJECT_FUNCTION';
  package Perinci::Object::Function;
  
  our $DATE = '2014-12-11'; 
  our $VERSION = '0.21'; 
  
  use 5.010;
  use strict;
  use warnings;
  
  use parent qw(Perinci::Object::Metadata);
  
  sub type { "function" }
  
  sub feature {
      my $self = shift;
      my $name = shift;
      if (@_) {
          die "1.0 can't set feature" if $self->v eq 1.0;
          my $value = shift;
          ${$self}->{features} //= {};
          my $old = ${$self}->{features}{$name};
          ${$self}->{features}{$name} = $value;
          return $old;
      } else {
          ${$self}->{features}{$name};
      }
  }
  
  sub features {
      my $self = shift;
      ${$self}->{features} // {};
  }
  
  sub can_dry_run {
      my $self = shift;
      my $ff = ${$self}->{features} // {};
      $ff->{dry_run} // $ff->{tx} && $ff->{tx}{v} == 2;
  }
  
  sub arg {
      my $self = shift;
      my $name = shift;
      if (@_) {
          die "1.0 can't set arg" if $self->v eq 1.0;
          my $value = shift;
          ${$self}->{args} //= {};
          my $old = ${$self}->{args}{$name};
          ${$self}->{args}{$name} = $value;
          return $old;
      } else {
          ${$self}->{args}{$name};
      }
  }
  
  1;
  
  __END__
  
PERINCI_OBJECT_FUNCTION

$fatpacked{"Perinci/Object/Metadata.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PERINCI_OBJECT_METADATA';
  package Perinci::Object::Metadata;
  
  our $DATE = '2014-12-11'; 
  our $VERSION = '0.21'; 
  
  use 5.010;
  use strict;
  use warnings;
  use String::Trim::More qw(trim_blank_lines);
  
  sub new {
      my ($class, $meta) = @_;
      $meta //= {};
      my $obj = \$meta;
      bless $obj, $class;
  }
  
  sub v {
      my $self = shift;
      ${$self}->{v} // 1.0;
  }
  
  sub type {
      die "BUG: type() must be subclassed";
  }
  
  sub as_struct {
      my $self = shift;
      ${$self};
  }
  
  sub langprop {
      my $self = shift;
      my $opts;
      if (ref($_[0]) eq 'HASH') {
          $opts = shift;
      } else {
          $opts = {};
      }
      my $prop = shift;
  
      my $deflang = ${$self}->{default_lang} // "en_US";
      my $olang   = $opts->{lang} || $ENV{LANGUAGE} || $ENV{LANG} || $deflang;
      $olang =~ s/\W.+//; 
      (my $olang2 = $olang) =~ s/\A([a-z]{2})_[A-Z]{2}\z/$1/; 
      my $mark    = $opts->{mark_different_lang} // 1;
  
      my @k;
      if ($olang eq $deflang) {
          @k = ([$olang, $prop, 0]);
      } else {
          @k = (
              [$olang, "$prop.alt.lang.$olang", 0],
              ([$olang2, "$prop.alt.lang.$olang2", 0]) x !!($olang2 ne $olang),
              [$deflang, $prop, $mark],
          );
      }
  
      my $v;
    GET:
      for my $k (@k) {
          $v = ${$self}->{$k->[1]};
          if (defined $v) {
              if ($k->[2]) {
                  my $has_nl = $v =~ s/\n\z//;
                  $v = "{$k->[0] $v}" . ($has_nl ? "\n" : "");
              }
              $v = trim_blank_lines($v);
              last GET;
          }
      }
  
      if (@_) {
          ${$self}->{$k[0][1]} = $_[0];
      }
  
      $v;
  }
  
  sub name {
      my $self = shift;
      my $opts;
      if (@_ && ref($_[0]) eq 'HASH') {
          $opts = shift;
      } else {
          $opts = {};
      }
      $self->langprop($opts, "name", @_);
  }
  
  sub caption {
      my $self = shift;
      my $opts;
      if (@_ && ref($_[0]) eq 'HASH') {
          $opts = shift;
      } else {
          $opts = {};
      }
      $self->langprop($opts, "caption", @_);
  }
  
  sub summary {
      my $self = shift;
      my $opts;
      if (@_ && ref($_[0]) eq 'HASH') {
          $opts = shift;
      } else {
          $opts = {};
      }
      $self->langprop($opts, "summary", @_);
  }
  
  sub description {
      my $self = shift;
      my $opts;
      if (@_ && ref($_[0]) eq 'HASH') {
          $opts = shift;
      } else {
          $opts = {};
      }
      $self->langprop($opts, "description", @_);
  }
  
  1;
  
  __END__
  
PERINCI_OBJECT_METADATA

$fatpacked{"Perinci/Sub/CoerceArgs.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PERINCI_SUB_COERCEARGS';
  package Perinci::Sub::CoerceArgs;
  
  our $DATE = '2015-03-30'; 
  our $VERSION = '0.01'; 
  
  use 5.010001;
  use strict;
  use warnings;
  
  use Exporter;
  our @ISA = qw(Exporter);
  our @EXPORT_OK = qw(
                         coerce_args
                 );
  
  our %SPEC;
  
  
  $SPEC{coerce_args} = {
      v           => 1.1,
      summary     => 'Coerce arguments',
      description => <<'_',
  
  This routine can be used when function arguments are retrieved from strings,
  like from command-line arguments in CLI application (see
  `Perinci::CmdLine::Lite` or `Perinci::CmdLine::Classic`) or from web form
  variables in web application (see `Borang`). For convenience, object or complex
  data structure can be converted from string (e.g. `DateTime` object from strings
  like `2015-03-27` or epoch integer). And filters can be applied to
  clean/preprocess the string (e.g. remove leading/trailing blanks) beforehand.
  
  _
      args => {
          meta => {
              summary => 'Rinci function metadata',
              schema  => 'hash*',
              req     => 1,
          },
          meta_is_normalized => {
              schema => 'bool*',
          },
          args => {
              summary => 'Reference to hash which store the arguments',
              schema  => 'hash*',
          },
      },
  };
  sub coerce_args {
      my %fargs = @_;
  
      my $meta = $fargs{meta} or return [400, "Please specify meta"];
      unless ($fargs{meta_is_normalized}) {
          require Perinci::Sub::Normalize;
          $meta = Perinci::Sub::Normalize::normalize_function_metadata($meta);
      }
      my $args = $fargs{args};
  
      for my $arg_name (keys %$args) {
          my $val = $args->{$arg_name};
          next unless defined($val) && !ref($val);
          my $arg_spec = $meta->{args}{$arg_name};
          next unless $arg_spec;
  
          if (my $filters = $arg_spec->{filters}) {
              for my $filter (@$filters) {
                  if (ref($filter) eq 'CODE') {
                      $val = $filter->($val);
                  } elsif ($filter eq 'trim') {
                      $val =~ s/\A\s+//s;
                      $val =~ s/\s+\z//s;
                  } elsif ($filter eq 'ltrim') {
                      $val =~ s/\s+\z//s;
                  } elsif ($filter eq 'rtrim') {
                      $val =~ s/\A\s+//s;
                  } else {
                      return [400, "Unknown filter '$filter' ".
                                  "for argument '$arg_name'"];
                  }
              }
              $args->{$arg_name} = $val if @$filters;
          }
  
          if (my $schema = $arg_spec->{schema}) {
              if ($schema->[0] eq 'obj') {
                  my $class = $schema->[1]{isa} // '';
                  if ($class eq 'DateTime') {
                      if ($val =~ /\A\d{8,}\z/) {
                          require DateTime;
                          $args->{$arg_name} = DateTime->from_epoch(
                              epoch => $val,
                              time_zone => $ENV{TZ} // "UTC",
                          );
                      } elsif ($val =~ m!\A
                                         (\d{4})[/-](\d{1,2})[/-](\d{1,2})
                                         (?:[ Tt](\d{1,2}):(\d{1,2}):(\d{1,2}))?
                                         \z!x) {
                          require DateTime;
                          $args->{$arg_name} = DateTime->new(
                              year => $1, month => $2, day => $3,
                              hour => $4 // 0,
                              minute => $4 // 0,
                              second => $4 // 0,
                              time_zone => $ENV{TZ} // "UTC",
                          );
                      } else {
                          return [400, "Can't coerce DateTime object " .
                                      "'$arg_name' from '$args->{$arg_name}'"];
                      }
                  } elsif ($class eq 'Time::Moment') {
                      if ($val =~ /\A\d{8,}\z/) {
                          require Time::Moment;
                          $args->{$arg_name} = Time::Moment->from_epoch($val);
                      } elsif ($val =~ m!\A
                                         (\d{4})[/-](\d{1,2})[/-](\d{1,2})
                                         (?:[ Tt](\d{1,2}):(\d{1,2}):(\d{1,2}))?
                                         \z!x) {
                          require Time::Moment;
                          $args->{$arg_name} = Time::Moment->new(
                              year => $1, month => $2, day => $3,
                              hour => $4 // 0,
                              minute => $4 // 0,
                              second => $4 // 0,
                          );
                      } else {
                          return [400, "Can't coerce Time::Moment object " .
                                      "'$arg_name' from '$args->{$arg_name}'"];
                      }
                  }
              }
          } 
      }
  
      [200, "OK", $args];
  }
  
  1;
  
  __END__
  
PERINCI_SUB_COERCEARGS

$fatpacked{"Perinci/Sub/Complete.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PERINCI_SUB_COMPLETE';
  package Perinci::Sub::Complete;
  
  our $DATE = '2015-04-09'; 
  our $VERSION = '0.78'; 
  
  use 5.010001;
  use strict;
  use warnings;
  use experimental 'smartmatch';
  use Log::Any::IfLOG '$log';
  
  use Complete;
  use Complete::Util qw(hashify_answer complete_array_elem combine_answers);
  use Perinci::Sub::Util qw(gen_modified_sub);
  
  require Exporter;
  our @ISA       = qw(Exporter);
  our @EXPORT_OK = qw(
                         complete_from_schema
                         complete_arg_val
                         complete_arg_elem
                         complete_cli_arg
                 );
  our %SPEC;
  
  $SPEC{':package'} = {
      v => 1.1,
      summary => 'Complete command-line argument using Rinci metadata',
  };
  
  my %common_args_riap = (
      riap_client => {
          summary => 'Optional, to perform complete_arg_val to the server',
          schema  => 'obj*',
          description => <<'_',
  
  When the argument spec in the Rinci metadata contains `completion` key, this
  means there is custom completion code for that argument. However, if retrieved
  from a remote server, sometimes the `completion` key no longer contains the code
  (it has been cleansed into a string). Moreover, the completion code needs to run
  on the server.
  
  If supplied this argument and te `riap_server_url` argument, the function will
  try to request to the server (via Riap request `complete_arg_val`). Otherwise,
  the function will just give up/decline completing.
  
  _
          },
      riap_server_url => {
          summary => 'Optional, to perform complete_arg_val to the server',
          schema  => 'str*',
          description => <<'_',
  
  See the `riap_client` argument.
  
  _
      },
      riap_uri => {
          summary => 'Optional, to perform complete_arg_val to the server',
          schema  => 'str*',
          description => <<'_',
  
  See the `riap_client` argument.
  
  _
      },
  );
  
  $SPEC{complete_from_schema} = {
      v => 1.1,
      summary => 'Complete a value from schema',
      description => <<'_',
  
  Employ some heuristics to complete a value from Sah schema. For example, if
  schema is `[str => in => [qw/new open resolved rejected/]]`, then we can
  complete from the `in` clause. Or for something like `[int => between => [1,
  20]]` we can complete using values from 1 to 20.
  
  _
      args => {
          schema => {
              summary => 'Must be normalized',
              req => 1,
          },
          word => {
              schema => [str => default => ''],
              req => 1,
          },
          ci => {
              schema => 'bool',
          },
      },
  };
  sub complete_from_schema {
      my %args = @_;
      my $sch  = $args{schema}; 
      my $word = $args{word} // "";
      my $ci   = $args{ci} // $Complete::OPT_CI;
  
      my $fres;
      $log->tracef("[comp][periscomp] entering complete_from_schema, word=<%s>, schema=%s", $word, $sch);
  
      my ($type, $cs) = @{$sch};
  
      my $static;
      my $words;
      eval {
          if ($cs->{is} && !ref($cs->{is})) {
              $log->tracef("[comp][periscomp] adding completion from 'is' clause");
              push @$words, $cs->{is};
              $static++;
              return; 
          }
          if ($cs->{in}) {
              $log->tracef("[comp][periscomp] adding completion from 'in' clause");
              push @$words, grep {!ref($_)} @{ $cs->{in} };
              $static++;
              return; 
          }
          if ($type eq 'any') {
              require Data::Sah::Normalize;
              if ($cs->{of} && @{ $cs->{of} }) {
                  $fres = combine_answers(
                      grep { defined } map {
                          complete_from_schema(
                              schema=>Data::Sah::Normalize::normalize_schema($_),
                              word => $word,
                              ci => $ci,
                          )
                      } @{ $cs->{of} }
                  );
                  goto RETURN_RES; 
              }
          }
          if ($type eq 'bool') {
              $log->tracef("[comp][periscomp] adding completion from possible values of bool");
              push @$words, 0, 1;
              $static++;
              return; 
          }
          if ($type eq 'int') {
              my $limit = 100;
              if ($cs->{between} &&
                      $cs->{between}[0] - $cs->{between}[0] <= $limit) {
                  $log->tracef("[comp][periscomp] adding completion from 'between' clause");
                  push @$words, $cs->{between}[0] .. $cs->{between}[1];
                  $static++;
              } elsif ($cs->{xbetween} &&
                           $cs->{xbetween}[0] - $cs->{xbetween}[0] <= $limit) {
                  $log->tracef("[comp][periscomp] adding completion from 'xbetween' clause");
                  push @$words, $cs->{xbetween}[0]+1 .. $cs->{xbetween}[1]-1;
                  $static++;
              } elsif (defined($cs->{min}) && defined($cs->{max}) &&
                           $cs->{max}-$cs->{min} <= $limit) {
                  $log->tracef("[comp][periscomp] adding completion from 'min' & 'max' clauses");
                  push @$words, $cs->{min} .. $cs->{max};
                  $static++;
              } elsif (defined($cs->{min}) && defined($cs->{xmax}) &&
                           $cs->{xmax}-$cs->{min} <= $limit) {
                  $log->tracef("[comp][periscomp] adding completion from 'min' & 'xmax' clauses");
                  push @$words, $cs->{min} .. $cs->{xmax}-1;
                  $static++;
              } elsif (defined($cs->{xmin}) && defined($cs->{max}) &&
                           $cs->{max}-$cs->{xmin} <= $limit) {
                  $log->tracef("[comp][periscomp] adding completion from 'xmin' & 'max' clauses");
                  push @$words, $cs->{xmin}+1 .. $cs->{max};
                  $static++;
              } elsif (defined($cs->{xmin}) && defined($cs->{xmax}) &&
                           $cs->{xmax}-$cs->{xmin} <= $limit) {
                  $log->tracef("[comp][periscomp] adding completion from 'xmin' & 'xmax' clauses");
                  push @$words, $cs->{xmin}+1 .. $cs->{xmax}-1;
                  $static++;
              } elsif (length($word) && $word !~ /\A-?\d*\z/) {
                  $log->tracef("[comp][periscomp] word not an int");
                  $words = [];
              } else {
                  $words = [];
                  for my $sign ("", "-") {
                      for ("", 0..9) {
                          my $i = $sign . $word . $_;
                          next unless length $i;
                          next unless $i =~ /\A-?\d+\z/;
                          next if $i eq '-0';
                          next if $i =~ /\A-?0\d/;
                          next if $cs->{between} &&
                              ($i < $cs->{between}[0] ||
                                   $i > $cs->{between}[1]);
                          next if $cs->{xbetween} &&
                              ($i <= $cs->{xbetween}[0] ||
                                   $i >= $cs->{xbetween}[1]);
                          next if defined($cs->{min} ) && $i <  $cs->{min};
                          next if defined($cs->{xmin}) && $i <= $cs->{xmin};
                          next if defined($cs->{max} ) && $i >  $cs->{max};
                          next if defined($cs->{xmin}) && $i >= $cs->{xmax};
                          push @$words, $i;
                      }
                  }
                  $words = [sort @$words];
              }
              return; 
          }
          if ($type eq 'float') {
              if (length($word) && $word !~ /\A-?\d*(\.\d*)?\z/) {
                  $log->tracef("[comp][periscomp] word not a float");
                  $words = [];
              } else {
                  $words = [];
                  for my $sig ("", "-") {
                      for ("", 0..9,
                           ".0",".1",".2",".3",".4",".5",".6",".7",".8",".9") {
                          my $f = $sig . $word . $_;
                          next unless length $f;
                          next unless $f =~ /\A-?\d+(\.\d+)?\z/;
                          next if $f eq '-0';
                          next if $f =~ /\A-?0\d\z/;
                          next if $cs->{between} &&
                              ($f < $cs->{between}[0] ||
                                   $f > $cs->{between}[1]);
                          next if $cs->{xbetween} &&
                              ($f <= $cs->{xbetween}[0] ||
                                   $f >= $cs->{xbetween}[1]);
                          next if defined($cs->{min} ) && $f <  $cs->{min};
                          next if defined($cs->{xmin}) && $f <= $cs->{xmin};
                          next if defined($cs->{max} ) && $f >  $cs->{max};
                          next if defined($cs->{xmin}) && $f >= $cs->{xmax};
                          push @$words, $f;
                      }
                  }
              }
              return; 
          }
      }; 
  
      $log->tracef("[periscomp] complete_from_schema died: %s", $@) if $@;
  
      goto RETURN_RES unless $words;
      $fres = hashify_answer(
          complete_array_elem(array=>$words, word=>$word, ci=>$ci),
          {static=>$static && $word eq '' ? 1:0},
      );
  
    RETURN_RES:
      $log->tracef("[comp][periscomp] leaving complete_from_schema, result=%s", $fres);
      $fres;
  }
  
  $SPEC{complete_arg_val} = {
      v => 1.1,
      summary => 'Given argument name and function metadata, complete value',
      description => <<'_',
  
  Will attempt to complete using the completion routine specified in the argument
  specification (the `completion` property, or in the case of `complete_arg_elem`
  function, the `element_completion` property), or if that is not specified, from
  argument's schema using `complete_from_schema`.
  
  Completion routine will get `%args`, with the following keys:
  
  * `word` (str, the word to be completed)
  * `ci` (bool, whether string matching should be case-insensitive)
  * `arg` (str, the argument name which value is currently being completed)
  * `index (int, only for the `complete_arg_elem` function, the index in the
     argument array that is currently being completed, starts from 0)
  * `args` (hash, the argument hash to the function, so far)
  
  as well as extra keys from `extras` (but these won't overwrite the above
  standard keys).
  
  Completion routine should return a completion answer structure (described in
  `Complete`) which is either a hash or an array. The simplest form of answer is
  just to return an array of strings. Completion routine can also return undef to
  express declination.
  
  _
      args => {
          meta => {
              summary => 'Rinci function metadata, must be normalized',
              schema => 'hash*',
              req => 1,
          },
          arg => {
              summary => 'Argument name',
              schema => 'str*',
              req => 1,
          },
          word => {
              summary => 'Word to be completed',
              schema => ['str*', default => ''],
          },
          ci => {
              summary => 'Whether to be case-insensitive',
              schema => ['bool*'],
          },
          args => {
              summary => 'Collected arguments so far, '.
                  'will be passed to completion routines',
              schema  => 'hash',
          },
          extras => {
              summary => 'Add extra arguments to completion routine',
              schema  => 'hash',
              description => <<'_',
  
  The keys from this `extras` hash will be merged into the final `%args` passed to
  completion routines. Note that standard keys like `word`, `cword`, `ci`, and so
  on as described in the function description will not be overwritten by this.
  
  _
          },
  
          %common_args_riap,
      },
      result_naked => 1,
      result => {
          schema => 'array', 
      },
  };
  sub complete_arg_val {
      my %args = @_;
  
      $log->tracef("[comp][periscomp] entering complete_arg_val, arg=<%s>", $args{arg});
      my $fres;
  
      my $extras = $args{extras} // {};
  
      my $meta = $args{meta} or do {
          $log->tracef("[comp][periscomp] meta is not supplied, declining");
          goto RETURN_RES;
      };
      my $arg  = $args{arg} or do {
          $log->tracef("[comp][periscomp] arg is not supplied, declining");
          goto RETURN_RES;
      };
      my $ci   = $args{ci} // $Complete::OPT_CI;
      my $word = $args{word} // '';
  
  
      my $args_prop = $meta->{args} // {};
      my $arg_spec = $args_prop->{$arg} or do {
          $log->tracef("[comp][periscomp] arg '$arg' is not specified in meta, declining");
          goto RETURN_RES;
      };
  
      my $static;
      eval { 
  
          my $comp;
        GET_COMP_ROUTINE:
          {
              $comp = $arg_spec->{completion};
              if ($comp) {
                  $log->tracef("[comp][periscomp] using arg completion routine from 'completion' property");
                  last GET_COMP_ROUTINE;
              }
              my $xcomp = $arg_spec->{'x.completion'};
              if ($xcomp) {
                  require Module::Path::More;
                  my $mod = "Perinci::Sub::XCompletion::$xcomp->[0]";
                  if (Module::Path::More::module_path(module=>$mod)) {
                      $log->tracef("[comp][periscomp] loading module %s ...", $mod);
                      my $mod_pm = $mod; $mod_pm =~ s!::!/!g; $mod_pm .= ".pm";
                      require $mod_pm;
                      my $fref = \&{"$mod\::gen_completion"};
                      $comp = $fref->(%{ $xcomp->[1] });
                  }
                  if ($comp) {
                      $log->tracef("[comp][periscomp] using arg completion routine from 'x.completion' attribute");
                      last GET_COMP_ROUTINE;
                  }
              }
              my $ent = $arg_spec->{'x.schema.entity'};
              if ($ent) {
                  require Module::Path::More;
                  my $mod = "Perinci::Sub::ArgEntity::$ent";
                  if (Module::Path::More::module_path(module=>$mod)) {
                      $log->tracef("[comp][periscomp] loading module %s ...", $mod);
                      my $mod_pm = $mod; $mod_pm =~ s!::!/!g; $mod_pm .= ".pm";
                      require $mod_pm;
                      if (defined &{"$mod\::complete_arg_val"}) {
                          $log->tracef("[comp][periscomp] using arg completion routine from complete_arg_val() from %s", $mod);
                          $comp = \&{"$mod\::complete_arg_val"};
                          last GET_COMP_ROUTINE;
                      }
                  }
              }
          } 
  
          if ($comp) {
              if (ref($comp) eq 'CODE') {
                  $log->tracef("[comp][periscomp] invoking arg completion routine");
                  $fres = $comp->(
                      %$extras,
                      word=>$word, ci=>$ci, arg=>$arg, args=>$args{args});
                  return; 
              } elsif (ref($comp) eq 'ARRAY') {
                  $log->tracef("[comp][periscomp] using array specified in arg completion routine: %s", $comp);
                  $fres = complete_array_elem(
                      array=>$comp, word=>$word, ci=>$ci);
                  $static++;
                  return; 
              }
  
              $log->tracef("[comp][periscomp] arg spec's 'completion' property is not a coderef or arrayref");
              if ($args{riap_client} && $args{riap_server_url}) {
                  $log->tracef("[comp][periscomp] trying to perform complete_arg_val request to Riap server");
                  my $res = $args{riap_client}->request(
                      complete_arg_val => $args{riap_server_url},
                      {(uri=>$args{riap_uri}) x !!defined($args{riap_uri}),
                       arg=>$arg, word=>$word, ci=>$ci},
                  );
                  if ($res->[0] != 200) {
                      $log->tracef("[comp][periscomp] Riap request failed (%s), declining", $res);
                      return; 
                  }
                  $fres = $res->[2];
                  return; 
              }
  
              $log->tracef("[comp][periscomp] declining");
              return; 
          }
  
          my $sch = $arg_spec->{schema};
          unless ($sch) {
              $log->tracef("[comp][periscomp] arg spec does not specify schema, declining");
              return; 
          };
  
  
          $fres = complete_from_schema(schema=>$sch, word=>$word, ci=>$ci);
      };
      $log->debug("[comp][periscomp] completion died: $@") if $@;
      unless ($fres) {
          $log->tracef("[comp][periscomp] no completion from metadata possible, declining");
          goto RETURN_RES;
      }
  
      $fres = hashify_answer($fres);
      $fres->{static} //= $static && $word eq '' ? 1:0;
    RETURN_RES:
      $log->tracef("[comp][periscomp] leaving complete_arg_val, result=%s", $fres);
      $fres;
  }
  
  gen_modified_sub(
      output_name  => 'complete_arg_elem',
      install_sub  => 0,
      base_name    => 'complete_arg_val',
      summary      => 'Given argument name and function metadata, '.
          'complete array element',
      add_args     => {
          index => {
              summary => 'Index of element to complete',
              schema  => [int => min => 0],
          },
      },
  );
  sub complete_arg_elem {
      require Data::Sah::Normalize;
  
      my %args = @_;
  
      my $fres;
  
      $log->tracef("[comp][periscomp] entering complete_arg_elem, arg=<%s>, index=<%d>",
                   $args{arg}, $args{index});
  
      my $extras = $args{extras} // {};
  
      my $ourextras = {arg=>$args{arg}, args=>$args{args}};
  
      my $meta = $args{meta} or do {
          $log->tracef("[comp][periscomp] meta is not supplied, declining");
          goto RETURN_RES;
      };
      my $arg  = $args{arg} or do {
          $log->tracef("[comp][periscomp] arg is not supplied, declining");
          goto RETURN_RES;
      };
      defined(my $index = $args{index}) or do {
          $log->tracef("[comp][periscomp] index is not supplied, declining");
          goto RETURN_RES;
      };
      my $ci   = $args{ci} // $Complete::OPT_CI;
      my $word = $args{word} // '';
  
  
      my $args_prop = $meta->{args} // {};
      my $arg_spec = $args_prop->{$arg} or do {
          $log->tracef("[comp][periscomp] arg '$arg' is not specified in meta, declining");
          goto RETURN_RES;
      };
  
      my $static;
      eval { 
  
          my $elcomp;
        GET_ELCOMP_ROUTINE:
          {
              $elcomp = $arg_spec->{element_completion};
              if ($elcomp) {
                  $log->tracef("[comp][periscomp] using arg element completion routine from 'element_completion' property");
                  last GET_ELCOMP_ROUTINE;
              }
              my $xelcomp = $arg_spec->{'x.element_completion'};
              if ($xelcomp) {
                 require Module::Path::More;
                  my $mod = "Perinci::Sub::XCompletion::$xelcomp->[0]";
                  if (Module::Path::More::module_path(module=>$mod)) {
                      $log->tracef("[comp][periscomp] loading module %s ...", $mod);
                      my $mod_pm = $mod; $mod_pm =~ s!::!/!g; $mod_pm .= ".pm";
                      require $mod_pm;
                      my $fref = \&{"$mod\::gen_completion"};
                      $elcomp = $fref->(%{ $xelcomp->[1] });
                  }
                  if ($elcomp) {
                      $log->tracef("[comp][periscomp] using arg element completion routine from 'x.element_completion' attribute");
                      last GET_ELCOMP_ROUTINE;
                  }
              }
              my $ent = $arg_spec->{'x.schema.element_entity'};
              if ($ent) {
                  require Module::Path::More;
                  my $mod = "Perinci::Sub::ArgEntity::$ent";
                  if (Module::Path::More::module_path(module=>$mod)) {
                      $log->tracef("[comp][periscomp] loading module %s ...", $mod);
                      my $mod_pm = $mod; $mod_pm =~ s!::!/!g; $mod_pm .= ".pm";
                      require $mod_pm;
                      if (defined &{"$mod\::complete_arg_val"}) {
                          $log->tracef("[comp][periscomp] using arg element completion routine from complete_arg_val() from %s", $mod);
                          $elcomp = \&{"$mod\::complete_arg_val"};
                          last GET_ELCOMP_ROUTINE;
                      }
                  }
              }
          } 
  
          $ourextras->{index} = $index;
          if ($elcomp) {
              if (ref($elcomp) eq 'CODE') {
                  $log->tracef("[comp][periscomp] invoking arg element completion routine");
                  $fres = $elcomp->(
                      %$extras,
                      %$ourextras,
                      word=>$word, ci=>$ci);
                  return; 
              } elsif (ref($elcomp) eq 'ARRAY') {
                  $log->tracef("[comp][periscomp] using array specified in arg element completion routine: %s", $elcomp);
                  $fres = complete_array_elem(
                      array=>$elcomp, word=>$word, ci=>$ci);
                  $static = $word eq '';
              }
  
              $log->tracef("[comp][periscomp] arg spec's 'element_completion' property is not a coderef or ".
                               "arrayref");
              if ($args{riap_client} && $args{riap_server_url}) {
                  $log->tracef("[comp][periscomp] trying to perform complete_arg_elem request to Riap server");
                  my $res = $args{riap_client}->request(
                      complete_arg_elem => $args{riap_server_url},
                      {(uri=>$args{riap_uri}) x !!defined($args{riap_uri}),
                       arg=>$arg, args=>$args{args}, word=>$word, ci=>$ci,
                       index=>$index},
                  );
                  if ($res->[0] != 200) {
                      $log->tracef("[comp][periscomp] Riap request failed (%s), declining", $res);
                      return; 
                  }
                  $fres = $res->[2];
                  return; 
              }
  
              $log->tracef("[comp][periscomp] declining");
              return; 
          }
  
          my $sch = $arg_spec->{schema};
          unless ($sch) {
              $log->tracef("[comp][periscomp] arg spec does not specify schema, declining");
              return; 
          };
  
  
          my ($type, $cs) = @{ $sch };
          if ($type ne 'array') {
              $log->tracef("[comp][periscomp] can't complete element for non-array");
              return; 
          }
  
          unless ($cs->{of}) {
              $log->tracef("[comp][periscomp] schema does not specify 'of' clause, declining");
              return; 
          }
  
          my $elsch = Data::Sah::Normalize::normalize_schema($cs->{of});
  
          $fres = complete_from_schema(schema=>$elsch, word=>$word, ci=>$ci);
      };
      $log->debug("[comp][periscomp] completion died: $@") if $@;
      unless ($fres) {
          $log->tracef("[comp][periscomp] no completion from metadata possible, declining");
          goto RETURN_RES;
      }
  
      $fres = hashify_answer($fres);
      $fres->{static} //= $static && $word eq '' ? 1:0;
    RETURN_RES:
      $log->tracef("[comp][periscomp] leaving complete_arg_elem, result=%s", $fres);
      $fres;
  }
  
  $SPEC{complete_cli_arg} = {
      v => 1.1,
      summary => 'Complete command-line argument using Rinci function metadata',
      description => <<'_',
  
  This routine uses `Perinci::Sub::GetArgs::Argv` to generate `Getopt::Long`
  specification from arguments list in Rinci function metadata and common options.
  Then, it will use `Complete::Getopt::Long` to complete option names, option
  values, as well as arguments.
  
  _
      args => {
          meta => {
              summary => 'Rinci function metadata',
              schema => 'hash*',
              req => 1,
          },
          words => {
              summary => 'Command-line arguments',
              schema => ['array*' => {of=>'str*'}],
              req => 1,
          },
          cword => {
              summary => 'On which argument cursor is located (zero-based)',
              schema => 'int*',
              req => 1,
          },
          completion => {
              summary => 'Supply custom completion routine',
              description => <<'_',
  
  If supplied, instead of the default completion routine, this code will be called
  instead. Will receive all arguments that `Complete::Getopt::Long` will pass, and
  additionally:
  
  * `arg` (str, the name of function argument)
  * `args` (hash, the function arguments formed so far)
  * `index` (int, if completing argument element value)
  
  _
              schema => 'code*',
          },
          per_arg_json => {
              summary => 'Will be passed to Perinci::Sub::GetArgs::Argv',
              schema  => 'bool',
          },
          per_arg_yaml => {
              summary => 'Will be passed to Perinci::Sub::GetArgs::Argv',
              schema  => 'bool',
          },
          common_opts => {
              summary => 'Common options',
              description => <<'_',
  
  A hash where the values are hashes containing these keys: `getopt` (Getopt::Long
  option specification), `handler` (Getopt::Long handler). Will be passed to
  `get_args_from_argv()`. Example:
  
      {
          help => {
              getopt  => 'help|h|?',
              handler => sub { ... },
              summary => 'Display help and exit',
          },
          version => {
              getopt  => 'version|v',
              handler => sub { ... },
              summary => 'Display version and exit',
          },
      }
  
  _
              schema => ['hash*'],
          },
          extras => {
              summary => 'Add extra arguments to completion routine',
              schema  => 'hash',
              description => <<'_',
  
  The keys from this `extras` hash will be merged into the final `%args` passed to
  completion routines. Note that standard keys like `word`, `cword`, `ci`, and so
  on as described in the function description will not be overwritten by this.
  
  _
          },
          func_arg_starts_at => {
              schema  => 'int*',
              default => 0,
              description => <<'_',
  
  This is a (temporary?) workaround for Perinci::CmdLine. In an application with
  subcommands (e.g. `cmd --verbose subcmd arg0 arg1 ...`), then `words` will still
  contain the subcommand name. Positional function arguments then start at 1 not
  0. This option allows offsetting function arguments.
  
  _
          },
          %common_args_riap,
      },
      result_naked => 1,
      result => {
          schema => 'hash*',
          description => <<'_',
  
  You can use `format_completion` function in `Complete::Bash` module to format
  the result of this function for bash.
  
  _
      },
  };
  sub complete_cli_arg {
      require Complete::Getopt::Long;
      require Perinci::Sub::GetArgs::Argv;
  
      my %args   = @_;
      my $meta   = $args{meta} or die "Please specify meta";
      my $words  = $args{words} or die "Please specify words";
      my $cword  = $args{cword}; defined($cword) or die "Please specify cword";
      my $copts  = $args{common_opts} // {};
      my $comp   = $args{completion};
      my $extras = {
          %{ $args{extras} // {} },
          words => $args{words},
          cword => $args{cword},
      };
  
      my $fname = __PACKAGE__ . "::complete_cli_arg"; 
      my $fres;
  
      my $word   = $words->[$cword];
      my $args_prop = $meta->{args} // {};
  
      $log->tracef('[comp][periscomp] entering %s(), words=%s, cword=%d, word=<%s>',
                   $fname, $words, $cword, $word);
  
      my $genres = Perinci::Sub::GetArgs::Argv::gen_getopt_long_spec_from_meta(
          meta         => $meta,
          common_opts  => $copts,
          per_arg_json => $args{per_arg_json},
          per_arg_yaml => $args{per_arg_yaml},
          ignore_converted_code => 1,
      );
      die "Can't generate getopt spec from meta: $genres->[0] - $genres->[1]"
          unless $genres->[0] == 200;
      my $gospec = $genres->[2];
      my $specmeta = $genres->[3]{'func.specmeta'};
  
      my $gares = Perinci::Sub::GetArgs::Argv::get_args_from_argv(
          argv   => [@$words],
          meta   => $meta,
          strict => 0,
      );
  
      my $copts_by_ospec = {};
      for (keys %$copts) { $copts_by_ospec->{$copts->{$_}{getopt}}=$copts->{$_} }
  
      my $compgl_comp = sub {
          $log->tracef("[comp][periscomp] entering completion routine (that we supply to Complete::Getopt::Long)");
          my %cargs = @_;
          my $type  = $cargs{type};
          my $ospec = $cargs{ospec} // '';
          my $word  = $cargs{word};
          my $ci    = $cargs{ci} // $Complete::OPT_CI;
  
          my $fres;
  
          my %rargs = (
              riap_server_url => $args{riap_server_url},
              riap_uri        => $args{riap_uri},
              riap_client     => $args{riap_client},
          );
  
          if (my $sm = $specmeta->{$ospec}) {
              $cargs{type} = 'optval';
              if ($sm->{arg}) {
                  $log->tracef("[comp][periscomp] completing option value for a known function argument, arg=<%s>, ospec=<%s>", $sm->{arg}, $ospec);
                  $cargs{arg} = $sm->{arg};
                  my $arg_spec = $args_prop->{$sm->{arg}} or goto RETURN_RES;
                  if ($comp) {
                      $log->tracef("[comp][periscomp] invoking routine supplied from 'completion' argument");
                      my $compres;
                      eval { $compres = $comp->(%cargs) };
                      $log->debug("[comp][periscomp] completion died: $@") if $@;
                      $log->tracef("[comp][periscomp] result from 'completion' routine: %s", $compres);
                      if ($compres) {
                          $fres = $compres;
                          goto RETURN_RES;
                      }
                  }
                  if ($ospec =~ /\@$/) {
                      $fres = complete_arg_elem(
                          meta=>$meta, arg=>$sm->{arg}, args=>$gares->[2],
                          word=>$word, index=>$cargs{nth}, 
                          extras=>$extras, %rargs);
                      goto RETURN_RES;
                  } else {
                      $fres = complete_arg_val(
                          meta=>$meta, arg=>$sm->{arg}, args=>$gares->[2],
                          word=>$word, extras=>$extras, %rargs);
                      goto RETURN_RES;
                  }
              } else {
                  $log->tracef("[comp][periscomp] completing option value for a common option, ospec=<%s>", $ospec);
                  $cargs{arg}  = undef;
                  my $codata = $copts_by_ospec->{$ospec};
                  if ($comp) {
                      $log->tracef("[comp][periscomp] invoking routine supplied from 'completion' argument");
                      my $res;
                      eval { $res = $comp->(%cargs) };
                      $log->debug("[comp][periscomp] completion died: $@") if $@;
                      if ($res) {
                          $fres = $res;
                          goto RETURN_RES;
                      }
                  }
                  if ($codata->{completion}) {
                      $cargs{arg}  = undef;
                      $log->tracef("[comp][periscomp] completing with common option's 'completion' property");
                      my $res;
                      eval { $res = $codata->{completion}->(%cargs) };
                      $log->debug("[comp][periscomp] completion died: $@") if $@;
                      if ($res) {
                          $fres = $res;
                          goto RETURN_RES;
                      }
                  }
                  if ($codata->{schema}) {
                      require Data::Sah::Normalize;
                      my $nsch = Data::Sah::Normalize::normalize_schema(
                          $codata->{schema});
                      $log->tracef("[comp][periscomp] completing with common option's schema");
                      $fres = complete_from_schema(
                          schema => $nsch, word=>$word, ci=>$ci);
                      goto RETURN_RES;
                  }
                  goto RETURN_RES;
              }
          } elsif ($type eq 'arg') {
              $log->tracef("[comp][periscomp] completing argument #%d", $cargs{argpos});
              $cargs{type} = 'arg';
  
              my $pos = $cargs{argpos};
              my $fasa = $args{func_arg_starts_at} // 0;
  
              for my $an (keys %$args_prop) {
                  my $arg_spec = $args_prop->{$an};
                  next unless !$arg_spec->{greedy} &&
                      defined($arg_spec->{pos}) && $arg_spec->{pos} == $pos - $fasa;
                  $log->tracef("[comp][periscomp] this argument position is for non-greedy function argument <%s>", $an);
                  $cargs{arg} = $an;
                  if ($comp) {
                      $log->tracef("[comp][periscomp] invoking routine supplied from 'completion' argument");
                      my $res;
                      eval { $res = $comp->(%cargs) };
                      $log->debug("[comp][periscomp] completion died: $@") if $@;
                      if ($res) {
                          $fres = $res;
                          goto RETURN_RES;
                      }
                  }
                  $fres = complete_arg_val(
                      meta=>$meta, arg=>$an, args=>$gares->[2],
                      word=>$word, extras=>$extras, %rargs);
                  goto RETURN_RES;
              }
  
              for my $an (sort {
                  ($args_prop->{$b}{pos} // 9999) <=> ($args_prop->{$a}{pos} // 9999)
              } keys %$args_prop) {
                  my $arg_spec = $args_prop->{$an};
                  next unless $arg_spec->{greedy} &&
                      defined($arg_spec->{pos}) && $arg_spec->{pos} <= $pos - $fasa;
                  my $index = $pos - $fasa - $arg_spec->{pos};
                  $cargs{arg} = $an;
                  $cargs{index} = $index;
                  $log->tracef("[comp][periscomp] this position is for greedy function argument <%s>'s element[%d]", $an, $index);
                  if ($comp) {
                      $log->tracef("[comp][periscomp] invoking routine supplied from 'completion' argument");
                      my $res;
                      eval { $res = $comp->(%cargs) };
                      $log->debug("[comp][periscomp] completion died: $@") if $@;
                      if ($res) {
                          $fres = $res;
                          goto RETURN_RES;
                      }
                  }
                  $fres = complete_arg_elem(
                      meta=>$meta, arg=>$an, args=>$gares->[2],
                      word=>$word, index=>$index, extras=>$extras, %rargs);
                  goto RETURN_RES;
              }
  
              $log->tracef("[comp][periscomp] there is no matching function argument at this position");
              if ($comp) {
                  $log->tracef("[comp][periscomp] invoking routine supplied from 'completion' argument");
                  my $res;
                  eval { $res = $comp->(%cargs) };
                  $log->debug("[comp][periscomp] completion died: $@") if $@;
                  if ($res) {
                      $fres = $res;
                      goto RETURN_RES;
                  }
              }
              goto RETURN_RES;
          } else {
              $log->tracef("[comp][periscomp] completing option value for an unknown/ambiguous option, declining ...");
              goto RETURN_RES;
          }
        RETURN_RES:
          $log->tracef("[comp][periscomp] leaving completion routine (that we supply to Complete::Getopt::Long)");
          $fres;
      }; 
  
      $fres = Complete::Getopt::Long::complete_cli_arg(
          getopt_spec => $gospec,
          words       => $words,
          cword       => $cword,
          completion  => $compgl_comp,
          extras      => $extras,
      );
  
    RETURN_RES:
      $log->tracef('[comp][periscomp] leaving %s(), result=%s',
                   $fname, $fres);
      $fres;
  }
  
  1;
  
  __END__
  
PERINCI_SUB_COMPLETE

$fatpacked{"Perinci/Sub/GetArgs/Argv.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PERINCI_SUB_GETARGS_ARGV';
  package Perinci::Sub::GetArgs::Argv;
  
  our $DATE = '2015-04-02'; 
  our $VERSION = '0.65'; 
  
  use 5.010001;
  use strict;
  use warnings;
  
  use Data::Sah::Normalize qw(normalize_schema);
  use Getopt::Long::Negate::EN qw(negations_for_option);
  use Getopt::Long::Util qw(parse_getopt_long_opt_spec);
  use List::Util qw(first);
  use Perinci::Sub::GetArgs::Array qw(get_args_from_array);
  use Perinci::Sub::Util qw(err);
  
  use Exporter;
  our @ISA = qw(Exporter);
  our @EXPORT_OK = qw(
                         gen_getopt_long_spec_from_meta
                         get_args_from_argv
                 );
  
  our %SPEC;
  
  $SPEC{':package'} = {
      v => 1.1,
      summary => 'Get subroutine arguments from command line arguments (@ARGV)',
  };
  
  my $re_simple_scalar = qr/^(str|num|int|float|bool|buf|re)$/;
  
  sub _parse_json {
      my $str = shift;
  
      state $json = do {
          require JSON;
          JSON->new->allow_nonref;
      };
  
      state $cleanser = do {
          require Data::Clean::FromJSON;
          Data::Clean::FromJSON->get_cleanser;
      };
  
      my $res;
      eval { $res = $json->decode($str); $cleanser->clean_in_place($res) };
      my $e = $@;
      return (!$e, $e, $res);
  }
  
  sub _parse_yaml {
      no warnings 'once';
      require YAML::Syck;
  
      my $str = shift;
  
      local $YAML::Syck::ImplicitTyping = 1;
      my $res;
      eval { $res = YAML::Syck::Load($str) };
      my $e = $@;
      return (!$e, $e, $res);
  }
  
  sub _arg2opt {
      my $opt = shift;
      $opt =~ s/[^A-Za-z0-9-]+/-/g; 
      $opt;
  }
  
  sub _opt2ospec {
      my ($opt, $schema, $arg_spec) = @_;
      my $type = $schema->[0];
      my $cs   = $schema->[1];
      my $is_array_of_simple_scalar = $type eq 'array' &&
          $cs->{of} && $cs->{of}[0] =~ $re_simple_scalar;
      if ($is_array_of_simple_scalar && $arg_spec && $arg_spec->{'x.name.is_plural'}) {
          if ($arg_spec->{'x.name.singular'}) {
              $opt = $arg_spec->{'x.name.singular'};
          } else {
              require Lingua::EN::PluralToSingular;
              $opt = Lingua::EN::PluralToSingular::to_singular($opt);
          }
      }
      if ($type eq 'bool') {
          if (length($opt) == 1 || $cs->{is}) {
              return ($opt, {opts=>[$opt]});
          } else {
              my @res;
              my @negs = negations_for_option($opt);
              push @res, $opt, {opts=>[$opt]}, {is_neg=>0, neg_opts=>\@negs};
              for (@negs) {
                  push @res, $_, {opts=>[$_]}, {is_neg=>1, pos_opts=>[$opt]};
              }
              return @res;
          }
      } elsif ($type eq 'buf') {
          return (
              "$opt=s", {opts=>[$opt], desttype=>"", type=>"s"}, undef,
              "$opt-base64=s", {opts=>["$opt-base64"], desttype=>"", type=>"s"}, {is_base64=>1},
          );
      } else {
          my $t = ($type eq 'int' ? 'i' : $type eq 'float' ? 'f' :
                       $is_array_of_simple_scalar ? 's@' : 's');
          return ("$opt=$t", {opts=>[$opt], desttype=>"", type=>$t});
      }
  }
  
  sub _args2opts {
      my %args = @_;
  
      my $argprefix        = $args{argprefix};
      my $parent_args      = $args{parent_args};
      my $meta             = $args{meta};
      my $seen_opts        = $args{seen_opts};
      my $seen_common_opts = $args{seen_common_opts};
      my $seen_func_opts   = $args{seen_func_opts};
      my $rargs            = $args{rargs};
      my $go_spec          = $args{go_spec};
      my $specmeta         = $args{specmeta};
  
      my $args_prop = $meta->{args} // {};
  
      for my $arg (keys %$args_prop) {
          my $fqarg    = "$argprefix$arg";
          my $arg_spec = $args_prop->{$arg};
          my $sch      = $arg_spec->{schema} // ['any', {}];
          my $type     = $sch->[0] // '';
          my $cs       = $sch->[1] // {};
  
          if ($type eq 'array' && $cs->{of}) {
              $cs->{of} = normalize_schema($cs->{of});
          }
          my $opt = _arg2opt($fqarg);
          if ($seen_opts->{$opt}) {
              my $i = 1;
              my $opt2;
              while (1) {
                  $opt2 = "$opt-arg" . ($i > 1 ? $i : '');
                  last unless $seen_opts->{$opt2};
                  $i++;
              }
              $opt = $opt2;
          }
  
          my $is_simple_scalar = $type =~ $re_simple_scalar;
          my $is_array_of_simple_scalar = $type eq 'array' &&
              $cs->{of} && $cs->{of}[0] =~ $re_simple_scalar;
  
          my $stash = {};
  
  
          my $handler = sub {
              my ($val, $val_set);
  
              my $num_called = ++$stash->{called}{$arg};
  
              my $rargs = do {
                  if (ref($rargs) eq 'ARRAY') {
                      $rargs->[$num_called-1] //= {};
                      $rargs->[$num_called-1];
                  } else {
                      $rargs;
                  }
              };
  
              if ($is_array_of_simple_scalar) {
                  $rargs->{$arg} //= [];
                  $val_set = 1; $val = $_[1];
                  push @{ $rargs->{$arg} }, $val;
              } elsif ($is_simple_scalar) {
                  $val_set = 1; $val = $_[1];
                  $rargs->{$arg} = $val;
              } else {
                  {
                      my ($success, $e, $decoded);
                      ($success, $e, $decoded) = _parse_json($_[1]);
                      if ($success) {
                          $val_set = 1; $val = $decoded;
                          $rargs->{$arg} = $val;
                          last;
                      }
                      ($success, $e, $decoded) = _parse_yaml($_[1]);
                      if ($success) {
                          $val_set = 1; $val = $decoded;
                          $rargs->{$arg} = $val;
                          last;
                      }
                      die "Invalid YAML/JSON in arg '$fqarg'";
                  }
              }
              if ($val_set && $arg_spec->{cmdline_on_getopt}) {
                  $arg_spec->{cmdline_on_getopt}->(
                      arg=>$arg, fqarg=>$fqarg, value=>$val, args=>$rargs,
                      opt=>$opt,
                  );
              }
          }; 
  
          my @triplets = _opt2ospec($opt, $sch, $arg_spec);
          my $aliases_processed;
          while (my ($ospec, $parsed, $extra) = splice @triplets, 0, 3) {
              $extra //= {};
              if ($extra->{is_neg}) {
                  $go_spec->{$ospec} = sub { $handler->($_[0], 0) };
              } elsif (defined $extra->{is_neg}) {
                  $go_spec->{$ospec} = sub { $handler->($_[0], 1) };
              } elsif ($extra->{is_base64}) {
                  $go_spec->{$ospec} = sub {
                      require MIME::Base64;
                      my $decoded = MIME::Base64::decode($_[1]);
                      $handler->($_[0], $decoded);
                  };
              } else {
                  $go_spec->{$ospec} = $handler;
              }
  
              $specmeta->{$ospec} = {arg=>$arg, fqarg=>$fqarg, parsed=>$parsed, %$extra};
              for (@{ $parsed->{opts} }) {
                  $seen_opts->{$_}++; $seen_func_opts->{$_} = $fqarg;
              }
  
              if ($parent_args->{per_arg_json} && $type !~ $re_simple_scalar) {
                  my $jopt = "$opt-json";
                  if ($seen_opts->{$jopt}) {
                      warn "Clash of option: $jopt, not added";
                  } else {
                      my $jospec = "$jopt=s";
                      my $parsed = {type=>"s", opts=>[$jopt]};
                      $go_spec->{$jospec} = sub {
                          my ($success, $e, $decoded);
                          ($success, $e, $decoded) = _parse_json($_[1]);
                          if ($success) {
                              $rargs->{$arg} = $decoded;
                          } else {
                              die "Invalid JSON in option --$jopt: $_[1]: $e";
                          }
                      };
                      $specmeta->{$jospec} = {arg=>$arg, fqarg=>$fqarg, is_json=>1, parsed=>$parsed, %$extra};
                      $seen_opts->{$jopt}++; $seen_func_opts->{$jopt} = $fqarg;
                  }
              }
              if ($parent_args->{per_arg_yaml} && $type !~ $re_simple_scalar) {
                  my $yopt = "$opt-yaml";
                  if ($seen_opts->{$yopt}) {
                      warn "Clash of option: $yopt, not added";
                  } else {
                      my $yospec = "$yopt=s";
                      my $parsed = {type=>"s", opts=>[$yopt]};
                      $go_spec->{$yospec} = sub {
                          my ($success, $e, $decoded);
                          ($success, $e, $decoded) = _parse_yaml($_[1]);
                          if ($success) {
                              $rargs->{$arg} = $decoded;
                          } else {
                              die "Invalid YAML in option --$yopt: $_[1]: $e";
                          }
                      };
                      $specmeta->{$yospec} = {arg=>$arg, fqarg=>$fqarg, is_yaml=>1, parsed=>$parsed, %$extra};
                      $seen_opts->{$yopt}++; $seen_func_opts->{$yopt} = $fqarg;
                  }
              }
  
              if ($arg_spec->{cmdline_aliases} && !$aliases_processed++) {
                  for my $al (keys %{$arg_spec->{cmdline_aliases}}) {
                      my $alspec = $arg_spec->{cmdline_aliases}{$al};
                      my $alsch = $alspec->{schema} //
                          $alspec->{is_flag} ? [bool=>{req=>1,is=>1}] : $sch;
                      my $altype = $alsch->[0];
                      my $alopt = _arg2opt("$argprefix$al");
                      if ($seen_opts->{$alopt}) {
                          warn "Clash of cmdline_alias option $al";
                          next;
                      }
                      my $alcode = $alspec->{code};
                      my $alospec;
                      my $parsed;
                      if ($alcode && $alsch->[0] eq 'bool') {
                          $alospec = $alopt; 
                          $parsed = {opts=>[$alopt]};
                      } else {
                          ($alospec, $parsed) = _opt2ospec($alopt, $alsch);
                      }
  
                      if ($alcode) {
                          if ($alcode eq 'CODE') {
                              if ($parent_args->{ignore_converted_code}) {
                                  $alcode = sub {};
                              } else {
                                  return [
                                      501,
                                      join("",
                                           "Code in cmdline_aliases for arg $fqarg ",
                                           "got converted into string, probably ",
                                           "because of JSON/YAML transport"),
                                  ];
                              }
                          }
                          $go_spec->{$alospec} = sub {
  
                              my $num_called = ++$stash->{called}{$arg};
                              my $rargs = do {
                                  if (ref($rargs) eq 'ARRAY') {
                                      $rargs->[$num_called-1] //= {};
                                      $rargs->[$num_called-1];
                                  } else {
                                      $rargs;
                                  }
                              };
  
                              $alcode->($rargs, $_[1]);
                          };
                      } else {
                          $go_spec->{$alospec} = $handler;
                      }
                      $specmeta->{$alospec} = {
                          alias     => $al,
                          is_alias  => 1,
                          alias_for => $ospec,
                          arg       => $arg,
                          fqarg     => $fqarg,
                          is_code   => $alcode ? 1:0,
                          parsed    => $parsed,
                          %$extra,
                      };
                      push @{$specmeta->{$ospec}{($alcode ? '':'non').'code_aliases'}},
                          $alospec;
                      $seen_opts->{$alopt}++; $seen_func_opts->{$alopt} = $fqarg;
                  }
              } 
  
              if ($arg_spec->{meta}) {
                  $rargs->{$arg} = {};
                  my $res = _args2opts(
                      %args,
                      argprefix => "$argprefix$arg\::",
                      meta      => $arg_spec->{meta},
                      rargs     => $rargs->{$arg},
                  );
                  return $res if $res;
              }
  
              if ($arg_spec->{element_meta}) {
                  $rargs->{$arg} = [];
                  my $res = _args2opts(
                      %args,
                      argprefix => "$argprefix$arg\::",
                      meta      => $arg_spec->{element_meta},
                      rargs     => $rargs->{$arg},
                  );
                  return $res if $res;
              }
          } 
  
      } 
  
      undef;
  }
  
  $SPEC{gen_getopt_long_spec_from_meta} = {
      v           => 1.1,
      summary     => 'Generate Getopt::Long spec from Rinci function metadata',
      description => <<'_',
  
  This routine will produce a `Getopt::Long` specification from Rinci function
  metadata, as well as some more data structure in the result metadata to help
  producing a command-line help/usage message.
  
  Function arguments will be mapped to command-line options with the same name,
  with non-alphanumeric characters changed to `-` (`-` is preferred over `_`
  because it lets user avoid pressing Shift on popular keyboards). For example:
  `file_size` becomes `file-size`, `file_size.max` becomes `file-size-max`. If
  function argument option name clashes with command-line option or another
  existing option, it will be renamed to `NAME-arg` (or `NAME-arg2` and so on).
  For example: `help` will become `help-arg` (if `common_opts` contains `help`,
  that is).
  
  Each command-line alias (`cmdline_aliases` property) in the argument
  specification will also be added as command-line option, except if it clashes
  with an existing option, in which case this function will warn and skip adding
  the alias. For more information about `cmdline_aliases`, see `Rinci::function`.
  
  For arguments with type of `bool`, Getopt::Long will by default also
  automatically recognize `--noNAME` or `--no-NAME` in addition to `--name`. So
  this function will also check those names for clashes.
  
  For arguments with type array of simple scalar, `--NAME` can be specified more
  than once to append to the array.
  
  If `per_arg_json` setting is active, and argument's schema is not a "required
  simple scalar" (e.g. an array, or a nullable string), then `--NAME-json` will
  also be added to let users input undef (through `--NAME-json null`) or a
  non-scalar value (e.g. `--NAME-json '[1,2,3]'`). If this name conflicts with
  another existing option, a warning will be displayed and the option will not be
  added.
  
  If `per_arg_yaml` setting is active, and argument's schema is not a "required
  simple scalar" (e.g. an array, or a nullable string), then `--NAME-yaml` will
  also be added to let users input undef (through `--NAME-yaml '~'`) or a
  non-scalar value (e.g. `--NAME-yaml '[foo, bar]'`). If this name conflicts with
  another existing option, a warning will be displayed and the option will not be
  added. YAML can express a larger set of values, e.g. binary data, circular
  references, etc.
  
  Will produce a hash (Getopt::Long spec), with `func.specmeta`, `func.opts`,
  `func.common_opts`, `func.func_opts` that contain extra information
  (`func.specmeta` is a hash of getopt spec name and a hash of extra information
  while `func.*opts` lists all used option names).
  
  _
      args => {
          meta => {
              summary => 'Rinci function metadata',
              schema  => 'hash*',
              req     => 1,
          },
          meta_is_normalized => {
              schema => 'bool*',
          },
          args => {
              summary => 'Reference to hash which will store the result',
              schema  => 'hash*',
          },
          common_opts => {
              summary => 'Common options',
              description => <<'_',
  
  A hash where the values are hashes containing these keys: `getopt` (Getopt::Long
  option specification), `handler` (Getopt::Long handler). Will be passed to
  `get_args_from_argv()`. Example:
  
      {
          help => {
              getopt  => 'help|h|?',
              handler => sub { ... },
              summary => 'Display help and exit',
          },
          version => {
              getopt  => 'version|v',
              handler => sub { ... },
              summary => 'Display version and exit',
          },
      }
  
  _
              schema => ['hash*'],
          },
          per_arg_json => {
              summary => 'Whether to add --NAME-json for non-simple arguments',
              schema  => 'bool',
              default => 0,
              description => <<'_',
  
  Will also interpret command-line arguments as JSON if assigned to function
  arguments, if arguments' schema is not simple scalar.
  
  _
          },
          per_arg_yaml => {
              summary => 'Whether to add --NAME-yaml for non-simple arguments',
              schema  => 'bool',
              default => 0,
              description => <<'_',
  
  Will also interpret command-line arguments as YAML if assigned to function
  arguments, if arguments' schema is not simple scalar.
  
  _
          },
          ignore_converted_code => {
              summary => 'Whether to ignore coderefs converted to string',
              schema => 'bool',
              default => 0,
              description => <<'_',
  
  Across network through JSON encoding, coderef in metadata (e.g. in
  `cmdline_aliases` property) usually gets converted to string `CODE`. In some
  cases, like for tab completion, this is pretty harmless so you can turn this
  option on. For example, in the case of `cmdline_aliases`, the effect is just
  that command-line aliases code are not getting executed, but this is usually
  okay.
  
  _
          },
      },
  };
  sub gen_getopt_long_spec_from_meta {
      my %fargs = @_;
  
      my $meta       = $fargs{meta} or return [400, "Please specify meta"];
      unless ($fargs{meta_is_normalized}) {
          require Perinci::Sub::Normalize;
          $meta = Perinci::Sub::Normalize::normalize_function_metadata($meta);
      }
      my $co           = $fargs{common_opts} // {};
      my $per_arg_yaml = $fargs{per_arg_yaml} // 0;
      my $per_arg_json = $fargs{per_arg_json} // 0;
      my $ignore_converted_code = $fargs{ignore_converted_code};
      my $rargs        = $fargs{args} // {};
  
      my %go_spec;
      my %specmeta; 
      my %seen_opts;
      my %seen_common_opts;
      my %seen_func_opts;
  
      for my $k (keys %$co) {
          my $v = $co->{$k};
          my $ospec   = $v->{getopt};
          my $handler = $v->{handler};
          my $res = parse_getopt_long_opt_spec($ospec)
              or return [400, "Can't parse common opt spec '$ospec'"];
          $go_spec{$ospec} = $handler;
          $specmeta{$ospec} = {common_opt=>$k, arg=>undef, parsed=>$res};
          for (@{ $res->{opts} }) {
              return [412, "Clash of common opt '$_'"] if $seen_opts{$_};
              $seen_opts{$_}++; $seen_common_opts{$_} = $ospec;
              if ($res->{is_neg}) {
                  $seen_opts{"no$_"}++ ; $seen_common_opts{"no$_"}  = $ospec;
                  $seen_opts{"no-$_"}++; $seen_common_opts{"no-$_"} = $ospec;
              }
          }
      }
  
      my $res = _args2opts(
          argprefix        => "",
          parent_args      => \%fargs,
          meta             => $meta,
          seen_opts        => \%seen_opts,
          seen_common_opts => \%seen_common_opts,
          seen_func_opts   => \%seen_func_opts,
          rargs            => $rargs,
          go_spec          => \%go_spec,
          specmeta         => \%specmeta,
      );
      return $res if $res;
  
      my $opts        = [sort(map {length($_)>1 ? "--$_":"-$_"} keys %seen_opts)];
      my $common_opts = [sort(map {length($_)>1 ? "--$_":"-$_"} keys %seen_common_opts)];
      my $func_opts   = [sort(map {length($_)>1 ? "--$_":"-$_"} keys %seen_func_opts)];
      my $opts_by_common = {};
      for my $k (keys %$co) {
          my $v = $co->{$k};
          my $ospec = $v->{getopt};
          my @opts;
          for (keys %seen_common_opts) {
              next unless $seen_common_opts{$_} eq $ospec;
              push @opts, (length($_)>1 ? "--$_":"-$_");
          }
          $opts_by_common->{$ospec} = [sort @opts];
      }
  
      my $opts_by_arg = {};
      for (keys %seen_func_opts) {
          my $fqarg = $seen_func_opts{$_};
          push @{ $opts_by_arg->{$fqarg} }, length($_)>1 ? "--$_":"-$_";
      }
      for (keys %$opts_by_arg) {
          $opts_by_arg->{$_} = [sort @{ $opts_by_arg->{$_} }];
      }
  
      [200, "OK", \%go_spec,
       {
           "func.specmeta"       => \%specmeta,
           "func.opts"           => $opts,
           "func.common_opts"    => $common_opts,
           "func.func_opts"      => $func_opts,
           "func.opts_by_arg"    => $opts_by_arg,
           "func.opts_by_common" => $opts_by_common,
       }];
  }
  
  $SPEC{get_args_from_argv} = {
      v => 1.1,
      summary => 'Get subroutine arguments (%args) from command-line arguments '.
          '(@ARGV)',
      description => <<'_',
  
  Using information in Rinci function metadata's `args` property, parse command
  line arguments `@argv` into hash `%args`, suitable for passing into subroutines.
  
  Currently uses Getopt::Long's GetOptions to do the parsing.
  
  As with GetOptions, this function modifies its `argv` argument, so you might
  want to copy the original `argv` first (or pass a copy instead) if you want to
  preserve the original.
  
  See also: gen_getopt_long_spec_from_meta() which is the routine that generates
  the specification.
  
  _
      args => {
          argv => {
              schema => ['array*' => {
                  of => 'str*',
              }],
              description => 'If not specified, defaults to @ARGV',
          },
          args => {
              summary => 'Specify input args, with some arguments preset',
              schema  => ['hash'],
          },
          meta => {
              schema => ['hash*' => {}],
              req => 1,
          },
          meta_is_normalized => {
              summary => 'Can be set to 1 if your metadata is normalized, '.
                  'to avoid duplicate effort',
              schema => 'bool',
              default => 0,
          },
          strict => {
              schema => ['bool' => {default=>1}],
              summary => 'Strict mode',
              description => <<'_',
  
  If set to 0, will still return parsed argv even if there are parsing errors
  (reported by Getopt::Long). If set to 1 (the default), will die upon error.
  
  Normally you would want to use strict mode, for more error checking. Setting off
  strict is used by, for example, Perinci::Sub::Complete during completion where
  the command-line might still be incomplete.
  
  Should probably be named `ignore_errors`. :-)
  
  _
          },
          per_arg_yaml => {
              schema => ['bool' => {default=>0}],
              summary => 'Whether to recognize --ARGNAME-yaml',
              description => <<'_',
  
  This is useful for example if you want to specify a value which is not
  expressible from the command-line, like 'undef'.
  
      % script.pl --name-yaml '~'
  
  See also: per_arg_json. You should enable just one instead of turning on both.
  
  _
          },
          per_arg_json => {
              schema => ['bool' => {default=>0}],
              summary => 'Whether to recognize --ARGNAME-json',
              description => <<'_',
  
  This is useful for example if you want to specify a value which is not
  expressible from the command-line, like 'undef'.
  
      % script.pl --name-json 'null'
  
  But every other string will need to be quoted:
  
      % script.pl --name-json '"foo"'
  
  See also: per_arg_yaml. You should enable just one instead of turning on both.
  
  _
          },
          common_opts => {
              summary => 'Common options',
              description => <<'_',
  
  A hash where the values are hashes containing these keys: `getopt` (Getopt::Long
  option specification), `handler` (Getopt::Long handler). Will be passed to
  `get_args_from_argv()`. Example:
  
      {
          help => {
              getopt  => 'help|h|?',
              handler => sub { ... },
              summary => 'Display help and exit',
          },
          version => {
              getopt  => 'version|v',
              handler => sub { ... },
              summary => 'Display version and exit',
          },
      }
  
  _
              schema => ['hash*'],
          },
          allow_extra_elems => {
              schema => ['bool' => {default=>0}],
              summary => 'Allow extra/unassigned elements in argv',
              description => <<'_',
  
  If set to 1, then if there are array elements unassigned to one of the
  arguments, instead of generating an error, this function will just ignore them.
  
  This option will be passed to Perinci::Sub::GetArgs::Array's allow_extra_elems.
  
  _
          },
          on_missing_required_args => {
              schema => 'code',
              summary => 'Execute code when there is missing required args',
              description => <<'_',
  
  This can be used to give a chance to supply argument value from other sources if
  not specified by command-line options. Perinci::CmdLine, for example, uses this
  hook to supply value from STDIN or file contents (if argument has `cmdline_src`
  specification key set).
  
  This hook will be called for each missing argument. It will be supplied hash
  arguments: (arg => $the_missing_argument_name, args =>
  $the_resulting_args_so_far, spec => $the_arg_spec).
  
  The hook can return true if it succeeds in making the missing situation
  resolved. In this case, this function will not report the argument as missing.
  
  _
          },
          ignore_converted_code => {
              summary => 'Whether to ignore coderefs converted to string',
              schema => 'bool',
              default => 0,
              description => <<'_',
  
  Across network through JSON encoding, coderef in metadata (e.g. in
  `cmdline_aliases` property) usually gets converted to string `CODE`. In some
  cases, like for tab completion, this is harmless so you can turn this option on.
  
  _
          },
      },
      result => {
          description => <<'_',
  
  Error codes:
  
  * 400 - Error in Getopt::Long option specification, e.g. in common_opts.
  
  * 500 - failure in GetOptions, meaning argv is not valid according to metadata
    specification (only if 'strict' mode is enabled).
  
  * 501 - coderef in cmdline_aliases got converted into a string, probably because
    the metadata was transported (e.g. through Riap::HTTP/Riap::Simple).
  
  _
      },
  };
  sub get_args_from_argv {
      require Getopt::Long;
  
      my %fargs = @_;
      my $argv       = $fargs{argv} // \@ARGV;
      my $meta       = $fargs{meta} or return [400, "Please specify meta"];
      unless ($fargs{meta_is_normalized}) {
          require Perinci::Sub::Normalize;
          $meta = Perinci::Sub::Normalize::normalize_function_metadata($meta);
      }
      my $strict            = $fargs{strict} // 1;
      my $common_opts       = $fargs{common_opts} // {};
      my $per_arg_yaml      = $fargs{per_arg_yaml} // 0;
      my $per_arg_json      = $fargs{per_arg_json} // 0;
      my $allow_extra_elems = $fargs{allow_extra_elems} // 0;
      my $on_missing        = $fargs{on_missing_required_args};
      my $ignore_converted_code = $fargs{ignore_converted_code};
  
      my $rargs = $fargs{args} // {};
  
      my $genres = gen_getopt_long_spec_from_meta(
          meta => $meta, meta_is_normalized => 1,
          args => $rargs,
          common_opts  => $common_opts,
          per_arg_json => $per_arg_json,
          per_arg_yaml => $per_arg_yaml,
          ignore_converted_code => $ignore_converted_code,
      );
      return err($genres->[0], "Can't generate Getopt::Long spec", $genres)
          if $genres->[0] != 200;
      my $go_spec = $genres->[2];
  
      {
          local $SIG{__WARN__} = sub{} if !$strict;
          my $old_go_conf = Getopt::Long::Configure(
              $strict ? "no_pass_through" : "pass_through",
              "no_ignore_case", "permute", "bundling", "no_getopt_compat");
          my $res = Getopt::Long::GetOptionsFromArray($argv, %$go_spec);
          Getopt::Long::Configure($old_go_conf);
          unless ($res) {
              return [500, "GetOptions failed"] if $strict;
          }
      }
  
  
      my $args_prop = $meta->{args};
  
      if (@$argv) {
          my $res = get_args_from_array(
              array=>$argv, meta => $meta,
              meta_is_normalized => 1,
              allow_extra_elems => $allow_extra_elems,
          );
          if ($res->[0] != 200 && $strict) {
              return err(500, "Get args from array failed", $res);
          } elsif ($strict && $res->[0] != 200) {
              return err("Can't get args from argv", $res);
          } elsif ($res->[0] == 200) {
              my $pos_args = $res->[2];
              for my $name (keys %$pos_args) {
                  my $arg_spec = $args_prop->{$name};
                  my $val      = $pos_args->{$name};
                  if (exists $rargs->{$name}) {
                      return [400, "You specified option --$name but also ".
                                  "argument #".$arg_spec->{pos}] if $strict;
                  }
                  my $type = $arg_spec->{schema}[0];
                  my $cs   = $arg_spec->{schema}[1];
                  my $is_simple_scalar = $type =~ $re_simple_scalar;
                  my $is_array_of_simple_scalar = $type eq 'array' &&
                      $cs->{of} && $cs->{of}[0] =~ $re_simple_scalar;
  
                  if ($arg_spec->{greedy} && ref($val) eq 'ARRAY' &&
                          !$is_array_of_simple_scalar) {
                      my $i = 0;
                      for (@$val) {
                        TRY_PARSING_AS_JSON_YAML:
                          {
                              my ($success, $e, $decoded);
                              if ($per_arg_json) {
                                  ($success, $e, $decoded) = _parse_json($_);
                                  if ($success) {
                                      $_ = $decoded;
                                      last TRY_PARSING_AS_JSON_YAML;
                                  } else {
                                      warn "Failed trying to parse argv #$i as JSON: $e";
                                  }
                              }
                              if ($per_arg_yaml) {
                                  ($success, $e, $decoded) = _parse_yaml($_);
                                  if ($success) {
                                      $_ = $decoded;
                                      last TRY_PARSING_AS_JSON_YAML;
                                  } else {
                                      warn "Failed trying to parse argv #$i as YAML: $e";
                                  }
                              }
                          }
                          $i++;
                      }
                  }
                  if (!$arg_spec->{greedy} && !$is_simple_scalar) {
                    TRY_PARSING_AS_JSON_YAML:
                      {
                          my ($success, $e, $decoded);
                          if ($per_arg_json) {
                              ($success, $e, $decoded) = _parse_json($val);
                              if ($success) {
                                  $val = $decoded;
                                  last TRY_PARSING_AS_JSON_YAML;
                              } else {
                                  warn "Failed trying to parse argv #$arg_spec->{pos} as JSON: $e";
                              }
                          }
                          if ($per_arg_yaml) {
                              ($success, $e, $decoded) = _parse_yaml($val);
                              if ($success) {
                                  $val = $decoded;
                                  last TRY_PARSING_AS_JSON_YAML;
                              } else {
                                  warn "Failed trying to parse argv #$arg_spec->{pos} as YAML: $e";
                              }
                          }
                      }
                  }
                  $rargs->{$name} = $val;
                  if ($arg_spec->{cmdline_on_getopt}) {
                      if ($arg_spec->{greedy}) {
                          $arg_spec->{cmdline_on_getopt}->(
                              arg=>$name, fqarg=>$name, value=>$_, args=>$rargs,
                              opt=>undef, 
                          ) for @$val;
                      } else {
                          $arg_spec->{cmdline_on_getopt}->(
                              arg=>$name, fqarg=>$name, value=>$val, args=>$rargs,
                              opt=>undef, 
                          );
                      }
                  }
              }
          }
      }
  
  
      my %missing_args;
      for my $arg (keys %$args_prop) {
          my $arg_spec = $args_prop->{$arg};
          if (!exists($rargs->{$arg})) {
              next unless $arg_spec->{req};
              if ($on_missing) {
                  next if $on_missing->(arg=>$arg, args=>$rargs, spec=>$arg_spec);
              }
              next if exists $rargs->{$arg};
              $missing_args{$arg} = 1;
          }
      }
  
      {
          last unless $strict;
  
          for my $arg (keys %$args_prop) {
              my $arg_spec = $args_prop->{$arg};
              next unless exists $rargs->{$arg};
              next unless $arg_spec->{deps};
              my $dep_arg = $arg_spec->{deps}{arg};
              next unless $dep_arg;
              return [400, "You specify '$arg', but don't specify '$dep_arg' ".
                          "(upon which '$arg' depends)"]
                  unless exists $rargs->{$dep_arg};
          }
      }
  
      {
          last unless $strict;
  
          last unless $meta->{args_groups};
          my @specified_args = sort keys %$rargs;
          for my $group_spec (@{ $meta->{args_groups} }) {
              my $group_args = $group_spec->{args};
              next unless @$group_args > 1;
              my $rel = $group_spec->{rel};
              my @args_in_group = grep {my $arg = $_; first {$_ eq $arg} @$group_args} @specified_args;
              if ($rel eq 'one_of') {
                  next unless @args_in_group;
                  if (@args_in_group > 1) {
                      my $first_arg = shift @args_in_group;
                      return [
                          400, join(
                              "",
                              "You specify '$first_arg', but also specify ",
                              join(", ", map {"'$_'"} @args_in_group),
                              " (only one can be specified)",
                          )];
                  }
              } elsif ($rel eq 'all') {
                  next unless @args_in_group;
                  if (@args_in_group < @$group_args) {
                      my @missing = grep {my $arg = $_; !(first {$_ eq $arg} @specified_args)} @$group_args;
                      return [
                          400, join(
                              "",
                              "You specify ",
                              join(", ", map {"'$_'"} @args_in_group),
                              ", but don't specify ",
                              join(", ", map {"'$_'"} @missing),
                              " (they must all be specified together)",
                          )];
                  }
              } else {
                  die "BUG: Unknown rel '$rel' in args_groups" .
                      ", only one_of/all is supported";
              }
          }
      }
  
      [200, "OK", $rargs, {
          "func.missing_args" => [sort keys %missing_args],
          "func.gen_getopt_long_spec_result" => $genres,
      }];
  }
  
  1;
  
  __END__
  
PERINCI_SUB_GETARGS_ARGV

$fatpacked{"Perinci/Sub/GetArgs/Array.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PERINCI_SUB_GETARGS_ARRAY';
  package Perinci::Sub::GetArgs::Array;
  
  use 5.010001;
  use strict;
  use warnings;
  
  use Exporter;
  our @ISA = qw(Exporter);
  our @EXPORT_OK = qw(get_args_from_array);
  
  our $VERSION = '0.14'; 
  
  our %SPEC;
  
  $SPEC{get_args_from_array} = {
      v => 1.1,
      summary => 'Get subroutine arguments (%args) from array',
      description => <<'_',
  
  Using information in metadata's `args` property (particularly the `pos` and
  `greedy` arg type clauses), extract arguments from an array into a hash
  `\%args`, suitable for passing into subs.
  
  Example:
  
      my $meta = {
          v => 1.1,
          summary => 'Multiply 2 numbers (a & b)',
          args => {
              a => {schema=>'num*', pos=>0},
              b => {schema=>'num*', pos=>1},
          }
      }
  
  then `get_args_from_array(array=>[2, 3], meta=>$meta)` will produce:
  
      [200, "OK", {a=>2, b=>3}]
  
  _
      args => {
          array => {
              schema => ['array*' => {}],
              req => 1,
              description => <<'_',
  
  NOTE: array will be modified/emptied (elements will be taken from the array as
  they are put into the resulting args). Copy your array first if you want to
  preserve its content.
  
  _
          },
          meta => {
              schema => ['hash*' => {}],
              req => 1,
          },
          meta_is_normalized => {
              summary => 'Can be set to 1 if your metadata is normalized, '.
                  'to avoid duplicate effort',
              schema => 'bool',
              default => 0,
          },
          allow_extra_elems => {
              schema => ['bool' => {default=>0}],
              summary => 'Allow extra/unassigned elements in array',
              description => <<'_',
  
  If set to 1, then if there are array elements unassigned to one of the arguments
  (due to missing `pos`, for example), instead of generating an error, the
  function will just ignore them.
  
  _
          },
      },
  };
  sub get_args_from_array {
      my %fargs = @_;
      my $ary  = $fargs{array} or return [400, "Please specify array"];
      my $meta = $fargs{meta} or return [400, "Please specify meta"];
      unless ($fargs{meta_is_normalized}) {
          require Perinci::Sub::Normalize;
          $meta = Perinci::Sub::Normalize::normalize_function_metadata(
              $meta);
      }
      my $allow_extra_elems = $fargs{allow_extra_elems} // 0;
  
      my $rargs = {};
  
      my $args_p = $meta->{args} // {};
      for my $i (reverse 0..@$ary-1) {
          while (my ($a, $as) = each %$args_p) {
              my $o = $as->{pos};
              if (defined($o) && $o == $i) {
                  if ($as->{greedy}) {
                      my $type = $as->{schema}[0];
                      my @elems = splice(@$ary, $i);
                      if ($type eq 'array') {
                          $rargs->{$a} = \@elems;
                      } else {
                          $rargs->{$a} = join " ", @elems;
                      }
                  } else {
                      $rargs->{$a} = splice(@$ary, $i, 1);
                  }
              }
          }
      }
  
      return [400, "There are extra, unassigned elements in array: [".
                  join(", ", @$ary)."]"] if @$ary && !$allow_extra_elems;
  
      [200, "OK", $rargs];
  }
  
  1;
  
  __END__
  
PERINCI_SUB_GETARGS_ARRAY

$fatpacked{"Perinci/Sub/Normalize.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PERINCI_SUB_NORMALIZE';
  package Perinci::Sub::Normalize;
  
  our $DATE = '2015-01-07'; 
  our $VERSION = '0.09'; 
  
  use 5.010001;
  use strict;
  use warnings;
  
  require Exporter;
  our @ISA = qw(Exporter);
  our @EXPORT_OK = qw(
                         normalize_function_metadata
                 );
  
  use Sah::Schema::Rinci;
  my $sch = $Sah::Schema::Rinci::SCHEMAS{rinci_function}
      or die "BUG: Rinci schema structure changed (1)";
  my $sch_proplist = $sch->[1]{_prop}
      or die "BUG: Rinci schema structure changed (2)";
  
  sub _normalize{
      my ($meta, $ver, $opts, $proplist, $nmeta, $prefix, $modprefix) = @_;
  
      my $opt_aup = $opts->{allow_unknown_properties};
      my $opt_nss = $opts->{normalize_sah_schemas};
      my $opt_rip = $opts->{remove_internal_properties};
  
      if (defined $ver) {
          defined($meta->{v}) && $meta->{v} eq $ver
              or die "$prefix: Metadata version must be $ver";
      }
  
    KEY:
      for my $k (keys %$meta) {
  
          if ($k =~ /\.(\w+)\z/) {
              my $attr = $1;
              unless ($attr =~ /\A_/ && $opt_rip) {
                  $nmeta->{$k} = $meta->{$k};
              }
              next KEY;
          }
  
          my $prop = $k;
          my $prop_proplist = $proplist->{$prop};
          if ($prop =~ /\A_/) {
              unless ($opt_rip) {
                  $nmeta->{$prop} = $meta->{$k};
              }
              next KEY;
          }
          if (!$opt_aup && !$prop_proplist) {
              if ($prop =~ /\A[A-Za-z][A-Za-z0-9_]*\z/) {
                  $modprefix //= $prefix;
                  my $mod = "Perinci/Sub/Property$modprefix/$prop.pm";
                  eval { require $mod };
                  if ($@) {
                      die "Unknown property '$prefix/$prop' (and couldn't ".
                          "load property module '$mod'): $@" if $@;
                  }
                  $prop_proplist = $proplist->{$prop};
              }
              die "Unknown property '$prefix/$prop'"
                  unless $prop_proplist;
          }
          if ($prop_proplist && $prop_proplist->{_prop}) {
              die "Property '$prefix/$prop' must be a hash"
                  unless ref($meta->{$k}) eq 'HASH';
              $nmeta->{$k} = {};
              _normalize(
                  $meta->{$k},
                  $prop_proplist->{_ver},
                  $opts,
                  $prop_proplist->{_prop},
                  $nmeta->{$k},
                  "$prefix/$prop",
              );
          } elsif ($prop_proplist && $prop_proplist->{_elem_prop}) {
              die "Property '$prefix/$prop' must be an array"
                  unless ref($meta->{$k}) eq 'ARRAY';
              $nmeta->{$k} = [];
              my $i = 0;
              for (@{ $meta->{$k} }) {
                  my $href = {};
                  if (ref($_) eq 'HASH') {
                      _normalize(
                          $_,
                          $prop_proplist->{_ver},
                          $opts,
                          $prop_proplist->{_elem_prop},
                          $href,
                          "$prefix/$prop/$i",
                      );
                      push @{ $nmeta->{$k} }, $href;
                  } else {
                      push @{ $nmeta->{$k} }, $_;
                  }
                  $i++;
              }
          } elsif ($prop_proplist && $prop_proplist->{_value_prop}) {
              die "Property '$prefix/$prop' must be a hash"
                  unless ref($meta->{$k}) eq 'HASH';
              $nmeta->{$k} = {};
              for (keys %{ $meta->{$k} }) {
                  $nmeta->{$k}{$_} = {};
                  die "Property '$prefix/$prop/$_' must be a hash"
                      unless ref($meta->{$k}{$_}) eq 'HASH';
                  _normalize(
                      $meta->{$k}{$_},
                      $prop_proplist->{_ver},
                      $opts,
                      $prop_proplist->{_value_prop},
                      $nmeta->{$k}{$_},
                      "$prefix/$prop/$_",
                      ($prop eq 'args' ? "$prefix/arg" : undef),
                  );
              }
          } else {
              if ($k eq 'schema' && $opt_nss) { 
                  require Data::Sah::Normalize;
                  $nmeta->{$k} = Data::Sah::Normalize::normalize_schema(
                      $meta->{$k});
              } else {
                  $nmeta->{$k} = $meta->{$k};
              }
          }
      }
  
      $nmeta;
  }
  
  sub normalize_function_metadata {
      my ($meta, $opts) = @_;
  
      $opts //= {};
  
      $opts->{allow_unknown_properties}    //= 0;
      $opts->{normalize_sah_schemas}       //= 1;
      $opts->{remove_internal_properties}  //= 0;
  
      _normalize($meta, 1.1, $opts, $sch_proplist, {}, '');
  }
  
  1;
  
  __END__
  
PERINCI_SUB_NORMALIZE

$fatpacked{"Perinci/Sub/To/CLIDocData.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PERINCI_SUB_TO_CLIDOCDATA';
  package Perinci::Sub::To::CLIDocData;
  
  our $DATE = '2015-04-07'; 
  our $VERSION = '0.20'; 
  
  use 5.010001;
  use strict;
  use warnings;
  
  use Perinci::Object;
  use Perinci::Sub::Util qw(err);
  
  our %SPEC;
  
  require Exporter;
  our @ISA = qw(Exporter);
  our @EXPORT_OK = qw(gen_cli_doc_data_from_meta);
  
  sub _has_cats {
      for my $spec (@{ $_[0] }) {
          for (@{ $spec->{tags} // [] }) {
              my $tag_name = ref($_) ? $_->{name} : $_;
              if ($tag_name =~ /^category:/) {
                  return 1;
              }
          }
      }
      0;
  }
  
  sub _add_category_from_spec {
      my ($cats_spec, $thing, $spec, $noun, $has_cats) = @_;
      my $cat;
      my $raw_cat = '';
      my $order;
      for (@{ $spec->{tags} // [] }) {
          my $tag_name = ref($_) ? $_->{name} : $_;
          if ($tag_name =~ /^category:(.+)/) {
              $raw_cat = $1;
  
              $cat = ucfirst($1);
              $cat =~ s/-/ /g;
              $cat .= " " . $noun;
              $order = 50;
              last;
          }
      }
      $cat //= $has_cats ? "Other $noun" : ucfirst($noun); 
      $order //= 99;
      $thing->{category} = $cat;
      $cats_spec->{$cat}{order} //= $order;
  }
  
  sub _add_default_from_arg_spec {
      my ($opt, $arg_spec) = @_;
      if (exists $arg_spec->{default}) {
          $opt->{default} = $arg_spec->{default};
      } elsif ($arg_spec->{schema} && exists($arg_spec->{schema}[1]{default})) {
          $opt->{default} = $arg_spec->{schema}[1]{default};
      }
  }
  
  sub _dash_prefix {
      length($_[0]) > 1 ? "--$_[0]" : "-$_[0]";
  }
  
  sub _fmt_opt {
      my $spec = shift;
      my @ospecs = @_;
      my @res;
      my $i = 0;
      for my $ospec (@ospecs) {
          my $j = 0;
          my $parsed = $ospec->{parsed};
          for (@{ $parsed->{opts} }) {
              my $opt = _dash_prefix($_);
              if ($i==0 && $j==0) {
                  if ($parsed->{type}) {
                      if ($spec->{'x.schema.entity'}) {
                          $opt .= "=".$spec->{'x.schema.entity'};
                      } elsif ($spec->{'x.schema.element_entity'}) {
                          $opt .= "=".$spec->{'x.schema.element_entity'};
                      } else {
                          $opt .= "=$parsed->{type}";
                      }
                  }
                  $opt .= "*" if $spec->{req} && !$ospec->{is_base64} &&
                      !$ospec->{is_json} && !$ospec->{is_yaml};
              }
              push @res, $opt;
              $j++;
          }
          $i++;
      }
      join ", ", @res;
  }
  
  $SPEC{gen_cli_doc_data_from_meta} = {
      v => 1.1,
      summary => 'From Rinci function metadata, generate structure convenient '.
          'for producing CLI documentation (help/usage/POD)',
      description => <<'_',
  
  This function calls `Perinci::Sub::GetArgs::Argv`'s
  `gen_getopt_long_spec_from_meta()` (or receive its result as an argument, if
  passed, to avoid calling the function twice) and post-processes it: produce
  command usage line, format the options, include information from metadata, group
  the options by category. It also selects examples in the `examples` property
  which are applicable to CLI environment and format them.
  
  The resulting data structure is convenient to use when one wants to produce a
  documentation for CLI program (including help/usage message and POD).
  
  _
      args => {
          meta => {
              schema => 'hash*', 
              req => 1,
              pos => 0,
          },
          meta_is_normalized => {
              schema => 'bool*',
          },
          common_opts => {
              summary => 'Will be passed to gen_getopt_long_spec_from_meta()',
              schema  => 'hash*',
          },
          ggls_res => {
              summary => 'Full result from gen_getopt_long_spec_from_meta()',
              schema  => 'array*', 
              description => <<'_',
  
  If you already call `Perinci::Sub::GetArgs::Argv`'s
  `gen_getopt_long_spec_from_meta()`, you can pass the _full_ enveloped result
  here, to avoid calculating twice. What will be useful for the function is the
  extra result in result metadata (`func.*` keys in `$res->[3]` hash).
  
  _
          },
          per_arg_json => {
              schema => 'bool',
              summary => 'Pass per_arg_json=1 to Perinci::Sub::GetArgs::Argv',
          },
          per_arg_yaml => {
              schema => 'bool',
              summary => 'Pass per_arg_json=1 to Perinci::Sub::GetArgs::Argv',
          },
          lang => {
              schema => 'str*',
          },
      },
      result => {
          schema => 'hash*',
      },
  };
  sub gen_cli_doc_data_from_meta {
      require Getopt::Long::Negate::EN;
  
      my %args = @_;
  
      my $lang = $args{lang};
      my $meta = $args{meta} or return [400, 'Please specify meta'];
      my $common_opts = $args{common_opts};
      unless ($args{meta_is_normalized}) {
          require Perinci::Sub::Normalize;
          $meta = Perinci::Sub::Normalize::normalize_function_metadata($meta);
      }
      my $ggls_res = $args{ggls_res} // do {
          require Perinci::Sub::GetArgs::Argv;
          Perinci::Sub::GetArgs::Argv::gen_getopt_long_spec_from_meta(
              meta=>$meta, meta_is_normalized=>1, common_opts=>$common_opts,
              per_arg_json => $args{per_arg_json},
              per_arg_yaml => $args{per_arg_yaml},
          );
      };
      $ggls_res->[0] == 200 or return $ggls_res;
  
      my $args_prop = $meta->{args} // {};
      my $clidocdata = {
          option_categories => {},
          example_categories => {},
      };
  
      {
          my @args;
          my %args_prop = %$args_prop; 
          my $max_pos = -1;
          for (values %args_prop) {
              $max_pos = $_->{pos}
                  if defined($_->{pos}) && $_->{pos} > $max_pos;
          }
          my $pos = 0;
          while ($pos <= $max_pos) {
              my ($arg, $arg_spec);
              for (keys %args_prop) {
                  $arg_spec = $args_prop{$_};
                  if (defined($arg_spec->{pos}) && $arg_spec->{pos}==$pos) {
                      $arg = $_;
                      last;
                  }
              }
              $pos++;
              next unless defined($arg);
              if ($arg_spec->{req}) {
                  push @args, "<$arg>";
              } else {
                  push @args, "[$arg]";
              }
              $args[-1] .= "..." if $arg_spec->{greedy};
              delete $args_prop{$arg};
          }
          unshift @args, "[options]" if keys(%args_prop) || keys(%$common_opts); 
          $clidocdata->{usage_line} = "[[prog]]".
              (@args ? " ".join(" ", @args) : "");
      }
  
      my %opts;
      {
          my $ospecs = $ggls_res->[3]{'func.specmeta'};
          my (@k, @k_aliases);
        OSPEC1:
          for (sort keys %$ospecs) {
              my $ospec = $ospecs->{$_};
              {
                  last unless $ospec->{is_alias};
                  next if $ospec->{is_code};
                  my $arg_spec = $args_prop->{$ospec->{arg}};
                  my $alias_spec = $arg_spec->{cmdline_aliases}{$ospec->{alias}};
                  next if $alias_spec->{summary};
                  push @k_aliases, $_;
                  next OSPEC1;
              }
              push @k, $_;
          }
  
          my %negs; 
  
        OSPEC2:
          while (@k) {
              my $k = shift @k;
              my $ospec = $ospecs->{$k};
              my $opt;
              my $optkey;
  
              if ($ospec->{is_alias} || defined($ospec->{arg})) {
                  my $arg_spec;
                  my $alias_spec;
  
                  if ($ospec->{is_alias}) {
  
                      $arg_spec = $args_prop->{ $ospec->{arg} };
                      $alias_spec = $arg_spec->{cmdline_aliases}{$ospec->{alias}};
                      my $rimeta = rimeta($alias_spec);
                      $optkey = _fmt_opt($arg_spec, $ospec);
                      $opt = {
                          opt_parsed => $ospec->{parsed},
                          orig_opt => $k,
                          is_alias => 1,
                          alias_for => $ospec->{alias_for},
                          summary => $rimeta->langprop({lang=>$lang}, 'summary') //
                              "Alias for "._dash_prefix($ospec->{parsed}{opts}[0]),
                          description =>
                              $rimeta->langprop({lang=>$lang}, 'description'),
                      };
                  } else {
  
                      $arg_spec = $args_prop->{$ospec->{arg}};
                      my $rimeta = rimeta($arg_spec);
                      $opt = {
                          opt_parsed => $ospec->{parsed},
                          orig_opt => $k,
                      };
  
                      if (defined($ospec->{is_neg})) {
                          my $default = $arg_spec->{default} //
                              $arg_spec->{schema}[1]{default};
                          next OSPEC2 if  $default && !$ospec->{is_neg};
                          next OSPEC2 if !$default &&  $ospec->{is_neg};
                          if ($ospec->{is_neg}) {
                              next OSPEC2 if $negs{$ospec->{arg}}++;
                          }
                      }
  
                      if ($ospec->{is_neg}) {
                          $opt->{summary} =
                              $rimeta->langprop({lang=>$lang}, 'summary.alt.bool.not');
                      } elsif (defined $ospec->{is_neg}) {
                          $opt->{summary} =
                              $rimeta->langprop({lang=>$lang}, 'summary.alt.bool.yes') //
                                  $rimeta->langprop({lang=>$lang}, 'summary');
                      } elsif (($ospec->{parsed}{type}//'') eq 's@') {
                          $opt->{summary} =
                              $rimeta->langprop({lang=>$lang}, 'summary.alt.plurality.singular') //
                                  $rimeta->langprop({lang=>$lang}, 'summary');
                      } else {
                          $opt->{summary} =
                              $rimeta->langprop({lang=>$lang}, 'summary');
                      }
                      $opt->{description} =
                          $rimeta->langprop({lang=>$lang}, 'description');
  
                      my @aliases;
                      my $j = $#k_aliases;
                      while ($j >= 0) {
                          my $aospec = $ospecs->{ $k_aliases[$j] };
                          {
                              last unless $aospec->{arg} eq $ospec->{arg};
                              push @aliases, $aospec;
                              splice @k_aliases, $j, 1;
                          }
                          $j--;
                      }
  
                      $optkey = _fmt_opt($arg_spec, $ospec, @aliases);
                  }
  
                  $opt->{arg_spec} = $arg_spec;
                  $opt->{alias_spec} = $alias_spec if $alias_spec;
  
                  for (qw/arg fqarg is_base64 is_json is_yaml/) {
                      $opt->{$_} = $ospec->{$_} if defined $ospec->{$_};
                  }
  
                  for (qw/req pos greedy is_password links tags/) {
                      $opt->{$_} = $arg_spec->{$_} if defined $arg_spec->{$_};
                  }
  
                  _add_category_from_spec($clidocdata->{option_categories},
                                          $opt, $arg_spec, "options", 1);
                  _add_default_from_arg_spec($opt, $arg_spec);
  
              } else {
  
                  my $spec = $common_opts->{$ospec->{common_opt}};
  
                  my $show_neg = $ospec->{parsed}{is_neg} && $spec->{default};
  
                  local $ospec->{parsed}{opts} = do {
                      my @opts = Getopt::Long::Negate::EN::negations_for_option(
                          $ospec->{parsed}{opts}[0]);
                      [ $opts[0] ];
                  } if $show_neg;
  
                  $optkey = _fmt_opt($spec, $ospec);
                  my $rimeta = rimeta($spec);
                  $opt = {
                      opt_parsed => $ospec->{parsed},
                      orig_opt => $k,
                      common_opt => $ospec->{common_opt},
                      common_opt_spec => $spec,
                      summary => $show_neg ?
                          $rimeta->langprop({lang=>$lang}, 'summary.alt.bool.not') :
                              $rimeta->langprop({lang=>$lang}, 'summary'),
                      (schema => $spec->{schema}) x !!$spec->{schema},
                      ('x.schema.entity' => $spec->{'x.schema.entity'}) x !!$spec->{'x.schema.entity'},
                      ('x.schema.element_entity' => $spec->{'x.schema.element_entity'}) x !!$spec->{'x.schema.element_entity'},
                      description =>
                          $rimeta->langprop({lang=>$lang}, 'description'),
                      (default => $spec->{default}) x !!(exists($spec->{default}) && !$show_neg),
                  };
  
                  _add_category_from_spec($clidocdata->{option_categories},
                                          $opt, $spec, "options", 1);
  
              }
  
              $opts{$optkey} = $opt;
          }
  
        OPT1:
          for my $k (keys %opts) {
              my $opt = $opts{$k};
              next unless $opt->{is_alias} || $opt->{is_base64} ||
                  $opt->{is_json} || $opt->{is_yaml};
              for my $k2 (keys %opts) {
                  my $arg_opt = $opts{$k2};
                  next if $arg_opt->{is_alias} || $arg_opt->{is_base64} ||
                      $arg_opt->{is_json} || $arg_opt->{is_yaml};
                  next unless defined($arg_opt->{arg}) &&
                      $arg_opt->{arg} eq $opt->{arg};
                  $opt->{main_opt} = $k2;
                  next OPT1;
              }
          }
  
      }
      $clidocdata->{opts} = \%opts;
  
      my @examples;
      {
          my $examples = $meta->{examples} // [];
          my $has_cats = _has_cats($examples);
  
          for my $eg (@$examples) {
              my $rimeta = rimeta($eg);
              my $argv;
              my $cmdline;
              if (defined($eg->{src})) {
                  if ($eg->{src_plang} =~ /^(sh|bash)$/) {
                      $cmdline = $eg->{src};
                  } else {
                      next;
                  }
              } else {
                  require String::ShellQuote;
                  if ($eg->{argv}) {
                      $argv = $eg->{argv};
                  } else {
                      require Perinci::Sub::ConvertArgs::Argv;
                      my $res = Perinci::Sub::ConvertArgs::Argv::convert_args_to_argv(
                          args => $eg->{args}, meta => $meta);
                      return err($res, 500, "Can't convert args to argv")
                          unless $res->[0] == 200;
                      $argv = $res->[2];
                  }
                  $cmdline = "[[prog]]";
                  for my $arg (@$argv) {
                      $arg = String::ShellQuote::shell_quote($arg);
                      $cmdline .= " $arg"; 
                  }
              }
              my $egdata = {
                  cmdline      => $cmdline,
                  summary      => $rimeta->langprop({lang=>$lang}, 'summary'),
                  description  => $rimeta->langprop({lang=>$lang}, 'description'),
                  example_spec => $eg,
              };
              _add_category_from_spec($clidocdata->{example_categories},
                                      $egdata, $eg, "examples", $has_cats);
              push @examples, $egdata;
          }
      }
      $clidocdata->{examples} = \@examples;
  
      [200, "OK", $clidocdata];
  }
  
  1;
  
  __END__
  
PERINCI_SUB_TO_CLIDOCDATA

$fatpacked{"Perinci/Sub/Util.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PERINCI_SUB_UTIL';
  package Perinci::Sub::Util;
  
  our $DATE = '2015-01-04'; 
  our $VERSION = '0.41'; 
  
  use 5.010001;
  use strict;
  use warnings;
  
  require Exporter;
  our @ISA = qw(Exporter);
  our @EXPORT_OK = qw(
                         err
                         caller
                         gen_modified_sub
                         warn_err
                         die_err
                 );
  
  our %SPEC;
  
  $SPEC{':package'} = {
      v => 1.1,
      summary => 'Helper when writing functions',
  };
  
  our $STACK_TRACE;
  our @_c; 
  our $_i; 
  sub err {
      require Scalar::Util;
  
      my @caller = CORE::caller(1);
      if (!@caller) {
          @caller = ("main", "-e", 1, "program");
      }
  
      my ($status, $msg, $meta, $prev);
  
      for (@_) {
          my $ref = ref($_);
          if ($ref eq 'ARRAY') { $prev = $_ }
          elsif ($ref eq 'HASH') { $meta = $_ }
          elsif (!$ref) {
              if (Scalar::Util::looks_like_number($_)) {
                  $status = $_;
              } else {
                  $msg = $_;
              }
          }
      }
  
      $status //= 500;
      $msg  //= "$caller[3] failed";
      $meta //= {};
      $meta->{prev} //= $prev if $prev;
  
      if (!$meta->{logs}) {
  
          my $stack_trace;
          {
              no warnings;
              last unless $STACK_TRACE // $INC{"Carp/Always.pm"};
              last if $prev && ref($prev->[3]) eq 'HASH' &&
                  ref($prev->[3]{logs}) eq 'ARRAY' &&
                      ref($prev->[3]{logs}[0]) eq 'HASH' &&
                          $prev->[3]{logs}[0]{stack_trace};
              $stack_trace = [];
              $_i = 1;
              while (1) {
                  {
                      package DB;
                      @_c = CORE::caller($_i);
                      if (@_c) {
                          $_c[4] = [@DB::args];
                      }
                  }
                  last unless @_c;
                  push @$stack_trace, [@_c];
                  $_i++;
              }
          }
          push @{ $meta->{logs} }, {
              type    => 'create',
              time    => time(),
              package => $caller[0],
              file    => $caller[1],
              line    => $caller[2],
              func    => $caller[3],
              ( stack_trace => $stack_trace ) x !!$stack_trace,
          };
      }
  
      [$status, $msg, undef, $meta];
  }
  
  sub caller {
      my $n0 = shift;
      my $n  = $n0 // 0;
  
      my $pkg = $Perinci::Sub::Wrapper::default_wrapped_package //
          'Perinci::Sub::Wrapped';
  
      my @r;
      my $i =  0;
      my $j = -1;
      while ($i <= $n+1) { 
          $j++;
          @r = CORE::caller($j);
          last unless @r;
          if ($r[0] eq $pkg && $r[1] =~ /^\(eval /) {
              next;
          }
          $i++;
      }
  
      return unless @r;
      return defined($n0) ? @r : $r[0];
  }
  
  $SPEC{gen_modified_sub} = {
      v => 1.1,
      summary => 'Generate modified metadata (and subroutine) based on another',
      description => <<'_',
  
  Often you'll want to create another sub (and its metadata) based on another, but
  with some modifications, e.g. add/remove/rename some arguments, change summary,
  add/remove some properties, and so on.
  
  Instead of cloning the Rinci metadata and modify it manually yourself, this
  routine provides some shortcuts.
  
  You can specify base sub/metadata using `base_name` (string, subroutine name,
  either qualified or not) or `base_code` (coderef) + `base_meta` (hash).
  
  _
      args => {
          base_name => {
              summary => 'Subroutine name (either qualified or not)',
              schema => 'str*',
              description => <<'_',
  
  If not qualified with package name, will be searched in the caller's package.
  Rinci metadata will be searched in `%SPEC` package variable.
  
  Alternatively, you can also specify `base_code` and `base_meta`.
  
  _
          },
          base_code => {
              summary => 'Base subroutine code',
              schema  => 'code*',
              description => <<'_',
  
  If you specify this, you'll also need to specify `base_meta`.
  
  Alternatively, you can specify `base_name` instead, to let this routine search
  the base subroutine from existing Perl package.
  
  _
          },
          base_meta => {
              summary => 'Base Rinci metadata',
              schema  => 'hash*', 
          },
          output_name => {
              summary => 'Where to install the modified sub',
              schema  => 'str*',
              description => <<'_',
  
  Subroutine will be put in the specified name. If the name is not qualified with
  package name, will use caller's package. If no `output_code` is specified, the
  base subroutine reference will be assigned here.
  
  Note that this argument is optional.
  
  _
          },
          output_code => {
              summary => 'Code for the modified sub',
              schema  => 'code*',
              description => <<'_',
  
  If not specified will use `base_code` (which will then be required).
  
  _
          },
          summary => {
              summary => 'Summary for the mod subroutine',
              schema  => 'str*',
          },
          description => {
              summary => 'Description for the mod subroutine',
              schema  => 'str*',
          },
          remove_args => {
              summary => 'List of arguments to remove',
              schema  => 'array*',
          },
          add_args => {
              summary => 'Arguments to add',
              schema  => 'hash*',
          },
          replace_args => {
              summary => 'Arguments to add',
              schema  => 'hash*',
          },
          rename_args => {
              summary => 'Arguments to rename',
              schema  => 'hash*',
          },
          modify_args => {
              summary => 'Arguments to modify',
              description => <<'_',
  
  For each argument you can specify a coderef. The coderef will receive the
  argument ($arg_spec) and is expected to modify the argument specification.
  
  _
              schema  => 'hash*',
          },
          modify_meta => {
              summary => 'Specify code to modify metadata',
              schema  => 'code*',
              description => <<'_',
  
  Code will be called with arguments ($meta) where $meta is the cloned Rinci
  metadata.
  
  _
          },
          install_sub => {
              schema  => 'bool',
              default => 1,
          },
      },
      result => {
          schema => ['hash*' => {
              keys => {
                  code => ['code*'],
                  meta => ['hash*'], 
              },
          }],
      },
  };
  sub gen_modified_sub {
      require Function::Fallback::CoreOrPP;
  
      my %args = @_;
  
      my ($base_code, $base_meta);
      if ($args{base_name}) {
          my ($pkg, $leaf);
          if ($args{base_name} =~ /(.+)::(.+)/) {
              ($pkg, $leaf) = ($1, $2);
          } else {
              $pkg  = CORE::caller();
              $leaf = $args{base_name};
          }
          no strict 'refs';
          $base_code = \&{"$pkg\::$leaf"};
          $base_meta = ${"$pkg\::SPEC"}{$leaf};
          die "Can't find Rinci metadata for $pkg\::$leaf" unless $base_meta;
      } elsif ($args{base_meta}) {
          $base_meta = $args{base_meta};
          $base_code = $args{base_code}
              or die "Please specify base_code";
      } else {
          die "Please specify base_name or base_code+base_meta";
      }
  
      my $output_meta = Function::Fallback::CoreOrPP::clone($base_meta);
      my $output_code = $args{output_code} // $base_code;
  
      for (qw/summary description/) {
          $output_meta->{$_} = $args{$_} if $args{$_};
      }
      if ($args{remove_args}) {
          delete $output_meta->{args}{$_} for @{ $args{remove_args} };
      }
      if ($args{add_args}) {
          for my $k (keys %{ $args{add_args} }) {
              my $v = $args{add_args}{$k};
              die "Can't add arg '$k' in mod sub: already exists"
                  if $output_meta->{args}{$k};
              $output_meta->{args}{$k} = $v;
          }
      }
      if ($args{replace_args}) {
          for my $k (keys %{ $args{replace_args} }) {
              my $v = $args{replace_args}{$k};
              die "Can't replace arg '$k' in mod sub: doesn't exist"
                  unless $output_meta->{args}{$k};
              $output_meta->{args}{$k} = $v;
          }
      }
      if ($args{rename_args}) {
          for my $old (keys %{ $args{rename_args} }) {
              my $new = $args{rename_args}{$old};
              my $as = $output_meta->{args}{$old};
              die "Can't rename arg '$old' in mod sub: doesn't exist" unless $as;
              die "Can't rename arg '$old'->'$new' in mod sub: ".
                  "new name already exist" if $output_meta->{args}{$new};
              $output_meta->{args}{$new} = $as;
              delete $output_meta->{args}{$old};
          }
      }
      if ($args{modify_args}) {
          for (keys %{ $args{modify_args} }) {
              $args{modify_args}{$_}->($output_meta->{args}{$_});
          }
      }
      if ($args{modify_meta}) {
          $args{modify_meta}->($output_meta);
      }
  
      if ($args{output_name}) {
          my ($pkg, $leaf);
          if ($args{output_name} =~ /(.+)::(.+)/) {
              ($pkg, $leaf) = ($1, $2);
          } else {
              $pkg  = CORE::caller();
              $leaf = $args{output_name};
          }
          no strict 'refs';
          no warnings 'redefine';
          *{"$pkg\::$leaf"}       = $output_code if $args{install_sub} // 1;
          ${"$pkg\::SPEC"}{$leaf} = $output_meta;
      }
  
      [200, "OK", {code=>$output_code, meta=>$output_meta}];
  }
  
  
  sub warn_err {
      require Carp;
  
      my $res = err(@_);
      Carp::carp("ERROR $res->[0]: $res->[1]");
  }
  
  sub die_err {
      require Carp;
  
      my $res = err(@_);
      Carp::croak("ERROR $res->[0]: $res->[1]");
  }
  
  1;
  
  __END__
  
PERINCI_SUB_UTIL

$fatpacked{"Regexp/Stringify.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'REGEXP_STRINGIFY';
  package Regexp::Stringify;
  
  our $DATE = '2015-01-08'; 
  our $VERSION = '0.03'; 
  
  use 5.010001;
  use strict;
  use warnings;
  
  use re qw(regexp_pattern);
  use Version::Util qw(version_ge);
  
  use Exporter;
  our @ISA = qw(Exporter);
  our @EXPORT_OK = qw(stringify_regexp);
  
  our %SPEC;
  
  $SPEC{stringify_regexp} = {
      v => 1.1,
      summary => 'Stringify a Regexp object',
      description => <<'_',
  
  This routine is an alternative to Perl's default stringification of Regexp
  object (i.e.:`"$re"`) and has some features/options, e.g.: producing regexp
  string that is compatible with certain perl versions.
  
  If given a string (or other non-Regexp object), will return it as-is.
  
  _
      args => {
          regexp => {
              schema => 're*',
              req => 1,
              pos => 0,
          },
          plver => {
              summary => 'Target perl version',
              schema => 'str*',
              description => <<'_',
  
  Try to produce a regexp object compatible with a certain perl version (should at
  least be >= 5.10).
  
  For example, in perl 5.14 regex stringification changes, e.g. `qr/hlagh/i` would
  previously be stringified as `(?i-xsm:hlagh)`, but now it's stringified as
  `(?^i:hlagh)`. If you set `plver` to 5.10 or 5.12, then this routine will
  still produce the former. It will also ignore regexp modifiers that are
  introduced in newer perls.
  
  Note that not all regexp objects will be translated to older perls, e.g. if it
  contains constructs not known to older perls.
  
  _
          },
          with_qr => {
              schema  => 'bool',
              description => <<'_',
  
  If you set this to 1, then `qr/a/i` will be stringified as `'qr/a/i'` instead as
  `'(^i:a)'`. The resulting string can then be eval-ed to recreate the Regexp
  object.
  
  _
          },
      },
      result_naked => 1,
      result => {
          schema => 'str*',
      },
  };
  sub stringify_regexp {
      my %args = @_;
  
      my $re = $args{regexp};
      return $re unless ref($re) eq 'Regexp';
      my $plver = $args{plver} // $^V;
  
      my ($pat, $mod) = regexp_pattern($re);
  
      my $ge_5140 = version_ge($plver, 5.014);
      unless ($ge_5140) {
          $mod =~ s/[adlu]//g;
      }
  
      if ($args{with_qr}) {
          return "qr($pat)$mod";
      } else {
          if ($ge_5140) {
              return "(^$mod:$pat)";
          } else {
              return "(?:(?$mod-)$pat)";
          }
      }
  }
  
  1;
  
  __END__
  
REGEXP_STRINGIFY

$fatpacked{"Regexp/Wildcards.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'REGEXP_WILDCARDS';
  package Regexp::Wildcards;
  
  use strict;
  use warnings;
  
  use Carp           qw<croak>;
  use Scalar::Util   qw<blessed>;
  use Text::Balanced qw<extract_bracketed>;
  
  
  use vars qw<$VERSION>;
  BEGIN {
   $VERSION = '1.05';
  }
  
  
  sub _check_self {
   croak 'First argument isn\'t a valid ' . __PACKAGE__ . ' object'
    unless blessed $_[0] and $_[0]->isa(__PACKAGE__);
  }
  
  my %types = (
   jokers   => [ qw<jokers> ],
   sql      => [ qw<sql> ],
   commas   => [ qw<commas> ],
   brackets => [ qw<brackets> ],
   unix     => [ qw<jokers brackets> ],
   win32    => [ qw<jokers commas> ],
  );
  $types{$_} = $types{win32} for qw<dos os2 MSWin32 cygwin>;
  $types{$_} = $types{unix}  for qw<linux
                                    darwin machten next
                                    aix irix hpux dgux dynixptx
                                    bsdos freebsd openbsd
                                    svr4 solaris sunos dec_osf
                                    sco_sv unicos unicosmk>;
  
  my %escapes = (
   jokers   => '?*',
   sql      => '_%',
   commas   => ',',
   brackets => '{},',
   groups   => '()',
   anchors  => '^$',
  );
  
  my %captures = (
   single   => sub { $_[1] ? '(.)' : '.' },
   any      => sub { $_[1] ? ($_[0]->{greedy} ? '(.*)'
                                              : '(.*?)')
                           : '.*' },
   brackets => sub { $_[1] ? '(' : '(?:'; },
   greedy   => undef,
  );
  
  sub _validate {
   my $self  = shift;
   _check_self $self;
   my $valid = shift;
   my $old   = shift;
   $old = { } unless defined $old;
  
   my %opts;
   if (@_ <= 1) {
    $opts{set} = defined $_[0] ? $_[0] : { };
   } elsif (@_ % 2) {
    croak 'Arguments must be passed as an unique scalar or as key => value pairs';
   } else {
    %opts = @_;
   }
  
   my %checked;
   for (qw<set add rem>) {
    my $opt = $opts{$_};
    next unless defined $opt;
  
    my $cb = {
     ''      => sub { +{ ($_[0] => 1) x (exists $valid->{$_[0]}) } },
     'ARRAY' => sub { +{ map { ($_ => 1) x (exists $valid->{$_}) } @{$_[0]} } },
     'HASH'  => sub { +{ map { ($_ => $_[0]->{$_}) x (exists $valid->{$_}) }
                          keys %{$_[0]} } }
    }->{ ref $opt };
    croak 'Wrong option set' unless $cb;
    $checked{$_} = $cb->($opt);
   }
  
   my $config = (exists $checked{set}) ? $checked{set} : $old;
   $config->{$_} = $checked{add}->{$_} for grep $checked{add}->{$_},
                                            keys %{$checked{add} || {}};
   delete $config->{$_}                for grep $checked{rem}->{$_},
                                            keys %{$checked{rem} || {}};
  
   $config;
  }
  
  sub _do {
   my $self = shift;
  
   my $config;
   $config->{do}      = $self->_validate(\%escapes, $self->{do}, @_);
   $config->{escape}  = '';
   $config->{escape} .= $escapes{$_} for keys %{$config->{do}};
   $config->{escape}  = quotemeta $config->{escape};
  
   $config;
  }
  
  sub do {
   my $self = shift;
   _check_self $self;
  
   my $config  = $self->_do(@_);
   $self->{$_} = $config->{$_} for keys %$config;
  
   $self;
  }
  
  sub _capture {
   my $self = shift;
  
   my $config;
   $config->{capture} = $self->_validate(\%captures, $self->{capture}, @_);
   $config->{greedy}  = delete $config->{capture}->{greedy};
   for (keys %captures) {
    $config->{'c_' . $_} = $captures{$_}->($config, $config->{capture}->{$_})
                                                 if $captures{$_}; 
   }
  
   $config;
  }
  
  sub capture {
   my $self = shift;
   _check_self $self;
  
   my $config  = $self->_capture(@_);
   $self->{$_} = $config->{$_} for keys %$config;
  
   $self;
  }
  
  sub _type {
   my ($self, $type) = @_;
   $type = 'unix'     unless defined $type;
   croak 'Wrong type' unless exists $types{$type};
  
   my $config      = $self->_do($types{$type});
   $config->{type} = $type;
  
   $config;
  }
  
  sub type {
   my $self = shift;
   _check_self $self;
  
   my $config  = $self->_type(@_);
   $self->{$_} = $config->{$_} for keys %$config;
  
   $self;
  }
  
  sub new {
   my $class = shift;
   $class    = blessed($class) || $class || __PACKAGE__;
  
   croak 'Optional arguments must be passed as key => value pairs' if @_ % 2;
   my %args = @_;
  
   my $self = bless { }, $class;
  
   if (defined $args{do}) {
    $self->do($args{do});
   } else {
    $self->type($args{type});
   }
  
   $self->capture($args{capture});
  }
  
  
  sub convert {
   my ($self, $wc, $type) = @_;
   _check_self $self;
  
   my $config = (defined $type) ? $self->_type($type) : $self;
   return unless defined $wc;
  
   my $e = $config->{escape};
   $wc =~ s/
    (?<!\\)(
     (?:\\\\)*
     (?:
       [^\w\s\\$e]
      |
       \\
       (?: [^\W$e] | \s | $ )
     )
    )
   /\\$1/gx;
  
   my $do = $config->{do};
   $wc = $self->_jokers($wc) if $do->{jokers};
   $wc = $self->_sql($wc)    if $do->{sql};
   if ($do->{brackets}) {
    $wc = $self->_bracketed($wc);
   } elsif ($do->{commas} and $wc =~ /(?<!\\)(?:\\\\)*,/) {
    $wc = $self->{'c_brackets'} . $self->_commas($wc) . ')';
   }
  
   $wc
  }
  
  
  sub _extract ($) { extract_bracketed $_[0], '{',  qr/.*?(?<!\\)(?:\\\\)*(?={)/ }
  
  sub _jokers {
   my $self = shift;
   local $_ = $_[0];
  
   my $s = $self->{c_single};
   s/(?<!\\)((?:\\\\)*)\?/$1$s/g;
   $s = $self->{c_any};
   s/(?<!\\)((?:\\\\)*)\*+/$1$s/g;
  
   $_
  }
  
  sub _sql {
   my $self = shift;
   local $_ = $_[0];
  
   my $s = $self->{c_single};
   s/(?<!\\)((?:\\\\)*)_/$1$s/g;
   $s = $self->{c_any};
   s/(?<!\\)((?:\\\\)*)%+/$1$s/g;
  
   $_
  }
  
  sub _commas {
   local $_ = $_[1];
  
   s/(?<!\\)((?:\\\\)*),/$1|/g;
  
   $_
  }
  
  sub _brackets {
   my ($self, $rest) = @_;
  
   substr $rest, 0, 1, '';
   chop $rest;
  
   my ($re, $bracket, $prefix) = ('');
   while (do { ($bracket, $rest, $prefix) = _extract $rest; $bracket }) {
    $re .= $self->_commas($prefix) . $self->_brackets($bracket);
   }
   $re .= $self->_commas($rest);
  
   $self->{c_brackets} . $re . ')';
  }
  
  sub _bracketed {
   my ($self, $rest) = @_;
  
   my ($re, $bracket, $prefix) = ('');
   while (do { ($bracket, $rest, $prefix) = _extract $rest; $bracket }) {
    $re .= $prefix . $self->_brackets($bracket);
   }
   $re .= $rest;
  
   $re =~ s/(?<!\\)((?:\\\\)*[\{\},])/\\$1/g;
  
   $re;
  }
  
  1; 
REGEXP_WILDCARDS

$fatpacked{"Role/Tiny.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'ROLE_TINY';
  package Role::Tiny;
  
  sub _getglob { \*{$_[0]} }
  sub _getstash { \%{"$_[0]::"} }
  
  use strict;
  use warnings;
  
  our $VERSION = '2.000000';
  $VERSION = eval $VERSION;
  
  our %INFO;
  our %APPLIED_TO;
  our %COMPOSED;
  our %COMPOSITE_INFO;
  our @ON_ROLE_CREATE;
  
  
  BEGIN {
    *_WORK_AROUND_BROKEN_MODULE_STATE = "$]" < 5.009 ? sub(){1} : sub(){0};
    *_MRO_MODULE = "$]" < 5.010 ? sub(){"MRO/Compat.pm"} : sub(){"mro.pm"};
  }
  
  sub Role::Tiny::__GUARD__::DESTROY {
    delete $INC{$_[0]->[0]} if @{$_[0]};
  }
  
  sub _load_module {
    (my $proto = $_[0]) =~ s/::/\//g;
    $proto .= '.pm';
    return 1 if $INC{$proto};
    return 1 if grep !/::$/, keys %{_getstash($_[0])||{}};
    my $guard = _WORK_AROUND_BROKEN_MODULE_STATE
      && bless([ $proto ], 'Role::Tiny::__GUARD__');
    require $proto;
    pop @$guard if _WORK_AROUND_BROKEN_MODULE_STATE;
    return 1;
  }
  
  sub import {
    my $target = caller;
    my $me = shift;
    strict->import;
    warnings->import;
    return if $me->is_role($target); 
    $INFO{$target}{is_role} = 1;
    my $stash = _getstash($target);
    foreach my $type (qw(before after around)) {
      *{_getglob "${target}::${type}"} = sub {
        require Class::Method::Modifiers;
        push @{$INFO{$target}{modifiers}||=[]}, [ $type => @_ ];
        return;
      };
    }
    *{_getglob "${target}::requires"} = sub {
      push @{$INFO{$target}{requires}||=[]}, @_;
      return;
    };
    *{_getglob "${target}::with"} = sub {
      $me->apply_roles_to_package($target, @_);
      return;
    };
    my @not_methods = (map { *$_{CODE}||() } grep !ref($_), values %$stash);
    @{$INFO{$target}{not_methods}={}}{@not_methods} = @not_methods;
    $APPLIED_TO{$target} = { $target => undef };
    $_->($target) for @ON_ROLE_CREATE;
  }
  
  sub role_application_steps {
    qw(_install_methods _check_requires _install_modifiers _copy_applied_list);
  }
  
  sub apply_single_role_to_package {
    my ($me, $to, $role) = @_;
  
    _load_module($role);
  
    die "This is apply_role_to_package" if ref($to);
    die "${role} is not a Role::Tiny" unless $me->is_role($role);
  
    foreach my $step ($me->role_application_steps) {
      $me->$step($to, $role);
    }
  }
  
  sub _copy_applied_list {
    my ($me, $to, $role) = @_;
    @{$APPLIED_TO{$to}||={}}{keys %{$APPLIED_TO{$role}}} = ();
  }
  
  sub apply_roles_to_object {
    my ($me, $object, @roles) = @_;
    die "No roles supplied!" unless @roles;
    my $class = ref($object);
    bless($_[1], $me->create_class_with_roles($class, @roles));
  }
  
  my $role_suffix = 'A000';
  sub _composite_name {
    my ($me, $superclass, @roles) = @_;
  
    my $new_name = join(
      '__WITH__', $superclass, my $compose_name = join '__AND__', @roles
    );
  
    if (length($new_name) > 252) {
      $new_name = $COMPOSED{abbrev}{$new_name}
        ||= substr($new_name, 0, 250 - length $role_suffix).'__'.$role_suffix++;
    }
    return wantarray ? ($new_name, $compose_name) : $new_name;
  }
  
  sub create_class_with_roles {
    my ($me, $superclass, @roles) = @_;
  
    die "No roles supplied!" unless @roles;
  
    _load_module($superclass);
    {
      my %seen;
      $seen{$_}++ for @roles;
      if (my @dupes = grep $seen{$_} > 1, @roles) {
        die "Duplicated roles: ".join(', ', @dupes);
      }
    }
  
    my ($new_name, $compose_name) = $me->_composite_name($superclass, @roles);
  
    return $new_name if $COMPOSED{class}{$new_name};
  
    foreach my $role (@roles) {
      _load_module($role);
      die "${role} is not a Role::Tiny" unless $me->is_role($role);
    }
  
    require(_MRO_MODULE);
  
    my $composite_info = $me->_composite_info_for(@roles);
    my %conflicts = %{$composite_info->{conflicts}};
    if (keys %conflicts) {
      my $fail =
        join "\n",
          map {
            "Method name conflict for '$_' between roles "
            ."'".join(' and ', sort values %{$conflicts{$_}})."'"
            .", cannot apply these simultaneously to an object."
          } keys %conflicts;
      die $fail;
    }
  
    my @composable = map $me->_composable_package_for($_), reverse @roles;
  
    my @requires = grep {
      my $method = $_;
      !grep $_->can($method) && !$COMPOSED{role}{$_}{modifiers_only}{$method},
        @composable
    } @{$composite_info->{requires}};
  
    $me->_check_requires(
      $superclass, $compose_name, \@requires
    );
  
    *{_getglob("${new_name}::ISA")} = [ @composable, $superclass ];
  
    @{$APPLIED_TO{$new_name}||={}}{
      map keys %{$APPLIED_TO{$_}}, @roles
    } = ();
  
    $COMPOSED{class}{$new_name} = 1;
    return $new_name;
  }
  
  
  sub apply_role_to_package { shift->apply_single_role_to_package(@_) }
  
  sub apply_roles_to_package {
    my ($me, $to, @roles) = @_;
  
    return $me->apply_role_to_package($to, $roles[0]) if @roles == 1;
  
    my %conflicts = %{$me->_composite_info_for(@roles)->{conflicts}};
    my @have = grep $to->can($_), keys %conflicts;
    delete @conflicts{@have};
  
    if (keys %conflicts) {
      my $fail =
        join "\n",
          map {
            "Due to a method name conflict between roles "
            ."'".join(' and ', sort values %{$conflicts{$_}})."'"
            .", the method '$_' must be implemented by '${to}'"
          } keys %conflicts;
      die $fail;
    }
  
    my @role_methods = map $me->_concrete_methods_of($_), @roles;
    local @{$_}{@have} for @role_methods;
    delete @{$_}{@have} for @role_methods;
  
    if ($INFO{$to}) {
      delete $INFO{$to}{methods}; 
    }
  
    our %BACKCOMPAT_HACK;
    if($me ne __PACKAGE__
        and exists $BACKCOMPAT_HACK{$me} ? $BACKCOMPAT_HACK{$me} :
        $BACKCOMPAT_HACK{$me} =
          $me->can('role_application_steps')
            == \&role_application_steps
          && $me->can('apply_single_role_to_package')
            != \&apply_single_role_to_package
    ) {
      foreach my $role (@roles) {
        $me->apply_single_role_to_package($to, $role);
      }
    }
    else {
      foreach my $step ($me->role_application_steps) {
        foreach my $role (@roles) {
          $me->$step($to, $role);
        }
      }
    }
    $APPLIED_TO{$to}{join('|',@roles)} = 1;
  }
  
  sub _composite_info_for {
    my ($me, @roles) = @_;
    $COMPOSITE_INFO{join('|', sort @roles)} ||= do {
      foreach my $role (@roles) {
        _load_module($role);
      }
      my %methods;
      foreach my $role (@roles) {
        my $this_methods = $me->_concrete_methods_of($role);
        $methods{$_}{$this_methods->{$_}} = $role for keys %$this_methods;
      }
      my %requires;
      @requires{map @{$INFO{$_}{requires}||[]}, @roles} = ();
      delete $requires{$_} for keys %methods;
      delete $methods{$_} for grep keys(%{$methods{$_}}) == 1, keys %methods;
      +{ conflicts => \%methods, requires => [keys %requires] }
    };
  }
  
  sub _composable_package_for {
    my ($me, $role) = @_;
    my $composed_name = 'Role::Tiny::_COMPOSABLE::'.$role;
    return $composed_name if $COMPOSED{role}{$composed_name};
    $me->_install_methods($composed_name, $role);
    my $base_name = $composed_name.'::_BASE';
    _getstash($base_name);
    { no strict 'refs'; @{"${composed_name}::ISA"} = ( $base_name ); }
    my $modifiers = $INFO{$role}{modifiers}||[];
    my @mod_base;
    my @modifiers = grep !$composed_name->can($_),
      do { my %h; @h{map @{$_}[1..$#$_-1], @$modifiers} = (); keys %h };
    foreach my $modified (@modifiers) {
      push @mod_base, "sub ${modified} { shift->next::method(\@_) }";
    }
    my $e;
    {
      local $@;
      eval(my $code = join "\n", "package ${base_name};", @mod_base);
      $e = "Evaling failed: $@\nTrying to eval:\n${code}" if $@;
    }
    die $e if $e;
    $me->_install_modifiers($composed_name, $role);
    $COMPOSED{role}{$composed_name} = {
      modifiers_only => { map { $_ => 1 } @modifiers },
    };
    return $composed_name;
  }
  
  sub _check_requires {
    my ($me, $to, $name, $requires) = @_;
    return unless my @requires = @{$requires||$INFO{$name}{requires}||[]};
    if (my @requires_fail = grep !$to->can($_), @requires) {
      if (my $to_info = $INFO{$to}) {
        push @{$to_info->{requires}||=[]}, @requires_fail;
      } else {
        die "Can't apply ${name} to ${to} - missing ".join(', ', @requires_fail);
      }
    }
  }
  
  sub _concrete_methods_of {
    my ($me, $role) = @_;
    my $info = $INFO{$role};
    my $stash = _getstash($role);
    my $not_methods = { reverse %{$info->{not_methods}||{}} };
    $info->{methods} ||= +{
      map {
        my $code = *{$stash->{$_}}{CODE};
        ( ! $code or exists $not_methods->{$code} ) ? () : ($_ => $code)
      } grep !ref($stash->{$_}), keys %$stash
    };
  }
  
  sub methods_provided_by {
    my ($me, $role) = @_;
    die "${role} is not a Role::Tiny" unless $me->is_role($role);
    (keys %{$me->_concrete_methods_of($role)}, @{$INFO{$role}->{requires}||[]});
  }
  
  sub _install_methods {
    my ($me, $to, $role) = @_;
  
    my $info = $INFO{$role};
  
    my $methods = $me->_concrete_methods_of($role);
  
    my $stash = _getstash($to);
  
    my %has_methods;
    @has_methods{grep
      +(ref($stash->{$_}) || *{$stash->{$_}}{CODE}),
      keys %$stash
    } = ();
  
    foreach my $i (grep !exists $has_methods{$_}, keys %$methods) {
      no warnings 'once';
      my $glob = _getglob "${to}::${i}";
      *$glob = $methods->{$i};
  
      next
        unless $i =~ /^\(/
          && ((defined &overload::nil && $methods->{$i} == \&overload::nil)
              || (defined &overload::_nil && $methods->{$i} == \&overload::_nil));
  
      my $overload = ${ *{_getglob "${role}::${i}"}{SCALAR} };
      next
        unless defined $overload;
  
      *$glob = \$overload;
    }
  
    $me->_install_does($to);
  }
  
  sub _install_modifiers {
    my ($me, $to, $name) = @_;
    return unless my $modifiers = $INFO{$name}{modifiers};
    if (my $info = $INFO{$to}) {
      push @{$info->{modifiers}}, @{$modifiers||[]};
    } else {
      foreach my $modifier (@{$modifiers||[]}) {
        $me->_install_single_modifier($to, @$modifier);
      }
    }
  }
  
  my $vcheck_error;
  
  sub _install_single_modifier {
    my ($me, @args) = @_;
    defined($vcheck_error) or $vcheck_error = do {
      local $@;
      eval { Class::Method::Modifiers->VERSION(1.05); 1 }
        ? 0
        : $@
    };
    $vcheck_error and die $vcheck_error;
    Class::Method::Modifiers::install_modifier(@args);
  }
  
  my $FALLBACK = sub { 0 };
  sub _install_does {
    my ($me, $to) = @_;
  
    return if $me->is_role($to);
  
    my $does = $me->can('does_role');
    *{_getglob "${to}::does"} = $does unless $to->can('does');
  
    return
      if $to->can('DOES') and $to->can('DOES') != (UNIVERSAL->can('DOES') || 0);
  
    my $existing = $to->can('DOES') || $to->can('isa') || $FALLBACK;
    my $new_sub = sub {
      my ($proto, $role) = @_;
      $proto->$does($role) or $proto->$existing($role);
    };
    no warnings 'redefine';
    return *{_getglob "${to}::DOES"} = $new_sub;
  }
  
  sub does_role {
    my ($proto, $role) = @_;
    require(_MRO_MODULE);
    foreach my $class (@{mro::get_linear_isa(ref($proto)||$proto)}) {
      return 1 if exists $APPLIED_TO{$class}{$role};
    }
    return 0;
  }
  
  sub is_role {
    my ($me, $role) = @_;
    return !!($INFO{$role} && $INFO{$role}{is_role});
  }
  
  1;
  __END__
  
ROLE_TINY

$fatpacked{"Role/Tiny/With.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'ROLE_TINY_WITH';
  package Role::Tiny::With;
  
  use strict;
  use warnings;
  
  our $VERSION = '2.000000';
  $VERSION = eval $VERSION;
  
  use Role::Tiny ();
  
  use Exporter 'import';
  our @EXPORT = qw( with );
  
  sub with {
      my $target = caller;
      Role::Tiny->apply_roles_to_package($target, @_)
  }
  
  1;
  
  
  
ROLE_TINY_WITH

$fatpacked{"Sah/Schema/Rinci.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'SAH_SCHEMA_RINCI';
  package Sah::Schema::Rinci;
  
  our $DATE = '2015-03-28'; 
  our $VERSION = '1.1.75'; 
  
  use 5.010001;
  use strict;
  use warnings;
  
  our %SCHEMAS;
  
  my %dh_props = (
      v => {},
      defhash_v => {},
      name => {},
      caption => {},
      summary => {},
      description => {},
      tags => {},
      default_lang => {},
      x => {},
  );
  
  $SCHEMAS{rinci} = [hash => {
      _ver => 1.1, 
      _prop => {
          %dh_props,
  
          entity_v => {},
          entity_date => {},
          links => {
              _elem_prop => {
                  %dh_props,
  
                  url => {},
              },
          },
      },
  }];
  
  $SCHEMAS{rinci_function} = [hash => {
      _ver => 1.1,
      _prop => {
          %dh_props,
  
          entity_v => {},
          entity_date => {},
          links => {},
  
          is_func => {},
          is_meth => {},
          is_class_meth => {},
          args => {
              _value_prop => {
                  %dh_props,
  
                  links => {},
  
                  schema => {},
                  filters => {},
                  default => {},
                  req => {},
                  pos => {},
                  greedy => {},
                  partial => {},
                  stream => {},
                  is_password => {},
                  cmdline_aliases => {
                      _value_prop => {
                          summary => {},
                          description => {},
                          schema => {},
                          code => {},
                          is_flag => {},
                      },
                  },
                  cmdline_on_getopt => {},
                  cmdline_prompt => {},
                  completion => {},
                  element_completion => {},
                  cmdline_src => {},
                  meta => 'fix',
                  element_meta => 'fix',
                  deps => {
                      _keys => {
                          arg => {},
                          all => {},
                          any => {},
                          none => {},
                      },
                  },
              },
          },
          args_as => {},
          args_groups => {
              _elem_prop => {
                  %dh_props,
                  args => {},
                  rel => {},
              },
          },
          result => {
              _prop => {
                  %dh_props,
  
                  schema => {},
                  statuses => {
                      _value_prop => {
                          summary => {},
                          description => {},
                          schema => {},
                      },
                  },
                  partial => {},
                  stream => {},
              },
          },
          result_naked => {},
          examples => {
              _elem_prop => {
                  %dh_props,
  
                  args => {},
                  argv => {},
                  src => {},
                  src_plang => {},
                  status => {},
                  result => {},
                  test => {},
              },
          },
          features => {
              _keys => {
                  reverse => {},
                  tx => {},
                  dry_run => {},
                  pure => {},
                  immutable => {},
                  idempotent => {},
                  check_arg => {},
              },
          },
          deps => {
              _keys => {
                  all => {},
                  any => {},
                  none => {},
                  env => {},
                  prog => {},
                  pkg => {},
                  func => {},
                  code => {},
                  tmp_dir => {},
                  trash_dir => {},
              },
          },
      },
  }];
  $SCHEMAS{rinci_function}[1]{_prop}{args}{_value_prop}{meta} =
      $SCHEMAS{rinci_function}[1];
  $SCHEMAS{rinci_function}[1]{_prop}{args}{_value_prop}{element_meta} =
      $SCHEMAS{rinci_function}[1];
  
  
  $SCHEMAS{rinci_resmeta} = [hash => {
      _ver => 1.1,
      _prop => {
          %dh_props,
  
          perm_err => {},
          func => {}, 
          cmdline => {}, 
          logs => {},
          prev => {},
          results => {},
          part_start => {},
          part_len => {},
          len => {},
          stream => {},
      },
  }];
  
  
  1;
  
  __END__
  
SAH_SCHEMA_RINCI

$fatpacked{"Scalar/Util/Numeric/PP.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'SCALAR_UTIL_NUMERIC_PP';
  package Scalar::Util::Numeric::PP;
  
  our $DATE = '2015-04-12'; 
  our $VERSION = '0.02'; 
  
  use 5.010001;
  use strict;
  use warnings;
  
  require Exporter;
  our @ISA       = qw(Exporter);
  our @EXPORT_OK = qw(
                         isint
                         isnum
                         isnan
                         isinf
                         isneg
                         isfloat
                 );
  
  sub isint {
      local $_ = shift;
      return 0 unless defined;
      return 1 if /\A[+-]?(?:0|[1-9][0-9]*)\z/;
      0;
  }
  
  sub isnan($) {
      local $_ = shift;
      return 0 unless defined;
      return 1 if /\A\s*[+-]?nan\s*\z/i;
      0;
  }
  
  sub isinf($) {
      local $_ = shift;
      return 0 unless defined;
      return 1 if /\A\s*[+-]?inf(?:inity)?\s*\z/i;
      0;
  }
  
  sub isneg($) {
      local $_ = shift;
      return 0 unless defined;
      return 1 if /\A\s*-/;
      0;
  }
  
  sub isnum($) {
      local $_ = shift;
      return 0 unless defined;
      return 1 if isint($_);
      return 1 if isfloat($_);
      0;
  }
  
  sub isfloat($) {
      local $_ = shift;
      return 0 unless defined;
      return 1 if /\A[+-]?(?:0|[1-9][0-9]*)(\.[0-9]+)?([eE][+-]?[0-9]+)?\z/
          && $1 || $2;
      return 1 if isnan($_) || isinf($_);
      0;
  }
  
  1;
  
  __END__
  
SCALAR_UTIL_NUMERIC_PP

$fatpacked{"String/Indent.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'STRING_INDENT';
  package String::Indent;
  
  our $DATE = '2015-03-06'; 
  our $VERSION = '0.03'; 
  
  use 5.010001;
  use strict;
  use warnings;
  
  use Exporter;
  our @ISA = qw(Exporter);
  our @EXPORT_OK = qw(
                         indent
                 );
  
  sub indent {
      my ($indent, $str, $opts) = @_;
      $opts //= {};
  
      my $ibl = $opts->{indent_blank_lines} // 1;
      my $fli = $opts->{first_line_indent} // $indent;
      my $sli = $opts->{subsequent_lines_indent} // $indent;
  
      my $i = 0;
      $str =~ s/^([^\r\n]?)/$i++; !$ibl && !$1 ? "$1" : $i==1 ? "$fli$1" : "$sli$1"/egm;
      $str;
  }
  
  1;
  
  __END__
  
STRING_INDENT

$fatpacked{"String/Trim/More.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'STRING_TRIM_MORE';
  package String::Trim::More;
  
  our $DATE = '2014-12-10'; 
  our $VERSION = '0.02'; 
  
  use 5.010001;
  use strict;
  use warnings;
  
  use Exporter;
  our @ISA = qw(Exporter);
  our @EXPORT_OK = qw(
                         ltrim
                         rtrim
                         trim
                         ltrim_lines
                         rtrim_lines
                         trim_lines
                         trim_blank_lines
  
                         ellipsis
                 );
  
  sub ltrim {
      my $str = shift;
      $str =~ s/\A\s+//s;
      $str;
  }
  
  sub rtrim {
      my $str = shift;
      $str =~ s/\s+\z//s;
      $str;
  }
  
  sub trim {
      my $str = shift;
      $str =~ s/\A\s+//s;
      $str =~ s/\s+\z//s;
      $str;
  }
  
  sub ltrim_lines {
      my $str = shift;
      $str =~ s/^[ \t]+//mg; 
      $str;
  }
  
  sub rtrim_lines {
      my $str = shift;
      $str =~ s/[ \t]+$//mg;
      $str;
  }
  
  sub trim_lines {
      my $str = shift;
      $str =~ s/^[ \t]+//mg;
      $str =~ s/[ \t]+$//mg;
      $str;
  }
  
  sub trim_blank_lines {
      local $_ = shift;
      return $_ unless defined;
      s/\A(?:\n\s*)+//;
      s/(?:\n\s*){2,}\z/\n/;
      $_;
  }
  
  sub ellipsis {
      my ($str, $maxlen, $ellipsis) = @_;
      $maxlen   //= 80;
      $ellipsis //= "...";
  
      if (length($str) <= $maxlen) {
          return $str;
      } else {
          return substr($str, 0, $maxlen-length($ellipsis)) . $ellipsis;
      }
  }
  
  1;
  
  __END__
  
STRING_TRIM_MORE

$fatpacked{"String/Wildcard/Bash.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'STRING_WILDCARD_BASH';
  package String::Wildcard::Bash;
  
  use 5.010001;
  use strict;
  use warnings;
  
  our $VERSION = '0.02'; 
  
  use Exporter;
  our @ISA = qw(Exporter);
  our @EXPORT_OK = qw(
                         contains_wildcard
                 );
  
  my $re1 =
      qr(
            # non-escaped brace expression, with at least one comma
            (?P<brace>
                (?<!\\)(?:\\\\)*\{
                (?:           \\\\ | \\\{ | \\\} | [^\\\{\}] )*
                (?:, (?:  \\\\ | \\\{ | \\\} | [^\\\{\}] )* )+
                (?<!\\)(?:\\\\)*\}
            )
        |
            # non-escaped brace expression, to catch * or ? or [...] inside so
            # they don't go to below pattern, because bash doesn't consider them
            # wildcards, e.g. '/{et?,us*}' expands to '/etc /usr', but '/{et?}'
            # doesn't expand at all to /etc.
            (?P<braceno>
                (?<!\\)(?:\\\\)*\{
                (?:           \\\\ | \\\{ | \\\} | [^\\\{\}] )*
                (?<!\\)(?:\\\\)*\}
            )
        |
            (?P<class>
                # non-empty, non-escaped character class
                (?<!\\)(?:\\\\)*\[
                (?:  \\\\ | \\\[ | \\\] | [^\\\[\]] )+
                (?<!\\)(?:\\\\)*\]
            )
        |
            (?P<joker>
                # non-escaped * and ?
                (?<!\\)(?:\\\\)*[*?]
            )
        )ox;
  
  sub contains_wildcard {
      my $str = shift;
  
      while ($str =~ /$re1/go) {
          my %m = %+;
          return 1 if $m{brace} || $m{class} || $m{joker};
      }
      0;
  }
  
  1;
  
  __END__
  
STRING_WILDCARD_BASH

$fatpacked{"Sub/Install.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'SUB_INSTALL';
  use strict;
  use warnings;
  package Sub::Install;
  $Sub::Install::VERSION = '0.928';
  use Carp;
  use Scalar::Util ();
  
  
  sub _name_of_code {
    my ($code) = @_;
    require B;
    my $name = B::svref_2object($code)->GV->NAME;
    return $name unless $name =~ /\A__ANON__/;
    return;
  }
  
  sub _CODELIKE {
    (Scalar::Util::reftype($_[0])||'') eq 'CODE'
    || Scalar::Util::blessed($_[0])
    && (overload::Method($_[0],'&{}') ? $_[0] : undef);
  }
  
  sub _build_public_installer {
    my ($installer) = @_;
  
    sub {
      my ($arg) = @_;
      my ($calling_pkg) = caller(0);
  
      for (qw(into from)) { $arg->{$_} = $calling_pkg unless $arg->{$_} }
  
      Carp::croak "named argument 'code' is not optional" unless $arg->{code};
  
      if (_CODELIKE($arg->{code})) {
        $arg->{as} ||= _name_of_code($arg->{code});
      } else {
        Carp::croak
          "couldn't find subroutine named $arg->{code} in package $arg->{from}"
          unless my $code = $arg->{from}->can($arg->{code});
  
        $arg->{as}   = $arg->{code} unless $arg->{as};
        $arg->{code} = $code;
      }
  
      Carp::croak "couldn't determine name under which to install subroutine"
        unless $arg->{as};
  
      $installer->(@$arg{qw(into as code) });
    }
  }
  
  
  my $_misc_warn_re;
  my $_redef_warn_re;
  BEGIN {
    $_misc_warn_re = qr/
      Prototype\ mismatch:\ sub\ .+?  |
      Constant subroutine .+? redefined
    /x;
    $_redef_warn_re = qr/Subroutine\ .+?\ redefined/x;
  }
  
  my $eow_re;
  BEGIN { $eow_re = qr/ at .+? line \d+\.\Z/ };
  
  sub _do_with_warn {
    my ($arg) = @_;
    my $code = delete $arg->{code};
    my $wants_code = sub {
      my $code = shift;
      sub {
        my $warn = $SIG{__WARN__} ? $SIG{__WARN__} : sub { warn @_ }; 
        local $SIG{__WARN__} = sub {
          my ($error) = @_;
          for (@{ $arg->{suppress} }) {
              return if $error =~ $_;
          }
          for (@{ $arg->{croak} }) {
            if (my ($base_error) = $error =~ /\A($_) $eow_re/x) {
              Carp::croak $base_error;
            }
          }
          for (@{ $arg->{carp} }) {
            if (my ($base_error) = $error =~ /\A($_) $eow_re/x) {
              return $warn->(Carp::shortmess $base_error);
            }
          }
          ($arg->{default} || $warn)->($error);
        };
        $code->(@_);
      };
    };
    return $wants_code->($code) if $code;
    return $wants_code;
  }
  
  sub _installer {
    sub {
      my ($pkg, $name, $code) = @_;
      no strict 'refs'; 
      *{"$pkg\::$name"} = $code;
      return $code;
    }
  }
  
  BEGIN {
    *_ignore_warnings = _do_with_warn({
      carp => [ $_misc_warn_re, $_redef_warn_re ]
    });
  
    *install_sub = _build_public_installer(_ignore_warnings(_installer));
  
    *_carp_warnings =  _do_with_warn({
      carp     => [ $_misc_warn_re ],
      suppress => [ $_redef_warn_re ],
    });
  
    *reinstall_sub = _build_public_installer(_carp_warnings(_installer));
  
    *_install_fatal = _do_with_warn({
      code     => _installer,
      croak    => [ $_redef_warn_re ],
    });
  }
  
  
  sub install_installers {
    my ($into) = @_;
  
    for my $method (qw(install_sub reinstall_sub)) {
      my $code = sub {
        my ($package, $subs) = @_;
        my ($caller) = caller(0);
        my $return;
        for (my ($name, $sub) = %$subs) {
          $return = Sub::Install->can($method)->({
            code => $sub,
            from => $caller,
            into => $package,
            as   => $name
          });
        }
        return $return;
      };
      install_sub({ code => $code, into => $into, as => $method });
    }
  }
  
  
  sub exporter {
    my ($arg) = @_;
  
    my %is_exported = map { $_ => undef } @{ $arg->{exports} };
  
    sub {
      my $class = shift;
      my $target = caller;
      for (@_) {
        Carp::croak "'$_' is not exported by $class" if !exists $is_exported{$_};
        install_sub({ code => $_, from => $class, into => $target });
      }
    }
  }
  
  BEGIN { *import = exporter({ exports => [ qw(install_sub reinstall_sub) ] }); }
  
  
  1;
  
  __END__
  
SUB_INSTALL

$fatpacked{"Test/Data/Sah.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'TEST_DATA_SAH';
  package Test::Data::Sah;
  
  our $DATE = '2015-04-14'; 
  our $VERSION = '0.51'; 
  
  use 5.010;
  use strict;
  use warnings;
  
  use Data::Sah qw(gen_validator);
  use Data::Dump qw(dump);
  use Test::More 0.98;
  
  use Exporter qw(import);
  our @EXPORT_OK = qw(test_sah_cases);
  
  sub test_sah_cases {
      my $tests = shift;
      my $opts  = shift // {};
  
      my $sah = Data::Sah->new;
      my $plc = $sah->get_compiler('perl');
  
      my $gvopts = $opts->{gen_validator_opts} // {};
      my $rt = $gvopts->{return_type} // 'bool';
  
      for my $test (@$tests) {
          my $v = gen_validator($test->{schema}, $gvopts);
          my $res = $v->($test->{input});
          my $name = $test->{name} //
              "data " . dump($test->{input}) . " should".
                  ($test->{valid} ? " pass" : " not pass"). " schema " .
                      dump($test->{schema});
          my $testres;
          if ($test->{valid}) {
              if ($rt eq 'bool') {
                  $testres = ok($res, $name);
              } elsif ($rt eq 'str') {
                  $testres = is($res, "", $name) or diag explain $res;
              } elsif ($rt eq 'full') {
                  $testres = is(~~keys(%{$res->{errors}}), 0, $name) or diag explain $res;
              }
          } else {
              if ($rt eq 'bool') {
                  $testres = ok(!$res, $name);
              } elsif ($rt eq 'str') {
                  $testres = isnt($res, "", $name) or diag explain $res;
              } elsif ($rt eq 'full') {
                  $testres = isnt(~~keys(%{$res->{errors}}), 0, $name) or diag explain $res;
              }
          }
          next if $testres;
  
          my $cd = $plc->compile(schema => $test->{schema});
          diag "schema compilation result:\n----begin generated code----\n",
              explain($cd->{result}), "\n----end generated code----\n",
                  "that code should return ", ($test->{valid} ? "true":"false"),
                      " when fed \$data=", dump($test->{input}),
                          " but instead returns ", dump($res);
  
          my $vfull = gen_validator($test->{schema}, {return_type=>"full"});
          diag "\nvalidator result (full):\n----begin result----\n",
              explain($vfull->($test->{input})), "----end result----";
      }
  }
  
  1;
  
  __END__
  
TEST_DATA_SAH

$fatpacked{"Text/sprintfn.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'TEXT_SPRINTFN';
  package Text::sprintfn;
  
  use 5.010001;
  use strict;
  use warnings;
  
  require Exporter;
  our @ISA       = qw(Exporter);
  our @EXPORT    = qw(sprintfn printfn);
  
  our $VERSION = '0.07'; 
  
  our $distance  = 10;
  
  my  $re1   = qr/[^)]+/s;
  my  $re2   = qr{(?<fmt>
                      %
                         (?<pi> \d+\$ | \((?<npi>$re1)\)\$?)?
                         (?<flags> [ +0#-]+)?
                         (?<vflag> \*?[v])?
                         (?<width> -?\d+ |
                             \*\d+\$? |
                             \((?<nwidth>$re1)\))?
                         (?<dot>\.?)
                         (?<prec>
                             (?: \d+ | \* |
                             \((?<nprec>$re1)\) ) ) ?
                         (?<conv> [%csduoxefgXEGbBpniDUOF])
                     )}x;
  our $regex = qr{($re2|%|[^%]+)}s;
  
  if (1) {
      $regex = qr{( #all=1
                      ( #fmt=2
                          %
                          (#pi=3
                              \d+\$ | \(
                              (#npi=4
                                  [^)]+)\)\$?)?
                          (#flags=5
                              [ +0#-]+)?
                          (#vflag=6
                              \*?[v])?
                          (#width=7
                              -?\d+ |
                              \*\d+\$? |
                              \((#nwidth=8
                                  [^)]+)\))?
                          (#dot=9
                              \.?)
                          (#prec=10
                              (?: \d+ | \* |
                                  \((#nprec=11
                                      [^)]+)\) ) ) ?
                          (#conv=12
                              [%csduoxefgXEGbBpniDUOF])
                      ) | % | [^%]+
                  )}xs;
  }
  
  sub sprintfn {
      my ($format, @args) = @_;
  
      my $hash;
      if (ref($args[0]) eq 'HASH') {
          $hash = shift(@args);
      }
      return sprintf($format, @args) if !$hash;
  
      my %indexes; 
      push @args, (undef) x $distance;
  
      $format =~ s{$regex}{
          my ($all, $fmt, $pi, $npi, $flags,
              $vflag, $width, $nwidth, $dot, $prec,
              $nprec, $conv) =
              ($1, $2, $3, $4, $5, $6, $7, $8, $9, $10, $11, $12);
  
          my $res;
          if ($fmt) {
  
              if (defined $npi) {
                  my $i = $indexes{$npi};
                  if (!$i) {
                      $i = @args + 1;
                      push @args, $hash->{$npi};
                      $indexes{$npi} = $i;
                  }
                  $pi = "${i}\$";
              }
  
              if (defined $nwidth) {
                  $width = $hash->{$nwidth};
              }
  
              if (defined $nprec) {
                  $prec = $hash->{$nprec};
              }
  
              $res = join("",
                  grep {defined} (
                      "%",
                      $pi, $flags, $vflag,
                      $width, $dot, $prec, $conv)
                  );
          } else {
              my $i = @args + 1;
              push @args, $all;
              $res = "\%${i}\$s";
          }
          $res;
      }xego;
  
  
      sprintf $format, @args;
  }
  
  sub printfn {
      print sprintfn @_;
  }
  
  1;
  
  __END__
  
TEXT_SPRINTFN

$fatpacked{"Time/Zone.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'TIME_ZONE';
  
  package Time::Zone;
  
  
  require 5.002;
  
  require Exporter;
  use Carp;
  use strict;
  use vars qw(@ISA @EXPORT $VERSION @tz_local);
  
  @ISA = qw(Exporter);
  @EXPORT = qw(tz2zone tz_local_offset tz_offset tz_name);
  $VERSION = "2.24";
  
  
  sub tz2zone (;$$$)
  {
  	my($TZ, $time, $isdst) = @_;
  
  	use vars qw(%tzn_cache);
  
  	$TZ = defined($ENV{'TZ'}) ? ( $ENV{'TZ'} ? $ENV{'TZ'} : 'GMT' ) : ''
  	    unless $TZ;
  
  
  	if (! defined $isdst) {
  		my $j;
  		$time = time() unless $time;
  		($j, $j, $j, $j, $j, $j, $j, $j, $isdst) = localtime($time);
  	}
  
  	if (defined $tzn_cache{$TZ}->[$isdst]) {
  		return $tzn_cache{$TZ}->[$isdst];
  	}
        
  	if ($TZ =~ /^
  		    ( [^:\d+\-,] {3,} )
  		    ( [+-] ?
  		      \d {1,2}
  		      ( : \d {1,2} ) {0,2} 
  		    )
  		    ( [^\d+\-,] {3,} )?
  		    /x
  	    ) {
  		my $dsttz = defined($4) ? $4 : $1;
  		$TZ = $isdst ? $dsttz : $1;
  		$tzn_cache{$TZ} = [ $1, $dsttz ];
  	} else {
  		$tzn_cache{$TZ} = [ $TZ, $TZ ];
  	}
  	return $TZ;
  }
  
  sub tz_local_offset (;$)
  {
  	my ($time) = @_;
  
  	$time = time() unless $time;
  	my (@l) = localtime($time);
  	my $isdst = $l[8];
  
  	if (defined($tz_local[$isdst])) {
  		return $tz_local[$isdst];
  	}
  
  	$tz_local[$isdst] = &calc_off($time);
  
  	return $tz_local[$isdst];
  }
  
  sub calc_off
  {
  	my ($time) = @_;
  
  	my (@l) = localtime($time);
  	my (@g) = gmtime($time);
  
  	my $off;
  
  	$off =     $l[0] - $g[0]
  		+ ($l[1] - $g[1]) * 60
  		+ ($l[2] - $g[2]) * 3600;
  
  
  	if ($l[7] == $g[7]) {
  	} elsif ($l[7] == $g[7] + 1) {
  		$off += 86400;
  	} elsif ($l[7] == $g[7] - 1) {
  		$off -= 86400;
  	} elsif ($l[7] < $g[7]) {
  		$off += 86400;
  	} else {
  		$off -= 86400;
  	}
  
  	return $off;
  }
  
  
  CONFIG: {
  	use vars qw(%dstZone %zoneOff %dstZoneOff %Zone);
  
  	my @dstZone = (
  	    "brst" =>   -2*3600,         
  	    "adt"  =>   -3*3600,  	 
  	    "edt"  =>   -4*3600,  	 
  	    "cdt"  =>   -5*3600,  	 
  	    "mdt"  =>   -6*3600,  	 
  	    "pdt"  =>   -7*3600,  	 
  	    "akdt" =>   -8*3600,         
  	    "ydt"  =>   -8*3600,  	 
  	    "hdt"  =>   -9*3600,  	 
  	    "bst"  =>   +1*3600,  	 
  	    "mest" =>   +2*3600,  	 
  	    "metdst" => +2*3600, 	 
  	    "sst"  =>   +2*3600,  	 
  	    "fst"  =>   +2*3600,  	 
              "cest" =>   +2*3600,         
              "eest" =>   +3*3600,         
              "msd"  =>   +4*3600,         
  	    "wadt" =>   +8*3600,  	 
  	    "kdt"  =>  +10*3600,	 
  	    "aedt" =>  +11*3600,  	 
  	    "eadt" =>  +11*3600,  	 
  	    "nzd"  =>  +13*3600,  	 
  	    "nzdt" =>  +13*3600,  	 
  	);
  
  	my @Zone = (
  	    "gmt"	=>   0,  	 
  	    "ut"        =>   0,  	 
  	    "utc"       =>   0,
  	    "wet"       =>   0,  	 
  	    "wat"       =>  -1*3600,	 
  	    "at"        =>  -2*3600,	 
  	    "fnt"	=>  -2*3600,	 
  	    "brt"	=>  -3*3600,	 
  	    "mnt"	=>  -4*3600,	 
  	    "ewt"       =>  -4*3600,	 
  	    "ast"       =>  -4*3600,	 
  	    "est"       =>  -5*3600,	 
  	    "act"	=>  -5*3600,	 
  	    "cst"       =>  -6*3600,	 
  	    "mst"       =>  -7*3600,	 
  	    "pst"       =>  -8*3600,	 
  	    "akst"      =>  -9*3600,     
  	    "yst"	=>  -9*3600,	 
  	    "hst"	=> -10*3600,	 
  	    "cat"	=> -10*3600,	 
  	    "ahst"	=> -10*3600,	 
  	    "nt"	=> -11*3600,	 
  	    "idlw"	=> -12*3600,	 
  	    "cet"	=>  +1*3600, 	 
  	    "mez"	=>  +1*3600, 	 
  	    "ect"	=>  +1*3600, 	 
  	    "met"	=>  +1*3600, 	 
  	    "mewt"	=>  +1*3600, 	 
  	    "swt"	=>  +1*3600, 	 
  	    "set"	=>  +1*3600, 	 
  	    "fwt"	=>  +1*3600, 	 
  	    "eet"	=>  +2*3600, 	 
  	    "ukr"	=>  +2*3600, 	 
  	    "bt"	=>  +3*3600, 	 
              "msk"       =>  +3*3600,     
  	    "zp4"	=>  +4*3600, 	 
  	    "zp5"	=>  +5*3600, 	 
  	    "zp6"	=>  +6*3600, 	 
  	    "wst"	=>  +8*3600, 	 
  	    "hkt"	=>  +8*3600, 	 
  	    "cct"	=>  +8*3600, 	 
  	    "jst"	=>  +9*3600,	 
  	    "kst"	=>  +9*3600,	 
  	    "aest"	=> +10*3600,	 
  	    "east"	=> +10*3600,	 
  	    "gst"	=> +10*3600,	 
  	    "nzt"	=> +12*3600,	 
  	    "nzst"	=> +12*3600,	 
  	    "idle"	=> +12*3600,	 
  	);
  
  	%Zone = @Zone;
  	%dstZone = @dstZone;
  	%zoneOff = reverse(@Zone);
  	%dstZoneOff = reverse(@dstZone);
  
  }
  
  sub tz_offset (;$$)
  {
  	my ($zone, $time) = @_;
  
  	return &tz_local_offset($time) unless($zone);
  
  	$time = time() unless $time;
  	my(@l) = localtime($time);
  	my $dst = $l[8];
  
  	$zone = lc $zone;
  
  	if($zone =~ /^(([\-\+])\d\d?)(\d\d)$/) {
  		my $v = $2 . $3;
  		return $1 * 3600 + $v * 60;
  	} elsif (exists $dstZone{$zone} && ($dst || !exists $Zone{$zone})) {
  		return $dstZone{$zone};
  	} elsif(exists $Zone{$zone}) {
  		return $Zone{$zone};
  	}
  	undef;
  }
  
  sub tz_name (;$$)
  {
  	my ($off, $dst) = @_;
  
  	$off = tz_offset()
  		unless(defined $off);
  
  	$dst = (localtime(time))[8]
  		unless(defined $dst);
  
  	if (exists $dstZoneOff{$off} && ($dst || !exists $zoneOff{$off})) {
  		return $dstZoneOff{$off};
  	} elsif (exists $zoneOff{$off}) {
  		return $zoneOff{$off};
  	}
  	sprintf("%+05d", int($off / 60) * 100 + $off % 60);
  }
  
  1;
TIME_ZONE

$fatpacked{"Version/Util.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'VERSION_UTIL';
  package Version::Util;
  
  use 5.010001;
  use strict;
  use version 0.77;
  use warnings;
  
  require Exporter;
  our @ISA = qw(Exporter);
  our @EXPORT_OK = qw(
                         cmp_version
                         version_eq version_ne
                         version_lt version_le version_gt version_ge
                         version_between version_in
                 );
  
  our $VERSION = '0.71'; 
  
  sub cmp_version {
      version->parse($_[0]) <=> version->parse($_[1]);
  }
  
  sub version_eq {
      version->parse($_[0]) == version->parse($_[1]);
  }
  
  sub version_ne {
      version->parse($_[0]) != version->parse($_[1]);
  }
  
  sub version_lt {
      version->parse($_[0]) <  version->parse($_[1]);
  }
  
  sub version_le {
      version->parse($_[0]) <= version->parse($_[1]);
  }
  
  sub version_gt {
      version->parse($_[0]) >  version->parse($_[1]);
  }
  
  sub version_ge {
      version->parse($_[0]) >= version->parse($_[1]);
  }
  
  sub version_between {
      my $v = version->parse(shift);
      while (@_) {
          my $v1 = shift;
          my $v2 = shift;
          return 1 if $v >= version->parse($v1) && $v <= version->parse($v2);
      }
      0;
  }
  
  sub version_in {
      my $v = version->parse(shift);
      for (@_) {
          return 1 if $v == version->parse($_);
      }
      0;
  }
  
  1;
  
  __END__
  
VERSION_UTIL

$fatpacked{"WWW/PAUSE/Simple.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'WWW_PAUSE_SIMPLE';
  package WWW::PAUSE::Simple;
  
  our $DATE = '2015-04-15'; 
  our $VERSION = '0.21'; 
  
  use 5.010001;
  use strict;
  use warnings;
  use Log::Any::IfLOG '$log';
  use Exporter qw(import);
  our @EXPORT_OK = qw(
                         upload_file
                         list_files
                         delete_files
                         undelete_files
                         reindex_files
                         list_dists
                         delete_old_releases
                         set_password
                         set_account_info
                 );
  
  use Perinci::Object;
  
  our %SPEC;
  
  our $re_archive_ext = qr/(?:tar|tar\.(?:Z|gz|bz2|xz)|zip|rar)/;
  
  our %common_args = (
      username => {
          summary => 'PAUSE ID',
          schema  => ['str*', match=>'\A\w{2,9}\z', max_len=>9],
          req     => 1,
          tags    => ['common'],
      },
      password => {
          summary => 'PAUSE password',
          schema  => 'str*',
          is_password => 1,
          req     => 1,
          tags    => ['common'],
      },
  );
  
  our %detail_arg = (
      detail => {
          summary => 'Whether to return detailed records',
          schema  => 'bool',
      },
  );
  
  our %detail_l_arg = (
      detail => {
          summary => 'Whether to return detailed records',
          schema  => 'bool',
          cmdline_aliases => {l=>{}},
      },
  );
  
  our %files_arg = (
      files => {
          summary => 'File names/wildcard patterns',
          'summary.alt.plurality.singular' => 'File name/wildcard pattern',
          schema  => ['array*', of=>'str*', min_len=>1],
          'x.name.is_plural' => 1,
          req => 1,
          pos => 0,
          greedy => 1,
      },
  );
  
  our %file_opt_arg = (
      files => {
          summary => 'File names/wildcard patterns',
          'summary.alt.plurality.singular' => 'File name/wildcard pattern',
          schema  => ['array*', of=>'str*'],
          'x.name.is_plural' => 1,
          pos => 0,
          greedy => 1,
      },
  );
  
  $SPEC{':package'} = {
      v => 1.1,
      summary => 'An API for PAUSE',
  };
  
  sub _common_args {
      my $args = shift;
      (username=>$args->{username}, password=>$args->{password});
  }
  
  sub _request {
      require HTTP::Request::Common;
  
      my %args = @_;
  
      state $ua = do {
          require LWP::UserAgent;
          LWP::UserAgent->new;
      };
      my $req = HTTP::Request::Common::POST(
          "https://pause.perl.org/pause/authenquery",
          @{ $args{post_data} });
      $req->authorization_basic($args{username}, $args{password});
  
      $ua->request($req);
  }
  
  sub _htres2envres {
      my $res = shift;
      [$res->code, $res->message, $res->content];
  }
  
  $SPEC{upload_file} = {
      v => 1.1,
      summary => 'Upload file(s) to your PAUSE account',
      args => {
          %common_args,
          %files_arg,
          subdir => {
              summary => 'Subdirectory to put the file(s) into',
              schema  => 'str*',
              default => '',
          },
      },
  };
  sub upload_file {
      require File::Basename;
  
      my %args = @_;
      my $files  = $args{files}
          or return [400, "Please specify at least one file"];
      my $subdir = $args{subdir} // '';
  
      my $envres = envresmulti();
  
      for my $file (@$files) {
          my $res;
          {
              unless (-f $file) {
                  $res = [404, "No such file"];
                  last;
              }
  
              $log->tracef("Uploading %s ...", $file);
              my $httpres = _request(
                  %args,
                  post_data => [
                      Content_Type => 'form-data',
                      Content => {
                          HIDDENNAME                        => $args{username},
                          CAN_MULTIPART                     => 0,
                          pause99_add_uri_upload            => File::Basename::basename($file),
                          SUBMIT_pause99_add_uri_httpupload => " Upload this file from my disk ",
                          pause99_add_uri_uri               => "",
                          pause99_add_uri_httpupload        => [$file],
                          (length($subdir) ? (pause99_add_uri_subdirtext => $subdir) : ()),
                      },
                  ]
              );
              if (!$httpres->is_success) {
                  $res = _htres2envres($httpres);
                  last;
              }
              if ($httpres->content !~ m!<h3>Submitting query</h3>\s*<p>(.+?)</p>!s) {
                  $res = [543, "Can't scrape upload status from response", $httpres->content];
                  last;
              }
              my $str = $1;
              if ($str =~ /Query succeeded/) {
                  $res = [200, "OK", undef, {"func.raw_status" => $str}];
              } else {
                  $res = [500, "Failed: $str"];
              }
          }
          $res->[3] //= {};
          $res->[3]{item_id} = $file;
          $log->tracef("Result of upload: %s", $res);
          $envres->add_result($res->[0], $res->[1], $res->[3]);
      }
      $envres->as_struct;
  }
  
  $SPEC{list_files} = {
      v => 1.1,
      summary => 'List files on your PAUSE account',
      args => {
          %common_args,
          %detail_l_arg,
          %file_opt_arg,
          del => {
              summary => 'Only list files which are scheduled for deletion',
              'summary.alt.bool.not' => 'Only list files which are not scheduled for deletion',
              schema => 'bool',
              tags => ['category:filtering'],
          },
      },
  };
  sub list_files {
      require Date::Parse;
      require Regexp::Wildcards;
      require String::Wildcard::Bash;
  
      my %args  = @_;
      my $q   = $args{files} // [];
      my $del = $args{del};
  
      my $httpres = _request(
          %args,
          post_data => [{ACTION=>'show_files'}],
      );
  
      $q = [@$q];
      for (@$q) {
          next unless String::Wildcard::Bash::contains_wildcard($_);
          my $re = Regexp::Wildcards->new(type=>'unix')->convert($_);
          $re = qr/\A($re)\z/;
          $_ = $re;
      }
  
      return _htres2envres($httpres) unless $httpres->is_success;
      return [543, "Can't scrape list of files from response",
              $httpres->content]
          unless $httpres->content =~ m!<h3>Files in directory.+</h3><pre>(.+)</pre>!s;
      my $str = $1;
      my @files;
    REC:
      while ($str =~ m!(?:\A |<br/> )(.+?)\s+(\d+)\s+(Scheduled for deletion \(due at )?(\w+, \d\d \w+ \d{4} \d\d:\d\d:\d\d GMT)!g) {
  
          my $time = Date::Parse::str2time($4, "UTC");
  
          my $rec = {
              name  => $1,
              size  => $2,
              is_scheduled_for_deletion => $3 ? 1:0,
          };
          if ($3) {
              $rec->{deletion_time} = $time;
          } else {
              $rec->{mtime} = $time;
          }
  
        FILTER_QUERY:
          {
              last unless @$q;
              for (@$q) {
                  if (ref($_) eq 'Regexp') {
                      last FILTER_QUERY if $rec->{name} =~ $_;
                  } else {
                      last FILTER_QUERY if $rec->{name} eq $_;
                  }
              }
              next REC;
          }
          if (defined $del) {
              next REC if $del xor $rec->{is_scheduled_for_deletion};
          }
  
          push @files, $args{detail} ? $rec : $rec->{name};
  
      }
      my %resmeta;
      if ($args{detail}) {
          $resmeta{format_options} = {
              any => {
                  table_column_orders => [[qw/name size mtime is_scheduled_for_deletion deletion_time/]],
              },
          };
      }
      [200, "OK", \@files, \%resmeta];
  }
  
  $SPEC{list_dists} = {
      v => 1.1,
      summary => 'List distributions on your PAUSE account',
      description => <<'_',
  
  Distribution names will be extracted from tarball/zip filenames.
  
  Unknown/unparseable filenames will be skipped.
  
  _
      args => {
          %common_args,
          %detail_l_arg,
          newest => {
              schema => 'bool',
              summary => 'Only show newest non-dev version',
              description => <<'_',
  
  Dev versions will be skipped.
  
  _
          },
          newest_n => {
              schema => ['int*', min=>1],
              summary => 'Only show this number of newest non-dev versions',
              description => <<'_',
  
  Dev versions will be skipped.
  
  _
          },
      },
  };
  sub list_dists {
      require List::MoreUtils;
      require Version::Util;
      use experimental 'smartmatch';
  
      my %args  = @_;
  
      my $res = list_files(_common_args(\%args), del=>0);
      return [500, "Can't list files: $res->[0] - $res->[1]"] if $res->[0] != 200;
  
      my $newest_n;
      if ($args{newest_n}) {
          $newest_n = $args{newest_n};
      } elsif ($args{newest}) {
          $newest_n = 1;
      }
  
      my @dists;
      for my $file (@{$res->[2]}) {
          if ($file =~ m!/!) {
              $log->debugf("Skipping %s: under a subdirectory", $file);
              next;
          }
          unless ($file =~ /\A
                            (\w+(?:-\w+)*)
                            -v?(\d+(?:\.\d+){0,2}(_\d+|-TRIAL)?)
                            \.$re_archive_ext
                            \z/ix) {
              $log->debugf("Skipping %s: doesn't match release regex", $file);
              next;
          }
          my ($dist, $version, $is_dev) = ($1, $2, $3);
          next if $is_dev && $newest_n;
          push @dists, {
              name => $dist,
              file => $file,
              version => $version,
              is_dev_version => $is_dev ? 1:0,
          };
      }
  
      my @old_files;
      if ($newest_n) {
          my %dist_versions;
          for my $dist (@dists) {
              push @{ $dist_versions{$dist->{name}} }, $dist->{version};
          }
          for my $dist (keys %dist_versions) {
              $dist_versions{$dist} = [
                  sort { -Version::Util::cmp_version($a, $b) }
                      @{ $dist_versions{$dist} }];
              if (@{ $dist_versions{$dist} } > $newest_n) {
                  $dist_versions{$dist} = [splice(
                      @{ $dist_versions{$dist} }, 0, $newest_n)];
              }
          }
          my @old_dists = @dists;
          @dists = ();
          for my $dist (@old_dists) {
              if ($dist->{version} ~~ @{ $dist_versions{$dist->{name}} }) {
                  push @dists, $dist;
              } else {
                  push @old_files, $dist->{file};
              }
          }
      }
  
      unless ($args{detail}) {
          @dists = List::MoreUtils::uniq(map { $_->{name} } @dists);
      }
  
      my %resmeta;
      if ($newest_n) {
          $resmeta{"func.old_files"} = \@old_files;
      }
      if ($args{detail}) {
          $resmeta{format_options} = {
              any => {
                  table_column_orders => [[qw/name version is_dev_version file/]],
              },
          };
      }
      [200, "OK", \@dists, \%resmeta];
  }
  
  $SPEC{delete_old_releases} = {
      v => 1.1,
      summary => 'Delete older versions of distributions on your PAUSE account',
      description => <<'_',
  
  Developer releases will not be deleted.
  
  To delete developer releases, you can use `delete_files` (rm), e.g. from the
  command line:
  
      % pause rm 'My-Module-*TRIAL*'; # delete a dist's trial releases
      % pause rm '*TRIAL*' '*_*'; # delete all files containing TRIAL or underscore
  
  _
      args => {
          %common_args,
          %detail_l_arg,
          num_keep => {
              schema => ['int*', min=>1],
              default => 1,
              summary => 'Number of new versions (including newest) to keep',
              cmdline_aliases => { n=>{} },
              description => <<'_',
  
  1 means to only keep the newest version, 2 means to keep the newest and the
  second newest, and so on.
  
  _
          },
      },
      features => {dry_run=>1},
  };
  sub delete_old_releases {
      my %args = @_;
  
      my $res = list_dists(_common_args(\%args), newest_n=>$args{num_keep}//1);
      return [500, "Can't list dists: $res->[0] - $res->[1]"] if $res->[0] != 200;
      my $old_files = $res->[3]{'func.old_files'};
  
      return [304, "No older releases", undef,
              {'cmdline.result'=>'There are no older releases to delete'}]
          unless @$old_files;
      my @to_delete;
      for my $file (@$old_files) {
          $file =~ s/\.$re_archive_ext\z//;
          push @to_delete, "$file.*";
      }
      $res = delete_files(_common_args(\%args),
                          files=>\@to_delete, -dry_run=>$args{-dry_run});
      return $res if $res->[0] != 200 || $args{-dry_run};
      my $deleted_files = $res->[3]{'func.files'} // [];
      if (@$deleted_files) {
          $res->[3]{'cmdline.result'} = $deleted_files;
      } else {
          $res->[3]{'cmdline.result'} = 'Deleted 0 files';
      }
      $res;
  }
  
  sub _delete_or_undelete_or_reindex_files {
      use experimental 'smartmatch';
      require Regexp::Wildcards;
      require String::Wildcard::Bash;
  
      my $which = shift;
      my %args = @_;
  
      my $files0 = $args{files} // [];
      return [400, "Please specify at least one file"] unless @$files0;
  
      my @files;
      {
          my $listres;
          for my $file (@$files0) {
              if (String::Wildcard::Bash::contains_wildcard($file)) {
                  unless ($listres) {
                      $listres = list_files(_common_args(\%args));
                      return [500, "Can't list files: $listres->[0] - $listres->[1]"]
                          unless $listres->[0] == 200;
                  }
                  my $re = Regexp::Wildcards->new(type=>'unix')->convert($file);
                  $re = qr/\A($re)\z/;
                  for my $f (@{$listres->[2]}) {
                      push @files, $f if $f =~ $re && !($f ~~ @files);
                  }
              } else {
                  push @files, $file;
              }
          }
      }
  
      unless (@files) {
          return [304, "No files to process"];
      }
  
      if ($args{-dry_run}) {
          $log->warnf("[dry-run] %s %s", $which, \@files);
          return [200, "OK (dry-run)"];
      } else {
          $log->infof("%s %s ...", $which, \@files);
      }
  
      my $httpres = _request(
          %args,
          post_data => [
              [
                  HIDDENNAME                => $args{username},
                  ($which eq 'delete'   ? (SUBMIT_pause99_delete_files_delete   => "Delete"  ) : ()),
                  ($which eq 'undelete' ? (SUBMIT_pause99_delete_files_undelete => "Undelete") : ()),
                  ($which eq 'reindex'  ? (SUBMIT_pause99_reindex_delete        => "Reindex" ) : ()),
                  ($which =~ /delete/   ? (pause99_delete_files_FILE => \@files) : ()),
                  ($which eq 'reindex'  ? (pause99_reindex_FILE => \@files) : ()),
              ],
          ],
      );
      return _htres2envres($httpres) unless $httpres->is_success;
      return [543, "Can't scrape $which status from response", $httpres->content]
          unless $httpres->content =~ m!<h3>Files in directory!s;
      [200,"OK", undef, {'func.files'=>\@files}];
  }
  
  $SPEC{delete_files} = {
      v => 1.1,
      summary => 'Delete files',
      description => <<'_',
  
  When a file is deleted, it is not immediately deleted but has
  scheduled_for_deletion status for 72 hours, then deleted. During that time, the
  file can be undeleted.
  
  _
      args => {
          %common_args,
          %files_arg,
      },
      features => {dry_run=>1},
  };
  sub delete_files {
      my %args = @_; 
      _delete_or_undelete_or_reindex_files('delete', @_);
  }
  
  $SPEC{undelete_files} = {
      v => 1.1,
      summary => 'Undelete files',
      description => <<'_',
  
  When a file is deleted, it is not immediately deleted but has
  scheduled_for_deletion status for 72 hours, then deleted. During that time, the
  file can be undeleted.
  
  _
      args => {
          %common_args,
          %files_arg,
      },
      features => {dry_run=>1},
  };
  sub undelete_files {
      my %args = @_; 
      _delete_or_undelete_or_reindex_files('undelete', @_);
  }
  
  $SPEC{reindex_files} = {
      v => 1.1,
      summary => 'Force reindexing',
      args => {
          %common_args,
          %files_arg,
      },
      features => {dry_run=>1},
  };
  sub reindex_files {
      my %args = @_; 
      _delete_or_undelete_or_reindex_files('reindex', @_);
  }
  
  $SPEC{set_password} = {
      v => 1.1,
      args => {
          %common_args,
      },
  };
  sub set_password {
      my %args = @_;
      [501, "Not yet implemented"];
  }
  
  $SPEC{set_account_info} = {
      v => 1.1,
      args => {
          %common_args,
      },
  };
  sub set_account_info {
      my %args = @_;
      [501, "Not yet implemented"];
  }
  
  
  1;
  
  __END__
  
WWW_PAUSE_SIMPLE

$fatpacked{"experimental.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'EXPERIMENTAL';
  package experimental;
  $experimental::VERSION = '0.013';
  use strict;
  use warnings;
  use version ();
  
  use feature ();
  use Carp qw/croak carp/;
  
  my %warnings = map { $_ => 1 } grep { /^experimental::/ } keys %warnings::Offsets;
  my %features = map { $_ => 1 } $] > 5.015006 ? keys %feature::feature : do {
  	my @features;
  	if ($] >= 5.010) {
  		push @features, qw/switch say state/;
  		push @features, 'unicode_strings' if $] > 5.011002;
  	}
  	@features;
  };
  
  my %min_version = (
  	array_base      => '5',
  	autoderef       => '5.14.0',
  	current_sub     => '5.16.0',
  	evalbytes       => '5.16.0',
  	fc              => '5.16.0',
  	lexical_topic   => '5.10.0',
  	lexical_subs    => '5.18.0',
  	postderef       => '5.20.0',
  	postderef_qq    => '5.20.0',
  	refaliasing     => '5.21.5',
  	regex_sets      => '5.18.0',
  	say             => '5.10.0',
  	smartmatch      => '5.10.0',
  	signatures      => '5.20.0',
  	state           => '5.10.0',
  	switch          => '5.10.0',
  	unicode_eval    => '5.16.0',
  	unicode_strings => '5.12.0',
  );
  $_ = version->new($_) for values %min_version;
  
  my %additional = (
  	postderef  => ['postderef_qq'],
  	switch     => ['smartmatch'],
  );
  
  sub _enable {
  	my $pragma = shift;
  	if ($warnings{"experimental::$pragma"}) {
  		warnings->unimport("experimental::$pragma");
  		feature->import($pragma) if exists $features{$pragma};
  		_enable(@{ $additional{$pragma} }) if $additional{$pragma};
  	}
  	elsif ($features{$pragma}) {
  		feature->import($pragma);
  		_enable(@{ $additional{$pragma} }) if $additional{$pragma};
  	}
  	elsif (not exists $min_version{$pragma}) {
  		croak "Can't enable unknown feature $pragma";
  	}
  	elsif ($min_version{$pragma} > $]) {
  		my $stable = $min_version{$pragma};
  		if ($stable->{version}[1] % 2) {
  			$stable = version->new(
  				"5.".($stable->{version}[1]+1).'.0'
  			);
  		}
  		croak "Need perl $stable or later for feature $pragma";
  	}
  }
  
  sub import {
  	my ($self, @pragmas) = @_;
  
  	for my $pragma (@pragmas) {
  		_enable($pragma);
  	}
  	return;
  }
  
  sub _disable {
  	my $pragma = shift;
  	if ($warnings{"experimental::$pragma"}) {
  		warnings->import("experimental::$pragma");
  		feature->unimport($pragma) if exists $features{$pragma};
  		_disable(@{ $additional{$pragma} }) if $additional{$pragma};
  	}
  	elsif ($features{$pragma}) {
  		feature->unimport($pragma);
  		_disable(@{ $additional{$pragma} }) if $additional{$pragma};
  	}
  	elsif (not exists $min_version{$pragma}) {
  		carp "Can't disable unknown feature $pragma, ignoring";
  	}
  }
  
  sub unimport {
  	my ($self, @pragmas) = @_;
  
  	for my $pragma (@pragmas) {
  		_disable($pragma);
  	}
  	return;
  }
  
  1;
  
  
  __END__
  
EXPERIMENTAL

$fatpacked{"version/regex.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'VERSION_REGEX';
  package version::regex;
  
  use strict;
  
  use vars qw($VERSION $CLASS $STRICT $LAX);
  
  $VERSION = 0.9912;
  
  
  
  my $FRACTION_PART = qr/\.[0-9]+/;
  
  
  my $STRICT_INTEGER_PART = qr/0|[1-9][0-9]*/;
  
  
  my $LAX_INTEGER_PART = qr/[0-9]+/;
  
  
  my $STRICT_DOTTED_DECIMAL_PART = qr/\.[0-9]{1,3}/;
  
  
  my $LAX_DOTTED_DECIMAL_PART = qr/\.[0-9]+/;
  
  
  my $LAX_ALPHA_PART = qr/_[0-9]+/;
  
  
  
  my $STRICT_DECIMAL_VERSION =
      qr/ $STRICT_INTEGER_PART $FRACTION_PART? /x;
  
  
  my $STRICT_DOTTED_DECIMAL_VERSION =
      qr/ v $STRICT_INTEGER_PART $STRICT_DOTTED_DECIMAL_PART{2,} /x;
  
  
  $STRICT =
      qr/ $STRICT_DECIMAL_VERSION | $STRICT_DOTTED_DECIMAL_VERSION /x;
  
  
  
  my $LAX_DECIMAL_VERSION =
      qr/ $LAX_INTEGER_PART (?: \. | $FRACTION_PART $LAX_ALPHA_PART? )?
  	|
  	$FRACTION_PART $LAX_ALPHA_PART?
      /x;
  
  
  my $LAX_DOTTED_DECIMAL_VERSION =
      qr/
  	v $LAX_INTEGER_PART (?: $LAX_DOTTED_DECIMAL_PART+ $LAX_ALPHA_PART? )?
  	|
  	$LAX_INTEGER_PART? $LAX_DOTTED_DECIMAL_PART{2,} $LAX_ALPHA_PART?
      /x;
  
  
  $LAX =
      qr/ undef | $LAX_DECIMAL_VERSION | $LAX_DOTTED_DECIMAL_VERSION /x;
  
  
  sub is_strict	{ defined $_[0] && $_[0] =~ qr/ \A $STRICT \z /x }
  sub is_lax	{ defined $_[0] && $_[0] =~ qr/ \A $LAX \z /x }
  
  1;
VERSION_REGEX

$fatpacked{"version/vxs.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'VERSION_VXS';
  #!perl -w
  package version::vxs;
  
  use v5.10;
  use strict;
  
  use vars qw(@ISA $VERSION $CLASS );
  $VERSION = 0.9912;
  $CLASS = 'version::vxs';
  
  eval {
      require XSLoader;
      local $^W; 
      XSLoader::load('version::vxs', $VERSION);
      1;
  } or do {
      require DynaLoader;
      push @ISA, 'DynaLoader'; 
      local $^W; 
      bootstrap version::vxs $VERSION;
  };
  
  
  1;
VERSION_VXS

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]}) {
       return sub {
         return 0 unless length $fat;
         $fat =~ s/^([^\n]*\n?)//;
         $_ = $1;
         return 1;
       };
     }
     return;
  };
}

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


our $DATE = '2015-04-15'; # DATE
our $VERSION = '0.26'; # VERSION

use 5.010001;
use strict;
use warnings;

use Perinci::CmdLine::pause;

BEGIN { $ENV{DATA_SAH_PP} = 1 }

my $prefix = '/WWW/PAUSE/Simple/';
Perinci::CmdLine::pause->new(
    url => $prefix,
    subcommands => {
        upload     => { url => "${prefix}upload_file" },
        list       => { url => "${prefix}list_files" },
        ls         => {
            url => "${prefix}list_files",
            summary => 'Alias for list',
            is_alias => 1,
        },
        "list-dists" => { url => "${prefix}list_dists" },
        delete     => { url => "${prefix}delete_files" },
        rm         => {
            url => "${prefix}delete_files",
            summary => 'Alias for delete',
            is_alias => 1,
        },
        undelete   => { url => "${prefix}undelete_files" },
        reindex    => { url => "${prefix}reindex_files" },
        password   => { url => "${prefix}set_password" },
        #'account-info' => { url => "${prefix}set_account_info" },
        cleanup    => { url => "${prefix}delete_old_releases" },
    },
    log => 1,
)->run;

# ABSTRACT: An API for PAUSE
# PODNAME: pause

__END__

=pod

=encoding UTF-8

=head1 NAME

pause - An API for PAUSE

=head1 VERSION

This document describes version 0.26 of pause (from Perl distribution App-pause), released on 2015-04-15.

=head1 SYNOPSIS

First create a config file C<~/pause.conf> containing:

 username=<Your PAUSE ID>
 password=<Your PAUSE password>

or if you have C<~/.pause> from L<cpan-upload>, C<pause> can read it too
(encrypted C<.pause> is currently not supported).

Then:

 # upload one or more files
 % pause upload Foo-Bar-0.12.tar.gz Baz-2.24.tar.gz
 % pause upload Foo-Bar-0.12.tar.gz --subdir old/2014; # upload to a subdir

 # list your files
 % pause list
 % pause ls 'App-*'; # accept filenames/wildcard patterns, note: quote first
 % pause ls -l     ; # see file sizes/mtimes/etc instead of just names

 # delete files
 % pause delete Foo-Bar-0.12.tar.gz Foo-Bar-0.12.readme Foo-Bar-0.12.meta
 % pause rm 'Foo-Bar-*'; # accept wildcard patterns, but quote first

 # undelete files scheduled for deletion (but not actually deleted yet)
 % pause undelete Foo-Bar-0.12.tar.gz Foo-Bar-0.12.readme Foo-Bar-0.12.meta
 % pause undelete 'Foo-Bar-*'; # accept wildcard patterns, but quote first

 # force reindexing
 % pause reindex Foo-Bar-0.12.tar.gz Foo-Bar-0.12.meta
 % pause reindex 'Foo-Bar-*'; # accept wildcard patterns, but quote first

 # clean old releases, by default will only leave the newest non-dev version
 % pause cleanup
 % pause cleanup -n 3 ; # keep 3 versions (newest + previous two)

 # change your password
 ...

 # view your account info
 ...

 # change your email forwarding
 ...

=head1 SUBCOMMANDS

=head2 B<cleanup>

Delete older versions of distributions on your PAUSE account.

Developer releases will not be deleted.

To delete developer releases, you can use C<delete_files> (rm), e.g. from the
command line:

 % pause rm 'My-Module-*TRIAL*'; # delete a dist's trial releases
 % pause rm '*TRIAL*' '*_*'; # delete all files containing TRIAL or underscore


=head2 B<delete>

Delete files.

When a file is deleted, it is not immediately deleted but has
scheduled_for_deletion status for 72 hours, then deleted. During that time, the
file can be undeleted.


=head2 B<list>

List files on your PAUSE account.

=head2 B<list-dists>

List distributions on your PAUSE account.

Distribution names will be extracted from tarball/zip filenames.

Unknown/unparseable filenames will be skipped.


=head2 B<ls>

Alias for list.

=head2 B<password>

=head2 B<reindex>

Force reindexing.

=head2 B<rm>

Alias for delete.

=head2 B<undelete>

Undelete files.

When a file is deleted, it is not immediately deleted but has
scheduled_for_deletion status for 72 hours, then deleted. During that time, the
file can be undeleted.


=head2 B<upload>

Upload file(s) to your PAUSE account.

=head1 OPTIONS

C<*> marks required options.

=head2 Common options

=over

=item B<--config-path>=I<filename>

Set path to configuration file.

Can be specified multiple times.

=item B<--config-profile>=I<s>

Set configuration profile to use.

=item B<--debug>

Set log level to debug.

=item B<--format>=I<s>

Choose output format, e.g. json, text.

Default value:

 undef

=item B<--help>, B<-h>, B<-?>

Display help message and exit.

=item B<--json>

Set output format to json.

=item B<--log-level>=I<s>

Set log level.

=item B<--naked-res>

When outputing as JSON, strip result envelope.

Default value:

 0

By default, when outputing as JSON, the full enveloped result is returned, e.g.:

    [200,"OK",[1,2,3],{"func.extra"=>4}]

The reason is so you can get the status (1st element), status message (2nd
element) as well as result metadata/extra result (4th element) instead of just
the result (3rd element). However, sometimes you want just the result, e.g. when
you want to pipe the result for more post-processing. In this case you can use
`--naked-res` so you just get:

    [1,2,3]


=item B<--no-config>

Do not use any configuration file.

=item B<--no-env>

Do not read environment for default options.

=item B<--password>=I<s>*

PAUSE password.

=item B<--quiet>

Set log level to quiet.

=item B<--subcommands>

List available subcommands.

=item B<--trace>

Set log level to trace.

=item B<--username>=I<s>*

PAUSE ID.

=item B<--verbose>

Set log level to info.

=item B<--version>, B<-v>

Display program's version and exit.

=back

=head2 Options for subcommand cleanup

=over

=item B<--detail>, B<-l>

Whether to return detailed records.

=item B<--num-keep>=I<i>, B<-n>

Number of new versions (including newest) to keep.

Default value:

 1

1 means to only keep the newest version, 2 means to keep the newest and the
second newest, and so on.


=back

=head2 Options for subcommand delete

=over

=item B<--file>=I<s@>*

File name/wildcard pattern.

Can be specified multiple times.

=item B<--files-json>=I<s>

File names/wildcard patterns (JSON-encoded).

See C<--file>.

=back

=head2 Options for subcommand list

=over

=item B<--del>

Only list files which are scheduled for deletion.

=item B<--detail>, B<-l>

Whether to return detailed records.

=item B<--file>=I<s@>

File name/wildcard pattern.

Can be specified multiple times.

=item B<--files-json>=I<s>

File names/wildcard patterns (JSON-encoded).

See C<--file>.

=back

=head2 Options for subcommand list-dists

=over

=item B<--detail>, B<-l>

Whether to return detailed records.

=item B<--newest>

Only show newest non-dev version.

Dev versions will be skipped.


=item B<--newest-n>=I<i>

Only show this number of newest non-dev versions.

Dev versions will be skipped.


=back

=head2 Options for subcommand reindex

=over

=item B<--file>=I<s@>*

File name/wildcard pattern.

Can be specified multiple times.

=item B<--files-json>=I<s>

File names/wildcard patterns (JSON-encoded).

See C<--file>.

=back

=head2 Options for subcommand undelete

=over

=item B<--file>=I<s@>*

File name/wildcard pattern.

Can be specified multiple times.

=item B<--files-json>=I<s>

File names/wildcard patterns (JSON-encoded).

See C<--file>.

=back

=head2 Options for subcommand upload

=over

=item B<--file>=I<s@>*

File name/wildcard pattern.

Can be specified multiple times.

=item B<--files-json>=I<s>

File names/wildcard patterns (JSON-encoded).

See C<--file>.

=item B<--subdir>=I<s>

Subdirectory to put the file(s) into.

Default value:

 ""

=back

=head1 COMPLETION

This script has shell tab completion capability with support for several
shells.

=head2 bash

To activate bash completion for this script, put:

 complete -C pause pause

in your bash startup (e.g. C<~/.bashrc>). Your next shell session will then
recognize tab completion for the command. Or, you can also directly execute the
line above in your shell to activate immediately.

It is recommended, however, that you install L<shcompgen> which allows you to
activate completion scripts for several kinds of scripts on multiple shells.
Some CPAN distributions (those that are built with
L<Dist::Zilla::Plugin::GenShellCompletion>) will even automatically enable shell
completion for their included scripts (using C<shcompgen>) at installation time,
so you can immadiately have tab completion.

=head2 tcsh

To activate tcsh completion for this script, put:

 complete pause 'p/*/`pause`/'

in your tcsh startup (e.g. C<~/.tcshrc>). Your next shell session will then
recognize tab completion for the command. Or, you can also directly execute the
line above in your shell to activate immediately.

It is also recommended to install C<shcompgen> (see above).

=head2 other shells

For fish and zsh, install C<shcompgen> as described above.

=head1 ENVIRONMENT

=over

=item * PAUSE_OPT

Specify additional command-line options

=back

=head1 CONFIGURATION FILE

This script can read configuration file, which by default is searched at C<~/.config/pause.conf>, C<~/pause.conf> or C</etc/pause.conf> (can be changed by specifying C<--config-path>). All found files will be read and merged.

To disable searching for configuration files, pass C<--no-config>.

Configuration file is in the format of L<IOD>, which is basically INI with some extra features. Section names map to subcommand names. 

You can put multiple profiles in a single file by using section names like C<[profile=SOMENAME]> or C<[SUBCOMMAND_NAME profile=SOMENAME]>. Those sections will only be read if you specify the matching C<--config-profile SOMENAME>.

List of available configuration parameters:

=head2 Common for all subcommands

 format (see --format)
 log_level (see --log-level)
 naked_res (see --naked-res)
 password (see --password)
 username (see --username)

=head2 For subcommand 'cleanup'

 detail (see --detail)
 num_keep (see --num-keep)

=head2 For subcommand 'delete'

 files (see --file)

=head2 For subcommand 'list'

 del (see --del)
 detail (see --detail)
 files (see --file)

=head2 For subcommand 'list-dists'

 detail (see --detail)
 newest (see --newest)
 newest_n (see --newest-n)

=head2 For subcommand 'password'


=head2 For subcommand 'reindex'

 files (see --file)

=head2 For subcommand 'undelete'

 files (see --file)

=head2 For subcommand 'upload'

 files (see --file)
 subdir (see --subdir)

=head1 FILES

~/.pause

~/.config/pause.conf

~/pause.conf

/etc/pause.conf

=head1 HOMEPAGE

Please visit the project's homepage at L<https://metacpan.org/release/App-pause>.

=head1 SOURCE

Source repository is at L<https://github.com/perlancar/perl-App-pause>.

=head1 BUGS

Please report any bugs or feature requests on the bugtracker website L<https://rt.cpan.org/Public/Dist/Display.html?Name=App-pause>

When submitting a bug or request, please include a test-file or a
patch to an existing test-file that illustrates the bug or desired
feature.

=head1 AUTHOR

perlancar <perlancar@cpan.org>

=head1 COPYRIGHT AND LICENSE

This software is copyright (c) 2015 by perlancar@cpan.org.

This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.

=cut
