#!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{"Algorithm/Dependency.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'ALGORITHM_DEPENDENCY';
  package Algorithm::Dependency;
  
  
  use 5.005;
  use strict;
  use Algorithm::Dependency::Item   ();
  use Algorithm::Dependency::Source ();
  use Params::Util qw{_INSTANCE _ARRAY};
  
  use vars qw{$VERSION};
  BEGIN {
  	$VERSION = '1.110';
  }
  
  
  
  
  
  
  
  sub new {
  	my $class  = shift;
  	my %args   = @_;
  	my $source = _INSTANCE($args{source}, 'Algorithm::Dependency::Source')
  		or return undef;
  
  	my $self = bless {
  		source   => $source, 
  		selected => {},
  		}, $class;
  
  	if ( $args{ignore_orphans} ) {
  		$self->{ignore_orphans} = 1;
  	}
  
  	_ARRAY($args{selected}) or return $self;
  
  	my %selected = ();
  	foreach my $id ( @{ $args{selected} } ) {
  		return undef unless $source->item($id);
  
  		return undef if $selected{$id};
  
  		$selected{$id} = 1;
  	}
  
  	$self->{selected} = \%selected;
  	$self;
  }
  
  
  
  
  
  
  
  sub source { $_[0]->{source} }
  
  
  sub selected_list { sort keys %{$_[0]->{selected}} }
  
  
  sub selected { $_[0]->{selected}->{$_[1]} }
  
  
  sub item { $_[0]->{source}->item($_[1]) }
  
  
  
  
  
  
  
  sub depends {
  	my $self    = shift;
  	my @stack   = @_ or return undef;
  	my @depends = ();
  	my %checked = ();
  
  	while ( my $id = shift @stack ) {
  		my $Item = $self->{source}->item($id)
  		or $self->{ignore_orphans} ? next : return undef;
  
  		next if $checked{$id};
  
  		push @stack, $Item->depends;
  		$checked{$id} = 1;
  
  		unless ( scalar grep { $id eq $_ } @_ ) {
  			push @depends, $id;
  		}
  	}
  
  	my $s = $self->{selected};
  	return [ sort grep { ! $s->{$_} } @depends ];
  }
  
  
  sub schedule {
  	my $self  = shift;
  	my @items = @_ or return undef;
  
  	my $depends = $self->depends( @items ) or return undef;
  
  	my $s = $self->{selected};
  	return [ sort grep { ! $s->{$_} } @items, @$depends ];
  }
  
  
  sub schedule_all {
  	my $self = shift;
  	$self->schedule( map { $_->id } $self->source->items );
  }
  
  1;
  
ALGORITHM_DEPENDENCY

$fatpacked{"Algorithm/Dependency/Item.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'ALGORITHM_DEPENDENCY_ITEM';
  package Algorithm::Dependency::Item;
  
  
  use 5.005;
  use strict;
  use Algorithm::Dependency ();
  
  use vars qw{$VERSION};
  BEGIN {
  	$VERSION = '1.110';
  }
  
  
  
  
  
  
  
  sub new {
  	my $class = shift;
  	my $id    = (defined $_[0] and ! ref $_[0] and $_[0] ne '') ? shift : return undef;
  	bless { id => $id, depends => [ @_ ] }, $class;
  }
  
  
  sub id { $_[0]->{id} }
  
  
  sub depends { @{$_[0]->{depends}} }
  
  1;
  
ALGORITHM_DEPENDENCY_ITEM

$fatpacked{"Algorithm/Dependency/Ordered.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'ALGORITHM_DEPENDENCY_ORDERED';
  package Algorithm::Dependency::Ordered;
  
  
  use 5.005;
  use strict;
  use Algorithm::Dependency ();
  
  use vars qw{$VERSION @ISA};
  BEGIN {
  	$VERSION = '1.110';
  	@ISA     = 'Algorithm::Dependency';
  }
  
  
  
  
  
  sub schedule {
  	my $self   = shift;
  	my $source = $self->{source};
  	my @items  = @_ or return undef;
  	return undef if grep { ! $source->item($_) } @items;
  
  	my $rv    = $self->SUPER::schedule( @items );
  	my @queue = $rv ? @$rv : return undef;
  
  	my %selected = %{ $self->{selected} };
  
  	my $error_marker = '';
  
  	my @schedule = ();
  	while ( my $id = shift @queue ) {
  		return undef if $id eq $error_marker;
  
  		my $Item    = $self->{source}->item($id) or return undef;
  		my @missing = grep { ! $selected{$_} } $Item->depends;
  
  		if ( $self->{ignore_orphans} ) {
  			@missing = grep { $self->{source}->item($_) } @missing;
  		}
  
  		if ( @missing ) {
  			$error_marker = $id unless $error_marker;
  
  			push @queue, $id;
  			next;
  		}
  
  		push @schedule, $id;
  		$selected{$id} = 1;
  		$error_marker  = '';
  	}
  
  	\@schedule;
  }
  
  1;
  
ALGORITHM_DEPENDENCY_ORDERED

$fatpacked{"Algorithm/Dependency/Source.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'ALGORITHM_DEPENDENCY_SOURCE';
  package Algorithm::Dependency::Source;
  
  
  use 5.005;
  use strict;
  use Algorithm::Dependency ();
  use Params::Util qw{_SET};
  
  use vars qw{$VERSION};
  BEGIN {
  	$VERSION = '1.110';
  }
  
  
  
  
  
  
  
  sub new {
  	my $class = shift;
  
  	if ( $class eq __PACKAGE__ ) {
  		die "Cannot directly instantiate Algorithm::Dependency::Source."
  			. " You must use a subclass";
  	}
  
  	my $self = bless {
  		loaded      => 0,
  
  		items_hash  => undef,
  		items_array => undef,
  		}, $class;
  
  	$self;
  }
  
  
  sub load {
  	my $self = shift;
  
  	if ( $self->{loaded} ) {
  		$self->{loaded}      = 0;
  		$self->{items_hash}  = undef;
  		$self->{items_array} = undef;
  	}
  
  	my $items = $self->_load_item_list;
  	return $items unless $items;
  	unless ( _SET($items, 'Algorithm::Dependency::Item') ) {
  		die( ref($self) . "::_load_item_list did not return an Algorithm::Dependency::Item set" );
  	}
  
  	foreach my $item ( @$items ) {
  		my $id = $item->id;
  		if ( $self->{items_hash}->{ $id } ) {
  			return undef;
  		}
  
  		push @{ $self->{items_array} }, $item;
  		$self->{items_hash}->{$id} = $item;
  	}
  
  	$self->{loaded} = 1;
  }
  
  
  sub item {
  	my $self = shift;
  	my $id   = (defined $_[0] and ! ref $_[0] and $_[0] ne '') ? shift : return undef;
  	$self->{loaded} or $self->load or return undef;
  
  	$self->{items_hash}->{$id};
  }
  
  
  sub items {
  	my $self = shift;
  	$self->{loaded} or $self->load or return undef;
  	@{ $self->{items_array} };
  }
  
  
  sub missing_dependencies {
  	my $self = shift;
  	$self->{loaded} or $self->load or return undef;
  	
  	my %missing = map  { $_ => 1           }
  	              grep { ! $self->item($_) }
  	              map  { $_->depends       }
  	              $self->items;
  	%missing ? [ sort keys %missing ] : 0;
  }
  
  
  
  
  
  
  sub _load_item_list {
  	die "Class $_[0] failed to define the method _load_item_list";
  }
  
  1;
  
ALGORITHM_DEPENDENCY_SOURCE

$fatpacked{"Algorithm/Dependency/Source/File.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'ALGORITHM_DEPENDENCY_SOURCE_FILE';
  package Algorithm::Dependency::Source::File;
  
  
  use 5.005;
  use strict;
  use Algorithm::Dependency::Source ();
  
  use vars qw{$VERSION @ISA};
  BEGIN {
  	$VERSION = '1.110';
  	@ISA     = 'Algorithm::Dependency::Source';
  }
  
  
  
  
  
  
  
  sub new {
  	my $class    = shift;
  	my $filename = shift or return undef;
  	return undef unless -r $filename;
  
  	my $self = $class->SUPER::new() or return undef;
  
  	$self->{filename} = $filename;
  
  	$self;
  }
  
  
  
  
  
  
  sub _load_item_list {
  	my $self = shift;
  
  	local $/ = undef;
  	open( FILE, $self->{filename} ) or return undef;
  	defined(my $source = <FILE>)    or return undef;
  	close( FILE )                   or return undef;
  
  	my @content = grep { ! /^\s*(?:\#|$)/ } 
  		split /\s*[\015\012][\s\015\012]*/, $source;
  
  	my @Items = ();
  	foreach my $line ( @content ) {
  		my @sections = grep { length $_ } split /\W+/, $line;
  		return undef unless scalar @sections;
  
  		my $Item = Algorithm::Dependency::Item->new( @sections ) or return undef;
  		push @Items, $Item;
  	}
  
  	\@Items;
  }
  
  1;
  
ALGORITHM_DEPENDENCY_SOURCE_FILE

$fatpacked{"Algorithm/Dependency/Source/HoA.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'ALGORITHM_DEPENDENCY_SOURCE_HOA';
  package Algorithm::Dependency::Source::HoA;
  
  
  use 5.005;
  use strict;
  use Algorithm::Dependency::Source ();
  use Params::Util qw{_HASH _ARRAY0};
  
  use vars qw{$VERSION @ISA};
  BEGIN {
  	$VERSION = '1.110';
  	@ISA     = 'Algorithm::Dependency::Source';
  }
  
  
  
  
  
  
  
  sub new {
  	my $class = shift;
  	my $hash  = _HASH(shift) or return undef;
  	foreach my $deps ( values %$hash ) {
  		_ARRAY0($deps) or return undef;
  	}
  
  	my $self = $class->SUPER::new() or return undef;
  
  	$self->{hash} = $hash;
  
  	$self;
  }
  
  
  
  
  
  
  sub _load_item_list {
  	my $self = shift;
  
  	my $hash  = $self->{hash};
  	my @items = map {
  		Algorithm::Dependency::Item->new( $_, @{$hash->{$_}} )
  		or return undef;
  		} keys %$hash;
  
  	\@items;
  }
  
  1;
  
ALGORITHM_DEPENDENCY_SOURCE_HOA

$fatpacked{"Algorithm/Dependency/Source/Invert.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'ALGORITHM_DEPENDENCY_SOURCE_INVERT';
  package Algorithm::Dependency::Source::Invert;
  
  
  use 5.005;
  use strict;
  use Params::Util '_INSTANCE';
  use Algorithm::Dependency::Source::HoA ();
  
  use vars qw{$VERSION @ISA};
  BEGIN {
  	$VERSION = '1.110';
  	@ISA     = 'Algorithm::Dependency::Source::HoA';
  }
  
  
  
  
  
  
  sub new {
  	my $class  = shift;
  	my $source = _INSTANCE(shift, 'Algorithm::Dependency::Source') or return undef;
  
  	my @items = $source->items;
  	my %hoa   = map { $_->id => [ ] } @items;
  	foreach my $item ( @items ) {
  		my $id   = $item->id;
  		my @deps = $item->depends;
  		foreach my $dep ( @deps ) {
  			push @{ $hoa{$dep} }, $id;
  		}
  	}
  
  	$class->SUPER::new( \%hoa );
  }
  
  1;
  
ALGORITHM_DEPENDENCY_SOURCE_INVERT

$fatpacked{"Algorithm/Dependency/Weight.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'ALGORITHM_DEPENDENCY_WEIGHT';
  package Algorithm::Dependency::Weight;
  
  
  use 5.005;
  use strict;
  use List::Util            ();
  use Algorithm::Dependency ();
  use Params::Util qw{_INSTANCE _STRING};
  
  use vars qw{$VERSION};
  BEGIN {
  	$VERSION = '1.110';
  }
  
  
  
  
  
  
  
  sub new {
  	my $class = shift;
  	my %args  = @_;
  
  	my $source = _INSTANCE($args{source}, 'Algorithm::Dependency')
  		? $args{source}->source
  		: _INSTANCE($args{source}, 'Algorithm::Dependency::Source')
  		or return undef;
  
  	my $algdep = Algorithm::Dependency->new(
  		source         => $source,
  		ignore_orphans => 1,
  		) or return undef;
  
  	my $self = bless {
  		source => $source,
  		algdep => $algdep,
  		weight => {},
  		}, $class;
  
  	$self;
  }
  
  
  sub source {
  	$_[0]->{source}
  }
  
  
  
  
  
  
  
  sub weight {
  	my $self = shift;
  	my $id   = defined(_STRING($_[0])) ? shift : return undef;
  	$self->{weight}->{$id} or
  	$self->{weight}->{$id} = $self->_weight($id);
  }
  
  sub _weight {
  	my $self  = shift;
  	my $items = $self->{algdep}->schedule($_[0]) or return undef;
  	scalar(@$items);
  }
  
  
  sub weight_merged {
  	my $self  = shift;
  	my $items = $self->{algdep}->schedule(@_) or return undef;
  	scalar(@$items);
  }
  
  
  sub weight_hash {
  	my $self  = shift;
  	my @names = @_;
  
  	my %hash = ();
  	foreach my $name ( @names ) {
  		if ( $self->{weight}->{$name} ) {
  			$hash{$name} = $self->{weight}->{$name};
  			next;
  		}
  		$hash{$name} = $self->weight($name) or return undef;
  	}
  
  	\%hash;
  }
  
  
  sub weight_all {
  	my $self  = shift;
  	my @items = $self->source->items;
  	defined $items[0] or return undef;
  	$self->weight_hash( map { $_->id } @items );
  }
  
  1;
  
ALGORITHM_DEPENDENCY_WEIGHT

$fatpacked{"App/pause.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'APP_PAUSE';
  package App::pause;
  
  
  1;
  
APP_PAUSE

$fatpacked{"App/pause/Fattened.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'APP_PAUSE_FATTENED';
  package App::pause::Fattened;
  
  
  
  1;
APP_PAUSE_FATTENED

$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{"Color/ANSI/Util.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'COLOR_ANSI_UTIL';
  package Color::ANSI::Util;
  
  our $DATE = '2015-01-03'; 
  our $VERSION = '0.14'; 
  
  use 5.010001;
  use strict;
  use warnings;
  
  require Exporter;
  our @ISA       = qw(Exporter);
  our @EXPORT_OK = qw(
                         ansi16_to_rgb
                         rgb_to_ansi16
                         rgb_to_ansi16_fg_code
                         ansi16fg
                         rgb_to_ansi16_bg_code
                         ansi16bg
  
                         ansi256_to_rgb
                         rgb_to_ansi256
                         rgb_to_ansi256_fg_code
                         ansi256fg
                         rgb_to_ansi256_bg_code
                         ansi256bg
  
                         rgb_to_ansi24b_fg_code
                         ansi24bfg
                         rgb_to_ansi24b_bg_code
                         ansi24bbg
  
                         rgb_to_ansi_fg_code
                         ansifg
                         rgb_to_ansi_bg_code
                         ansibg
                 );
  
  my %ansi16 = (
      0  => '000000',
      1  => '800000',
      2  => '008000',
      3  => '808000',
      4  => '000080',
      5  => '800080',
      6  => '008080',
      7  => 'c0c0c0',
      8  => '808080',
      9  => 'ff0000',
      10 => '00ff00',
      11 => 'ffff00',
      12 => '0000ff',
      13 => 'ff00ff',
      14 => '00ffff',
      15 => 'ffffff',
  );
  my @revansi16;
  for (sort {$a<=>$b} keys %ansi16) {
      $ansi16{$_} =~ /(..)(..)(..)/;
      push @revansi16, [hex($1), hex($2), hex($3), $_];
  }
  
  my %ansi256 = (
      %ansi16,
  
      16 => '000000',  17 => '00005f',  18 => '000087',  19 => '0000af',  20 => '0000d7',  21 => '0000ff',
      22 => '005f00',  23 => '005f5f',  24 => '005f87',  25 => '005faf',  26 => '005fd7',  27 => '005fff',
      28 => '008700',  29 => '00875f',  30 => '008787',  31 => '0087af',  32 => '0087d7',  33 => '0087ff',
      34 => '00af00',  35 => '00af5f',  36 => '00af87',  37 => '00afaf',  38 => '00afd7',  39 => '00afff',
      40 => '00d700',  41 => '00d75f',  42 => '00d787',  43 => '00d7af',  44 => '00d7d7',  45 => '00d7ff',
      46 => '00ff00',  47 => '00ff5f',  48 => '00ff87',  49 => '00ffaf',  50 => '00ffd7',  51 => '00ffff',
      52 => '5f0000',  53 => '5f005f',  54 => '5f0087',  55 => '5f00af',  56 => '5f00d7',  57 => '5f00ff',
      58 => '5f5f00',  59 => '5f5f5f',  60 => '5f5f87',  61 => '5f5faf',  62 => '5f5fd7',  63 => '5f5fff',
      64 => '5f8700',  65 => '5f875f',  66 => '5f8787',  67 => '5f87af',  68 => '5f87d7',  69 => '5f87ff',
      70 => '5faf00',  71 => '5faf5f',  72 => '5faf87',  73 => '5fafaf',  74 => '5fafd7',  75 => '5fafff',
      76 => '5fd700',  77 => '5fd75f',  78 => '5fd787',  79 => '5fd7af',  80 => '5fd7d7',  81 => '5fd7ff',
      82 => '5fff00',  83 => '5fff5f',  84 => '5fff87',  85 => '5fffaf',  86 => '5fffd7',  87 => '5fffff',
      88 => '870000',  89 => '87005f',  90 => '870087',  91 => '8700af',  92 => '8700d7',  93 => '8700ff',
      94 => '875f00',  95 => '875f5f',  96 => '875f87',  97 => '875faf',  98 => '875fd7',  99 => '875fff',
      100 => '878700', 101 => '87875f', 102 => '878787', 103 => '8787af', 104 => '8787d7', 105 => '8787ff',
      106 => '87af00', 107 => '87af5f', 108 => '87af87', 109 => '87afaf', 110 => '87afd7', 111 => '87afff',
      112 => '87d700', 113 => '87d75f', 114 => '87d787', 115 => '87d7af', 116 => '87d7d7', 117 => '87d7ff',
      118 => '87ff00', 119 => '87ff5f', 120 => '87ff87', 121 => '87ffaf', 122 => '87ffd7', 123 => '87ffff',
      124 => 'af0000', 125 => 'af005f', 126 => 'af0087', 127 => 'af00af', 128 => 'af00d7', 129 => 'af00ff',
      130 => 'af5f00', 131 => 'af5f5f', 132 => 'af5f87', 133 => 'af5faf', 134 => 'af5fd7', 135 => 'af5fff',
      136 => 'af8700', 137 => 'af875f', 138 => 'af8787', 139 => 'af87af', 140 => 'af87d7', 141 => 'af87ff',
      142 => 'afaf00', 143 => 'afaf5f', 144 => 'afaf87', 145 => 'afafaf', 146 => 'afafd7', 147 => 'afafff',
      148 => 'afd700', 149 => 'afd75f', 150 => 'afd787', 151 => 'afd7af', 152 => 'afd7d7', 153 => 'afd7ff',
      154 => 'afff00', 155 => 'afff5f', 156 => 'afff87', 157 => 'afffaf', 158 => 'afffd7', 159 => 'afffff',
      160 => 'd70000', 161 => 'd7005f', 162 => 'd70087', 163 => 'd700af', 164 => 'd700d7', 165 => 'd700ff',
      166 => 'd75f00', 167 => 'd75f5f', 168 => 'd75f87', 169 => 'd75faf', 170 => 'd75fd7', 171 => 'd75fff',
      172 => 'd78700', 173 => 'd7875f', 174 => 'd78787', 175 => 'd787af', 176 => 'd787d7', 177 => 'd787ff',
      178 => 'd7af00', 179 => 'd7af5f', 180 => 'd7af87', 181 => 'd7afaf', 182 => 'd7afd7', 183 => 'd7afff',
      184 => 'd7d700', 185 => 'd7d75f', 186 => 'd7d787', 187 => 'd7d7af', 188 => 'd7d7d7', 189 => 'd7d7ff',
      190 => 'd7ff00', 191 => 'd7ff5f', 192 => 'd7ff87', 193 => 'd7ffaf', 194 => 'd7ffd7', 195 => 'd7ffff',
      196 => 'ff0000', 197 => 'ff005f', 198 => 'ff0087', 199 => 'ff00af', 200 => 'ff00d7', 201 => 'ff00ff',
      202 => 'ff5f00', 203 => 'ff5f5f', 204 => 'ff5f87', 205 => 'ff5faf', 206 => 'ff5fd7', 207 => 'ff5fff',
      208 => 'ff8700', 209 => 'ff875f', 210 => 'ff8787', 211 => 'ff87af', 212 => 'ff87d7', 213 => 'ff87ff',
      214 => 'ffaf00', 215 => 'ffaf5f', 216 => 'ffaf87', 217 => 'ffafaf', 218 => 'ffafd7', 219 => 'ffafff',
      220 => 'ffd700', 221 => 'ffd75f', 222 => 'ffd787', 223 => 'ffd7af', 224 => 'ffd7d7', 225 => 'ffd7ff',
      226 => 'ffff00', 227 => 'ffff5f', 228 => 'ffff87', 229 => 'ffffaf', 230 => 'ffffd7', 231 => 'ffffff',
  
      232 => '080808', 233 => '121212', 234 => '1c1c1c', 235 => '262626', 236 => '303030', 237 => '3a3a3a',
      238 => '444444', 239 => '4e4e4e', 240 => '585858', 241 => '606060', 242 => '666666', 243 => '767676',
      244 => '808080', 245 => '8a8a8a', 246 => '949494', 247 => '9e9e9e', 248 => 'a8a8a8', 249 => 'b2b2b2',
      250 => 'bcbcbc', 251 => 'c6c6c6', 252 => 'd0d0d0', 253 => 'dadada', 254 => 'e4e4e4', 255 => 'eeeeee',
  );
  my @revansi256;
  for (sort {$a<=>$b} keys %ansi256) {
      $ansi256{$_} =~ /(..)(..)(..)/;
      push @revansi256, [hex($1), hex($2), hex($3), $_];
  }
  
  sub ansi16_to_rgb {
      my ($input) = @_;
  
      if ($input =~ /^\d+$/) {
          if ($input >= 0 && $input <= 15) {
              return $ansi16{$input + 0}; 
          } else {
              die "Invalid ANSI 16-color number '$input'";
          }
      } elsif ($input =~ /^(?:(bold|bright) \s )?
                          (black|red|green|yellow|blue|magenta|cyan|white)$/ix) {
          my ($bold, $col) = (lc($1 // ""), lc($2));
          my $i;
          if ($col eq 'black') {
              $i = 0;
          } elsif ($col eq 'red') {
              $i = 1;
          } elsif ($col eq 'green') {
              $i = 2;
          } elsif ($col eq 'yellow') {
              $i = 3;
          } elsif ($col eq 'blue') {
              $i = 4;
          } elsif ($col eq 'magenta') {
              $i = 5;
          } elsif ($col eq 'cyan') {
              $i = 6;
          } elsif ($col eq 'white') {
              $i = 7;
          }
          $i += 8 if $bold;
          return $ansi16{$i};
      } else {
          die "Invalid ANSI 16-color name '$input'";
      }
  }
  
  sub _rgb_to_indexed {
      my ($rgb, $table) = @_;
  
      $rgb =~ /^#?([0-9A-Fa-f]{2})([0-9A-Fa-f]{2})([0-9A-Fa-f]{2})$/
          or die "Invalid RGB input '$rgb'";
      my $r = hex($1);
      my $g = hex($2);
      my $b = hex($3);
  
      my ($minsqdist, $res);
      for my $e (@$table) {
          my $sqdist =
              abs($e->[0]-$r)**2 + abs($e->[1]-$g)**2 + abs($e->[2]-$b)**2;
          return $e->[3] if $sqdist == 0;
          if (!defined($minsqdist) || $minsqdist > $sqdist) {
              $minsqdist = $sqdist;
              $res = $e->[3];
          }
      }
      return $res;
  }
  
  sub ansi256_to_rgb {
      my ($input) = @_;
  
      $input += 0;
      exists($ansi256{$input}) or die "Invalid ANSI 256-color index '$input'";
      $ansi256{$input};
  }
  
  sub rgb_to_ansi16 {
      my ($input) = @_;
      _rgb_to_indexed($input, \@revansi16);
  }
  
  sub rgb_to_ansi256 {
      my ($input) = @_;
      _rgb_to_indexed($input, \@revansi256);
  }
  
  sub rgb_to_ansi16_fg_code {
      my ($input) = @_;
  
      my $res = _rgb_to_indexed($input, \@revansi16);
      return "\e[" . ($res >= 8 ? ($res+30-8) . ";1" : ($res+30)) . "m";
  }
  
  sub ansi16fg  { goto &rgb_to_ansi16_fg_code  }
  
  sub rgb_to_ansi16_bg_code {
      my ($input) = @_;
  
      my $res = _rgb_to_indexed($input, \@revansi16);
      return "\e[" . ($res >= 8 ? ($res+40-8) : ($res+40)) . "m";
  }
  
  sub ansi16bg  { goto &rgb_to_ansi16_bg_code  }
  
  sub rgb_to_ansi256_fg_code {
      my ($input) = @_;
  
      my $res = _rgb_to_indexed($input, \@revansi16);
      return "\e[38;5;${res}m";
  }
  
  sub ansi256fg { goto &rgb_to_ansi256_fg_code }
  
  sub rgb_to_ansi256_bg_code {
      my ($input) = @_;
  
      my $res = _rgb_to_indexed($input, \@revansi16);
      return "\e[48;5;${res}m";
  }
  
  sub ansi256bg { goto &rgb_to_ansi256_bg_code }
  
  sub rgb_to_ansi24b_fg_code {
      my ($rgb) = @_;
  
      return sprintf("\e[38;2;%d;%d;%dm",
                     hex(substr($rgb, 0, 2)),
                     hex(substr($rgb, 2, 2)),
                     hex(substr($rgb, 4, 2)));
  }
  
  sub ansi24bfg { goto &rgb_to_ansi24b_fg_code }
  
  sub rgb_to_ansi24b_bg_code {
      my ($rgb) = @_;
  
      return sprintf("\e[48;2;%d;%d;%dm",
                     hex(substr($rgb, 0, 2)),
                     hex(substr($rgb, 2, 2)),
                     hex(substr($rgb, 4, 2)));
  }
  
  sub ansi24bbg { goto &rgb_to_ansi24b_bg_code }
  
  our $_use_termdetsw = 1;
  our $_color_depth; 
  sub _color_depth {
      unless (defined $_color_depth) {
          {
              if (defined $ENV{COLOR_DEPTH}) {
                  $_color_depth = $ENV{COLOR_DEPTH};
                  last;
              }
              if ($_use_termdetsw) {
                  eval { require Term::Detect::Software };
                  if (!$@) {
                      $_color_depth = Term::Detect::Software::detect_terminal_cached()->{color_depth};
                      last;
                  }
              }
              if ($ENV{KONSOLE_DBUS_SERVICE}) {
                  $_color_depth = 2**24;
                  last;
              }
              $_color_depth = 16;
          }
      };
      $_color_depth;
  }
  
  sub rgb_to_ansi_fg_code {
      my ($rgb) = @_;
      my $cd = _color_depth();
      if ($cd >= 2**24) {
          rgb_to_ansi24b_fg_code($rgb);
      } elsif ($cd >= 256) {
          rgb_to_ansi256_fg_code($rgb);
      } else {
          rgb_to_ansi16_fg_code($rgb);
      }
  }
  
  sub ansifg { goto &rgb_to_ansi_fg_code }
  
  sub rgb_to_ansi_bg_code {
      my ($rgb) = @_;
      my $cd = _color_depth();
      if ($cd >= 2**24) {
          rgb_to_ansi24b_bg_code($rgb);
      } elsif ($cd >= 256) {
          rgb_to_ansi256_bg_code($rgb);
      } else {
          rgb_to_ansi16_bg_code($rgb);
      }
  }
  
  sub ansibg { goto &rgb_to_ansi_bg_code }
  
  1;
  
  __END__
  
COLOR_ANSI_UTIL

$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/Fish.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'COMPLETE_FISH';
  package Complete::Fish;
  
  our $DATE = '2014-11-29'; 
  our $VERSION = '0.03'; 
  
  use 5.010001;
  use strict;
  use warnings;
  
  require Exporter;
  our @ISA = qw(Exporter);
  our @EXPORT_OK = qw(
                         format_completion
                 );
  
  require Complete::Bash;
  
  our %SPEC;
  
  $SPEC{parse_cmdline} = {
      v => 1.1,
      summary => 'Parse shell command-line for processing by completion routines',
      description => <<'_',
  
  This function converts COMMAND_LINE (str) given by tcsh to become something like
  COMP_WORDS (array) and COMP_CWORD (int), like what bash supplies to shell
  functions. Currently implemented using `Complete::Bash`'s `parse_cmdline`.
  
  _
      args_as => 'array',
      args => {
          cmdline => {
              summary => 'Command-line, defaults to COMMAND_LINE environment',
              schema => 'str*',
              pos => 0,
          },
      },
      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,
  };
  sub parse_cmdline {
      my ($line) = @_;
  
      $line //= $ENV{COMMAND_LINE};
      Complete::Bash::parse_cmdline($line, length($line));
  }
  
  $SPEC{format_completion} = {
      v => 1.1,
      summary => 'Format completion for output (for shell)',
      description => <<'_',
  
  fish accepts completion reply in the form of one entry per line to STDOUT.
  Description can be added to each entry, prefixed by tab character.
  
  _
      args_as => 'array',
      args => {
          completion => {
              summary => 'Completion answer structure',
              description => <<'_',
  
  Either an array or hash, as described in `Complete`.
  
  _
              schema=>['any*' => of => ['hash*', 'array*']],
              req=>1,
              pos=>0,
          },
      },
      result => {
          summary => 'Formatted string (or array, if `as` key is set to `array`)',
          schema => ['any*' => of => ['str*', 'array*']],
      },
      result_naked => 1,
  };
  sub format_completion {
      my $comp = shift;
  
      my $as;
      my $entries;
  
      if (ref($comp) eq 'HASH') {
          $as = $comp->{as} // 'string';
          $entries = Complete::Bash::format_completion({%$comp, as=>'array'});
      } else {
          $as = 'string';
          $entries = Complete::Bash::format_completion({
              words=>$comp, as=>'array',
          });
      }
  
      {
          my $compary = ref($comp) eq 'HASH' ? $comp->{words} : $comp;
          for (my $i=0; $i<@$compary; $i++) {
  
              my $desc = (ref($compary->[$i]) eq 'HASH' ?
                              $compary->[$i]{description} : '' ) // '';
              $desc =~ s/\R/ /g;
              $entries->[$i] .= "\t$desc";
          }
      }
  
      if ($as eq 'string') {
          $entries = join("", map{"$_\n"} @$entries);
      }
      $entries;
  }
  
  1;
  
  __END__
  
COMPLETE_FISH

$fatpacked{"Complete/Getopt/Long.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'COMPLETE_GETOPT_LONG';
  package Complete::Getopt::Long;
  
  our $DATE = '2015-04-25'; 
  our $VERSION = '0.32'; 
  
  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;
  
      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 @answers;
  
      {
          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 @answers, $compres;
          if (!exists($exp->{optval}) && !exists($exp->{arg})) {
              $fres = {words=>$compres, 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');
          }
          push @answers, $compres;
      }
  
      {
          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);
          }
          push @answers, $compres;
      }
  
      $log->tracef("[comp][compgl] combining result from %d source(s)", ~~@answers);
      $fres = Complete::Util::combine_answers(@answers) // [];
  
    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/Tcsh.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'COMPLETE_TCSH';
  package Complete::Tcsh;
  
  our $DATE = '2014-11-23'; 
  our $VERSION = '0.01'; 
  
  use 5.010001;
  use strict;
  use warnings;
  
  require Exporter;
  our @ISA = qw(Exporter);
  our @EXPORT_OK = qw(
                         parse_cmdline
                         format_completion
                 );
  
  require Complete::Bash;
  
  our %SPEC;
  
  $SPEC{parse_cmdline} = {
      v => 1.1,
      summary => 'Parse shell command-line for processing by completion routines',
      description => <<'_',
  
  This function converts COMMAND_LINE (str) given by tcsh to become something like
  COMP_WORDS (array) and COMP_CWORD (int), like what bash supplies to shell
  functions. Currently implemented using `Complete::Bash`'s `parse_cmdline`.
  
  _
      args_as => 'array',
      args => {
          cmdline => {
              summary => 'Command-line, defaults to COMMAND_LINE environment',
              schema => 'str*',
              pos => 0,
          },
      },
      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,
  };
  sub parse_cmdline {
      my ($line) = @_;
  
      $line //= $ENV{COMMAND_LINE};
      Complete::Bash::parse_cmdline($line, length($line));
  }
  
  $SPEC{format_completion} = {
      v => 1.1,
      summary => 'Format completion for output (for shell)',
      description => <<'_',
  
  tcsh accepts completion reply in the form of one entry per line to STDOUT.
  Currently the formatting is done using `Complete::Bash`'s `format_completion`
  because escaping rule and so on are not yet well defined in tcsh.
  
  _
      args_as => 'array',
      args => {
          shell_completion => {
              summary => 'Result of shell completion',
              description => <<'_',
  
  Either an array or hash.
  
  _
              schema=>['any*' => of => ['hash*', 'array*']],
              req=>1,
              pos=>0,
          },
          as => {
              schema => ['str*', in=>['string', 'array']],
              default => 'string',
          },
      },
      result => {
          summary => 'Formatted string (or array, if `as` is set to `array`)',
          schema => ['any*' => of => ['str*', 'array*']],
      },
      result_naked => 1,
  };
  sub format_completion {
      Complete::Bash::format_completion(@_);
  }
  
  1;
  
  __END__
  
COMPLETE_TCSH

$fatpacked{"Complete/Util.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'COMPLETE_UTIL';
  package Complete::Util;
  
  our $DATE = '2015-06-08'; 
  our $VERSION = '0.31'; 
  
  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_rels => {
          choose_one => [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),
      );
  
  If a completion answer has a metadata `final` set to true, then that answer is
  used as the final answer without any combining with the other answers.
  
  _
      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} }
                          );
          }
      };
  
    ANSWER:
      for my $ans (@_) {
          if (ref($ans) eq 'ARRAY') {
              $add_words->($ans);
          } elsif (ref($ans) eq 'HASH') {
              $encounter_hash++;
  
              if ($ans->{final}) {
                  $final = $ans;
                  last ANSWER;
              }
  
              $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->{$_};
                  }
              }
          }
      }
  
      if ($final->{words}) {
          $final->{words} = [
              sort {
                  (ref($a) ? $a->{word} : $a) cmp
                      (ref($b) ? $b->{word} : $b);
              }
                  @{ $final->{words} }];
      }
  
      $encounter_hash ? $final : $final->{words};
  }
  
  
  1;
  
  __END__
  
COMPLETE_UTIL

$fatpacked{"Complete/Zsh.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'COMPLETE_ZSH';
  package Complete::Zsh;
  
  our $DATE = '2014-11-29'; 
  our $VERSION = '0.01'; 
  
  use 5.010001;
  use strict;
  use warnings;
  
  require Exporter;
  our @ISA = qw(Exporter);
  our @EXPORT_OK = qw(
                         parse_cmdline
                         format_completion
                 );
  
  require Complete::Bash;
  
  our %SPEC;
  
  $SPEC{parse_cmdline} = {
      v => 1.1,
      summary => 'Parse shell command-line for processing by completion routines',
      description => <<'_',
  
  This function converts COMP_LINE (str) (which can be supplied by zsh from `read
  -l`) and COMP_POINT (int) (which can be supplied by zsh from `read -ln`) into
  COMP_WORDS (array) and COMP_CWORD (int), like what bash supplies to shell
  functions. Currently implemented using `Complete::Bash`'s `parse_cmdline`.
  
  _
      args_as => 'array',
      args => {
          cmdline => {
              summary => 'Command-line, defaults to COMP_LINE environment',
              schema => 'str*',
              pos => 0,
          },
      },
      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,
  };
  sub parse_cmdline {
      my ($line) = @_;
  
      $line //= $ENV{COMP_LINE};
      Complete::Bash::parse_cmdline($line, length($line));
  }
  
  $SPEC{format_completion} = {
      v => 1.1,
      summary => 'Format completion for output (for shell)',
      description => <<'_',
  
  zsh accepts completion reply in the form of one entry per line to STDOUT.
  Currently the formatting is done using `Complete::Bash`'s `format_completion`.
  
  _
      args_as => 'array',
      args => {
          completion => {
              summary => 'Completion answer structure',
              description => <<'_',
  
  Either an array or hash, as described in `Complete`.
  
  _
              schema=>['any*' => of => ['hash*', 'array*']],
              req=>1,
              pos=>0,
          },
      },
      result => {
          summary => 'Formatted string (or array, if `as` key is set to `array`)',
          schema => ['any*' => of => ['str*', 'array*']],
      },
      result_naked => 1,
  };
  sub format_completion {
      Complete::Bash::format_completion(@_);
  }
  
  1;
  
  __END__
  
COMPLETE_ZSH

$fatpacked{"Compress/Raw/Bzip2.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'COMPRESS_RAW_BZIP2';
  
  package Compress::Raw::Bzip2;
  
  use strict ;
  use warnings ;
  
  require 5.006 ;
  require Exporter;
  use Carp ;
  
  use bytes ;
  our ($VERSION, $XS_VERSION, @ISA, @EXPORT, $AUTOLOAD);
  
  $VERSION = '2.068';
  $XS_VERSION = $VERSION; 
  $VERSION = eval $VERSION;
  
  @ISA = qw(Exporter);
  @EXPORT = qw(
  		BZ_RUN
  		BZ_FLUSH
  		BZ_FINISH
  
  		BZ_OK
  		BZ_RUN_OK
  		BZ_FLUSH_OK
  		BZ_FINISH_OK
  		BZ_STREAM_END
  		BZ_SEQUENCE_ERROR
  		BZ_PARAM_ERROR
  		BZ_MEM_ERROR
  		BZ_DATA_ERROR
  		BZ_DATA_ERROR_MAGIC
  		BZ_IO_ERROR
  		BZ_UNEXPECTED_EOF
  		BZ_OUTBUFF_FULL
  		BZ_CONFIG_ERROR
  
      );
  
  sub AUTOLOAD {
      my($constname);
      ($constname = $AUTOLOAD) =~ s/.*:://;
      my ($error, $val) = constant($constname);
      Carp::croak $error if $error;
      no strict 'refs';
      *{$AUTOLOAD} = sub { $val };
      goto &{$AUTOLOAD};
  
  }
  
  use constant FLAG_APPEND             => 1 ;
  use constant FLAG_CRC                => 2 ;
  use constant FLAG_ADLER              => 4 ;
  use constant FLAG_CONSUME_INPUT      => 8 ;
  
  eval {
      require XSLoader;
      XSLoader::load('Compress::Raw::Bzip2', $XS_VERSION);
      1;
  } 
  or do {
      require DynaLoader;
      local @ISA = qw(DynaLoader);
      bootstrap Compress::Raw::Bzip2 $XS_VERSION ; 
  };
  
  
  sub Compress::Raw::Bzip2::STORABLE_freeze
  {
      my $type = ref shift;
      croak "Cannot freeze $type object\n";
  }
  
  sub Compress::Raw::Bzip2::STORABLE_thaw
  {
      my $type = ref shift;
      croak "Cannot thaw $type object\n";
  }
  
  sub Compress::Raw::Bunzip2::STORABLE_freeze
  {
      my $type = ref shift;
      croak "Cannot freeze $type object\n";
  }
  
  sub Compress::Raw::Bunzip2::STORABLE_thaw
  {
      my $type = ref shift;
      croak "Cannot thaw $type object\n";
  }
  
  
  package Compress::Raw::Bzip2;
  
  1;
  
  __END__
  
  
COMPRESS_RAW_BZIP2

$fatpacked{"Compress/Raw/Zlib.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'COMPRESS_RAW_ZLIB';
  
  package Compress::Raw::Zlib;
  
  require 5.006 ;
  require Exporter;
  use Carp ;
  
  use strict ;
  use warnings ;
  use bytes ;
  our ($VERSION, $XS_VERSION, @ISA, @EXPORT, %EXPORT_TAGS, @EXPORT_OK, $AUTOLOAD, %DEFLATE_CONSTANTS, @DEFLATE_CONSTANTS);
  
  $VERSION = '2.068';
  $XS_VERSION = $VERSION; 
  $VERSION = eval $VERSION;
  
  @ISA = qw(Exporter);
  %EXPORT_TAGS = ( flush     => [qw{  
                                      Z_NO_FLUSH
                                      Z_PARTIAL_FLUSH
                                      Z_SYNC_FLUSH
                                      Z_FULL_FLUSH
                                      Z_FINISH
                                      Z_BLOCK
                                }],
                   level     => [qw{  
                                      Z_NO_COMPRESSION
                                      Z_BEST_SPEED
                                      Z_BEST_COMPRESSION
                                      Z_DEFAULT_COMPRESSION
                                }],
                   strategy  => [qw{  
                                      Z_FILTERED
                                      Z_HUFFMAN_ONLY
                                      Z_RLE
                                      Z_FIXED
                                      Z_DEFAULT_STRATEGY
                                }],
                   status   => [qw{  
                                      Z_OK
                                      Z_STREAM_END
                                      Z_NEED_DICT
                                      Z_ERRNO
                                      Z_STREAM_ERROR
                                      Z_DATA_ERROR  
                                      Z_MEM_ERROR   
                                      Z_BUF_ERROR 
                                      Z_VERSION_ERROR 
                                }],                              
                );
  
  %DEFLATE_CONSTANTS = %EXPORT_TAGS;
  
  @DEFLATE_CONSTANTS = 
  @EXPORT = qw(
          ZLIB_VERSION
          ZLIB_VERNUM
  
          
          OS_CODE
  
          MAX_MEM_LEVEL
          MAX_WBITS
  
          Z_ASCII
          Z_BEST_COMPRESSION
          Z_BEST_SPEED
          Z_BINARY
          Z_BLOCK
          Z_BUF_ERROR
          Z_DATA_ERROR
          Z_DEFAULT_COMPRESSION
          Z_DEFAULT_STRATEGY
          Z_DEFLATED
          Z_ERRNO
          Z_FILTERED
          Z_FIXED
          Z_FINISH
          Z_FULL_FLUSH
          Z_HUFFMAN_ONLY
          Z_MEM_ERROR
          Z_NEED_DICT
          Z_NO_COMPRESSION
          Z_NO_FLUSH
          Z_NULL
          Z_OK
          Z_PARTIAL_FLUSH
          Z_RLE
          Z_STREAM_END
          Z_STREAM_ERROR
          Z_SYNC_FLUSH
          Z_TREES
          Z_UNKNOWN
          Z_VERSION_ERROR
  
          WANT_GZIP
          WANT_GZIP_OR_ZLIB
  );
  
  push @EXPORT, qw(crc32 adler32 DEF_WBITS);
  
  use constant WANT_GZIP           => 16;
  use constant WANT_GZIP_OR_ZLIB   => 32;
  
  sub AUTOLOAD {
      my($constname);
      ($constname = $AUTOLOAD) =~ s/.*:://;
      my ($error, $val) = constant($constname);
      Carp::croak $error if $error;
      no strict 'refs';
      *{$AUTOLOAD} = sub { $val };
      goto &{$AUTOLOAD};
  }
  
  use constant FLAG_APPEND             => 1 ;
  use constant FLAG_CRC                => 2 ;
  use constant FLAG_ADLER              => 4 ;
  use constant FLAG_CONSUME_INPUT      => 8 ;
  use constant FLAG_LIMIT_OUTPUT       => 16 ;
  
  eval {
      require XSLoader;
      XSLoader::load('Compress::Raw::Zlib', $XS_VERSION);
      1;
  } 
  or do {
      require DynaLoader;
      local @ISA = qw(DynaLoader);
      bootstrap Compress::Raw::Zlib $XS_VERSION ; 
  };
   
  
  use constant Parse_any      => 0x01;
  use constant Parse_unsigned => 0x02;
  use constant Parse_signed   => 0x04;
  use constant Parse_boolean  => 0x08;
  
  
  use constant OFF_PARSED     => 0 ;
  use constant OFF_TYPE       => 1 ;
  use constant OFF_DEFAULT    => 2 ;
  use constant OFF_FIXED      => 3 ;
  use constant OFF_FIRST_ONLY => 4 ;
  use constant OFF_STICKY     => 5 ;
  
  
  
  sub ParseParameters
  {
      my $level = shift || 0 ; 
  
      my $sub = (caller($level + 1))[3] ;
      my $p = new Compress::Raw::Zlib::Parameters() ;
      $p->parse(@_)
          or croak "$sub: $p->{Error}" ;
  
      return $p;
  }
  
  
  sub Compress::Raw::Zlib::Parameters::new
  {
      my $class = shift ;
  
      my $obj = { Error => '',
                  Got   => {},
                } ;
  
      return bless $obj, 'Compress::Raw::Zlib::Parameters' ;
  }
  
  sub Compress::Raw::Zlib::Parameters::setError
  {
      my $self = shift ;
      my $error = shift ;
      my $retval = @_ ? shift : undef ;
  
      $self->{Error} = $error ;
      return $retval;
  }
            
            
  sub Compress::Raw::Zlib::Parameters::parse
  {
      my $self = shift ;
  
      my $default = shift ;
  
      my $got = $self->{Got} ;
      my $firstTime = keys %{ $got } == 0 ;
  
      my (@Bad) ;
      my @entered = () ;
  
      if (@_ == 0) {
          @entered = () ;
      }
      elsif (@_ == 1) {
          my $href = $_[0] ;    
          return $self->setError("Expected even number of parameters, got 1")
              if ! defined $href or ! ref $href or ref $href ne "HASH" ;
   
          foreach my $key (keys %$href) {
              push @entered, $key ;
              push @entered, \$href->{$key} ;
          }
      }
      else {
          my $count = @_;
          return $self->setError("Expected even number of parameters, got $count")
              if $count % 2 != 0 ;
          
          for my $i (0.. $count / 2 - 1) {
              push @entered, $_[2* $i] ;
              push @entered, \$_[2* $i+1] ;
          }
      }
  
  
      while (my ($key, $v) = each %$default)
      {
          croak "need 4 params [@$v]"
              if @$v != 4 ;
  
          my ($first_only, $sticky, $type, $value) = @$v ;
          my $x ;
          $self->_checkType($key, \$value, $type, 0, \$x) 
              or return undef ;
  
          $key = lc $key;
  
          if ($firstTime || ! $sticky) {
              $got->{$key} = [0, $type, $value, $x, $first_only, $sticky] ;
          }
  
          $got->{$key}[OFF_PARSED] = 0 ;
      }
  
      for my $i (0.. @entered / 2 - 1) {
          my $key = $entered[2* $i] ;
          my $value = $entered[2* $i+1] ;
  
  
          $key =~ s/^-// ;
          my $canonkey = lc $key;
   
          if ($got->{$canonkey} && ($firstTime ||
                                    ! $got->{$canonkey}[OFF_FIRST_ONLY]  ))
          {
              my $type = $got->{$canonkey}[OFF_TYPE] ;
              my $s ;
              $self->_checkType($key, $value, $type, 1, \$s)
                  or return undef ;
              $value = $$value ;
              $got->{$canonkey} = [1, $type, $value, $s] ;
          }
          else
            { push (@Bad, $key) }
      }
   
      if (@Bad) {
          my ($bad) = join(", ", @Bad) ;
          return $self->setError("unknown key value(s) @Bad") ;
      }
  
      return 1;
  }
  
  sub Compress::Raw::Zlib::Parameters::_checkType
  {
      my $self = shift ;
  
      my $key   = shift ;
      my $value = shift ;
      my $type  = shift ;
      my $validate  = shift ;
      my $output  = shift;
  
  
      $value = $$value ;
  
      if ($type & Parse_any)
      {
          $$output = $value ;
          return 1;
      }
      elsif ($type & Parse_unsigned)
      {
          return $self->setError("Parameter '$key' must be an unsigned int, got 'undef'")
              if $validate && ! defined $value ;
          return $self->setError("Parameter '$key' must be an unsigned int, got '$value'")
              if $validate && $value !~ /^\d+$/;
  
          $$output = defined $value ? $value : 0 ;    
          return 1;
      }
      elsif ($type & Parse_signed)
      {
          return $self->setError("Parameter '$key' must be a signed int, got 'undef'")
              if $validate && ! defined $value ;
          return $self->setError("Parameter '$key' must be a signed int, got '$value'")
              if $validate && $value !~ /^-?\d+$/;
  
          $$output = defined $value ? $value : 0 ;    
          return 1 ;
      }
      elsif ($type & Parse_boolean)
      {
          return $self->setError("Parameter '$key' must be an int, got '$value'")
              if $validate && defined $value && $value !~ /^\d*$/;
          $$output =  defined $value ? $value != 0 : 0 ;    
          return 1;
      }
  
      $$output = $value ;
      return 1;
  }
  
  
  
  sub Compress::Raw::Zlib::Parameters::parsed
  {
      my $self = shift ;
      my $name = shift ;
  
      return $self->{Got}{lc $name}[OFF_PARSED] ;
  }
  
  sub Compress::Raw::Zlib::Parameters::value
  {
      my $self = shift ;
      my $name = shift ;
  
      if (@_)
      {
          $self->{Got}{lc $name}[OFF_PARSED]  = 1;
          $self->{Got}{lc $name}[OFF_DEFAULT] = $_[0] ;
          $self->{Got}{lc $name}[OFF_FIXED]   = $_[0] ;
      }
  
      return $self->{Got}{lc $name}[OFF_FIXED] ;
  }
  
  our $OPTIONS_deflate =   
      {
          'AppendOutput'  => [1, 1, Parse_boolean,  0],
          'CRC32'         => [1, 1, Parse_boolean,  0],
          'ADLER32'       => [1, 1, Parse_boolean,  0],
          'Bufsize'       => [1, 1, Parse_unsigned, 4096],
  
          'Level'         => [1, 1, Parse_signed,   Z_DEFAULT_COMPRESSION()],
          'Method'        => [1, 1, Parse_unsigned, Z_DEFLATED()],
          'WindowBits'    => [1, 1, Parse_signed,   MAX_WBITS()],
          'MemLevel'      => [1, 1, Parse_unsigned, MAX_MEM_LEVEL()],
          'Strategy'      => [1, 1, Parse_unsigned, Z_DEFAULT_STRATEGY()],
          'Dictionary'    => [1, 1, Parse_any,      ""],
      };
  
  sub Compress::Raw::Zlib::Deflate::new
  {
      my $pkg = shift ;
      my ($got) = ParseParameters(0, $OPTIONS_deflate, @_);
  
      croak "Compress::Raw::Zlib::Deflate::new: Bufsize must be >= 1, you specified " . 
              $got->value('Bufsize')
          unless $got->value('Bufsize') >= 1;
  
      my $flags = 0 ;
      $flags |= FLAG_APPEND if $got->value('AppendOutput') ;
      $flags |= FLAG_CRC    if $got->value('CRC32') ;
      $flags |= FLAG_ADLER  if $got->value('ADLER32') ;
  
      my $windowBits =  $got->value('WindowBits');
      $windowBits += MAX_WBITS()
          if ($windowBits & MAX_WBITS()) == 0 ;
  
      _deflateInit($flags,
                  $got->value('Level'), 
                  $got->value('Method'), 
                  $windowBits, 
                  $got->value('MemLevel'), 
                  $got->value('Strategy'), 
                  $got->value('Bufsize'),
                  $got->value('Dictionary')) ;
  
  }
  
  sub Compress::Raw::Zlib::deflateStream::STORABLE_freeze
  {
      my $type = ref shift;
      croak "Cannot freeze $type object\n";
  }
  
  sub Compress::Raw::Zlib::deflateStream::STORABLE_thaw
  {
      my $type = ref shift;
      croak "Cannot thaw $type object\n";
  }
  
  
  our $OPTIONS_inflate = 
      {
          'AppendOutput'  => [1, 1, Parse_boolean,  0],
          'LimitOutput'   => [1, 1, Parse_boolean,  0],
          'CRC32'         => [1, 1, Parse_boolean,  0],
          'ADLER32'       => [1, 1, Parse_boolean,  0],
          'ConsumeInput'  => [1, 1, Parse_boolean,  1],
          'Bufsize'       => [1, 1, Parse_unsigned, 4096],
   
          'WindowBits'    => [1, 1, Parse_signed,   MAX_WBITS()],
          'Dictionary'    => [1, 1, Parse_any,      ""],
      } ;
  
  sub Compress::Raw::Zlib::Inflate::new
  {
      my $pkg = shift ;
      my ($got) = ParseParameters(0, $OPTIONS_inflate, @_);
  
      croak "Compress::Raw::Zlib::Inflate::new: Bufsize must be >= 1, you specified " . 
              $got->value('Bufsize')
          unless $got->value('Bufsize') >= 1;
  
      my $flags = 0 ;
      $flags |= FLAG_APPEND if $got->value('AppendOutput') ;
      $flags |= FLAG_CRC    if $got->value('CRC32') ;
      $flags |= FLAG_ADLER  if $got->value('ADLER32') ;
      $flags |= FLAG_CONSUME_INPUT if $got->value('ConsumeInput') ;
      $flags |= FLAG_LIMIT_OUTPUT if $got->value('LimitOutput') ;
  
  
      my $windowBits =  $got->value('WindowBits');
      $windowBits += MAX_WBITS()
          if ($windowBits & MAX_WBITS()) == 0 ;
  
      _inflateInit($flags, $windowBits, $got->value('Bufsize'), 
                   $got->value('Dictionary')) ;
  }
  
  sub Compress::Raw::Zlib::inflateStream::STORABLE_freeze
  {
      my $type = ref shift;
      croak "Cannot freeze $type object\n";
  }
  
  sub Compress::Raw::Zlib::inflateStream::STORABLE_thaw
  {
      my $type = ref shift;
      croak "Cannot thaw $type object\n";
  }
  
  sub Compress::Raw::Zlib::InflateScan::new
  {
      my $pkg = shift ;
      my ($got) = ParseParameters(0,
                      {
                          'CRC32'         => [1, 1, Parse_boolean,  0],
                          'ADLER32'       => [1, 1, Parse_boolean,  0],
                          'Bufsize'       => [1, 1, Parse_unsigned, 4096],
                   
                          'WindowBits'    => [1, 1, Parse_signed,   -MAX_WBITS()],
                          'Dictionary'    => [1, 1, Parse_any,      ""],
              }, @_) ;
  
  
      croak "Compress::Raw::Zlib::InflateScan::new: Bufsize must be >= 1, you specified " . 
              $got->value('Bufsize')
          unless $got->value('Bufsize') >= 1;
  
      my $flags = 0 ;
      $flags |= FLAG_CRC    if $got->value('CRC32') ;
      $flags |= FLAG_ADLER  if $got->value('ADLER32') ;
  
      _inflateScanInit($flags, $got->value('WindowBits'), $got->value('Bufsize'), 
                   '') ;
  }
  
  sub Compress::Raw::Zlib::inflateScanStream::createDeflateStream
  {
      my $pkg = shift ;
      my ($got) = ParseParameters(0,
              {
                  'AppendOutput'  => [1, 1, Parse_boolean,  0],
                  'CRC32'         => [1, 1, Parse_boolean,  0],
                  'ADLER32'       => [1, 1, Parse_boolean,  0],
                  'Bufsize'       => [1, 1, Parse_unsigned, 4096],
   
                  'Level'         => [1, 1, Parse_signed,   Z_DEFAULT_COMPRESSION()],
                  'Method'        => [1, 1, Parse_unsigned, Z_DEFLATED()],
                  'WindowBits'    => [1, 1, Parse_signed,   - MAX_WBITS()],
                  'MemLevel'      => [1, 1, Parse_unsigned, MAX_MEM_LEVEL()],
                  'Strategy'      => [1, 1, Parse_unsigned, Z_DEFAULT_STRATEGY()],
              }, @_) ;
  
      croak "Compress::Raw::Zlib::InflateScan::createDeflateStream: Bufsize must be >= 1, you specified " . 
              $got->value('Bufsize')
          unless $got->value('Bufsize') >= 1;
  
      my $flags = 0 ;
      $flags |= FLAG_APPEND if $got->value('AppendOutput') ;
      $flags |= FLAG_CRC    if $got->value('CRC32') ;
      $flags |= FLAG_ADLER  if $got->value('ADLER32') ;
  
      $pkg->_createDeflateStream($flags,
                  $got->value('Level'), 
                  $got->value('Method'), 
                  $got->value('WindowBits'), 
                  $got->value('MemLevel'), 
                  $got->value('Strategy'), 
                  $got->value('Bufsize'),
                  ) ;
  
  }
  
  sub Compress::Raw::Zlib::inflateScanStream::inflate
  {
      my $self = shift ;
      my $buffer = $_[1];
      my $eof = $_[2];
  
      my $status = $self->scan(@_);
  
      if ($status == Z_OK() && $_[2]) {
          my $byte = ' ';
          
          $status = $self->scan(\$byte, $_[1]) ;
      }
      
      return $status ;
  }
  
  sub Compress::Raw::Zlib::deflateStream::deflateParams
  {
      my $self = shift ;
      my ($got) = ParseParameters(0, {
                  'Level'      => [1, 1, Parse_signed,   undef],
                  'Strategy'   => [1, 1, Parse_unsigned, undef],
                  'Bufsize'    => [1, 1, Parse_unsigned, undef],
                  }, 
                  @_) ;
  
      croak "Compress::Raw::Zlib::deflateParams needs Level and/or Strategy"
          unless $got->parsed('Level') + $got->parsed('Strategy') +
              $got->parsed('Bufsize');
  
      croak "Compress::Raw::Zlib::Inflate::deflateParams: Bufsize must be >= 1, you specified " . 
              $got->value('Bufsize')
          if $got->parsed('Bufsize') && $got->value('Bufsize') <= 1;
  
      my $flags = 0;
      $flags |= 1 if $got->parsed('Level') ;
      $flags |= 2 if $got->parsed('Strategy') ;
      $flags |= 4 if $got->parsed('Bufsize') ;
  
      $self->_deflateParams($flags, $got->value('Level'), 
                            $got->value('Strategy'), $got->value('Bufsize'));
  
  }
  
  
  1;
  __END__
  
  
COMPRESS_RAW_ZLIB

$fatpacked{"Compress/Zlib.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'COMPRESS_ZLIB';
  
  package Compress::Zlib;
  
  require 5.006 ;
  require Exporter;
  use Carp ;
  use IO::Handle ;
  use Scalar::Util qw(dualvar);
  
  use IO::Compress::Base::Common 2.068 ;
  use Compress::Raw::Zlib 2.068 ;
  use IO::Compress::Gzip 2.068 ;
  use IO::Uncompress::Gunzip 2.068 ;
  
  use strict ;
  use warnings ;
  use bytes ;
  our ($VERSION, $XS_VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS);
  
  $VERSION = '2.068';
  $XS_VERSION = $VERSION; 
  $VERSION = eval $VERSION;
  
  @ISA = qw(Exporter);
  @EXPORT = qw(
          deflateInit inflateInit
  
          compress uncompress
  
          gzopen $gzerrno
      );
  
  push @EXPORT, @Compress::Raw::Zlib::EXPORT ;
  
  @EXPORT_OK = qw(memGunzip memGzip zlib_version);
  %EXPORT_TAGS = (
      ALL         => \@EXPORT
  );
  
  BEGIN
  {
      *zlib_version = \&Compress::Raw::Zlib::zlib_version;
  }
  
  use constant FLAG_APPEND             => 1 ;
  use constant FLAG_CRC                => 2 ;
  use constant FLAG_ADLER              => 4 ;
  use constant FLAG_CONSUME_INPUT      => 8 ;
  
  our (@my_z_errmsg);
  
  @my_z_errmsg = (
      "need dictionary",     
      "stream end",          
      "",                    
      "file error",          
      "stream error",        
      "data error",          
      "insufficient memory", 
      "buffer error",        
      "incompatible version",
      );
  
  
  sub _set_gzerr
  {
      my $value = shift ;
  
      if ($value == 0) {
          $Compress::Zlib::gzerrno = 0 ;
      }
      elsif ($value == Z_ERRNO() || $value > 2) {
          $Compress::Zlib::gzerrno = $! ;
      }
      else {
          $Compress::Zlib::gzerrno = dualvar($value+0, $my_z_errmsg[2 - $value]);
      }
  
      return $value ;
  }
  
  sub _set_gzerr_undef
  {
      _set_gzerr(@_);
      return undef;
  }
  
  sub _save_gzerr
  {
      my $gz = shift ;
      my $test_eof = shift ;
  
      my $value = $gz->errorNo() || 0 ;
      my $eof = $gz->eof() ;
  
      if ($test_eof) {
          $value = Z_STREAM_END() if $gz->eof() && $value == 0 ;
      }
  
      _set_gzerr($value) ;
  }
  
  sub gzopen($$)
  {
      my ($file, $mode) = @_ ;
  
      my $gz ;
      my %defOpts = (Level    => Z_DEFAULT_COMPRESSION(),
                     Strategy => Z_DEFAULT_STRATEGY(),
                    );
  
      my $writing ;
      $writing = ! ($mode =~ /r/i) ;
      $writing = ($mode =~ /[wa]/i) ;
  
      $defOpts{Level}    = $1               if $mode =~ /(\d)/;
      $defOpts{Strategy} = Z_FILTERED()     if $mode =~ /f/i;
      $defOpts{Strategy} = Z_HUFFMAN_ONLY() if $mode =~ /h/i;
      $defOpts{Append}   = 1                if $mode =~ /a/i;
  
      my $infDef = $writing ? 'deflate' : 'inflate';
      my @params = () ;
  
      croak "gzopen: file parameter is not a filehandle or filename"
          unless isaFilehandle $file || isaFilename $file  || 
                 (ref $file && ref $file eq 'SCALAR');
  
      return undef unless $mode =~ /[rwa]/i ;
  
      _set_gzerr(0) ;
  
      if ($writing) {
          $gz = new IO::Compress::Gzip($file, Minimal => 1, AutoClose => 1, 
                                       %defOpts) 
              or $Compress::Zlib::gzerrno = $IO::Compress::Gzip::GzipError;
      }
      else {
          $gz = new IO::Uncompress::Gunzip($file, 
                                           Transparent => 1,
                                           Append => 0, 
                                           AutoClose => 1, 
                                           MultiStream => 1,
                                           Strict => 0) 
              or $Compress::Zlib::gzerrno = $IO::Uncompress::Gunzip::GunzipError;
      }
  
      return undef
          if ! defined $gz ;
  
      bless [$gz, $infDef], 'Compress::Zlib::gzFile';
  }
  
  sub Compress::Zlib::gzFile::gzread
  {
      my $self = shift ;
  
      return _set_gzerr(Z_STREAM_ERROR())
          if $self->[1] ne 'inflate';
  
      my $len = defined $_[1] ? $_[1] : 4096 ; 
  
      my $gz = $self->[0] ;
      if ($self->gzeof() || $len == 0) {
          $_[0] = "" ;
          _save_gzerr($gz, 1);
          return 0 ;
      }
  
      my $status = $gz->read($_[0], $len) ; 
      _save_gzerr($gz, 1);
      return $status ;
  }
  
  sub Compress::Zlib::gzFile::gzreadline
  {
      my $self = shift ;
  
      my $gz = $self->[0] ;
      {
          local $/ = "\n" ;
          $_[0] = $gz->getline() ; 
      }
      _save_gzerr($gz, 1);
      return defined $_[0] ? length $_[0] : 0 ;
  }
  
  sub Compress::Zlib::gzFile::gzwrite
  {
      my $self = shift ;
      my $gz = $self->[0] ;
  
      return _set_gzerr(Z_STREAM_ERROR())
          if $self->[1] ne 'deflate';
  
      $] >= 5.008 and (utf8::downgrade($_[0], 1) 
          or croak "Wide character in gzwrite");
  
      my $status = $gz->write($_[0]) ;
      _save_gzerr($gz);
      return $status ;
  }
  
  sub Compress::Zlib::gzFile::gztell
  {
      my $self = shift ;
      my $gz = $self->[0] ;
      my $status = $gz->tell() ;
      _save_gzerr($gz);
      return $status ;
  }
  
  sub Compress::Zlib::gzFile::gzseek
  {
      my $self   = shift ;
      my $offset = shift ;
      my $whence = shift ;
  
      my $gz = $self->[0] ;
      my $status ;
      eval { $status = $gz->seek($offset, $whence) ; };
      if ($@)
      {
          my $error = $@;
          $error =~ s/^.*: /gzseek: /;
          $error =~ s/ at .* line \d+\s*$//;
          croak $error;
      }
      _save_gzerr($gz);
      return $status ;
  }
  
  sub Compress::Zlib::gzFile::gzflush
  {
      my $self = shift ;
      my $f    = shift ;
  
      my $gz = $self->[0] ;
      my $status = $gz->flush($f) ;
      my $err = _save_gzerr($gz);
      return $status ? 0 : $err;
  }
  
  sub Compress::Zlib::gzFile::gzclose
  {
      my $self = shift ;
      my $gz = $self->[0] ;
  
      my $status = $gz->close() ;
      my $err = _save_gzerr($gz);
      return $status ? 0 : $err;
  }
  
  sub Compress::Zlib::gzFile::gzeof
  {
      my $self = shift ;
      my $gz = $self->[0] ;
  
      return 0
          if $self->[1] ne 'inflate';
  
      my $status = $gz->eof() ;
      _save_gzerr($gz);
      return $status ;
  }
  
  sub Compress::Zlib::gzFile::gzsetparams
  {
      my $self = shift ;
      croak "Usage: Compress::Zlib::gzFile::gzsetparams(file, level, strategy)"
          unless @_ eq 2 ;
  
      my $gz = $self->[0] ;
      my $level = shift ;
      my $strategy = shift;
  
      return _set_gzerr(Z_STREAM_ERROR())
          if $self->[1] ne 'deflate';
   
      my $status = *$gz->{Compress}->deflateParams(-Level   => $level, 
                                                  -Strategy => $strategy);
      _save_gzerr($gz);
      return $status ;
  }
  
  sub Compress::Zlib::gzFile::gzerror
  {
      my $self = shift ;
      my $gz = $self->[0] ;
      
      return $Compress::Zlib::gzerrno ;
  }
  
  
  sub compress($;$)
  {
      my ($x, $output, $err, $in) =('', '', '', '') ;
  
      if (ref $_[0] ) {
          $in = $_[0] ;
          croak "not a scalar reference" unless ref $in eq 'SCALAR' ;
      }
      else {
          $in = \$_[0] ;
      }
  
      $] >= 5.008 and (utf8::downgrade($$in, 1) 
          or croak "Wide character in compress");
  
      my $level = (@_ == 2 ? $_[1] : Z_DEFAULT_COMPRESSION() );
  
      $x = Compress::Raw::Zlib::_deflateInit(FLAG_APPEND,
                                             $level,
                                             Z_DEFLATED,
                                             MAX_WBITS,
                                             MAX_MEM_LEVEL,
                                             Z_DEFAULT_STRATEGY,
                                             4096,
                                             '') 
              or return undef ;
  
      $err = $x->deflate($in, $output) ;
      return undef unless $err == Z_OK() ;
  
      $err = $x->flush($output) ;
      return undef unless $err == Z_OK() ;
      
      return $output ;
  }
  
  sub uncompress($)
  {
      my ($output, $in) =('', '') ;
  
      if (ref $_[0] ) {
          $in = $_[0] ;
          croak "not a scalar reference" unless ref $in eq 'SCALAR' ;
      }
      else {
          $in = \$_[0] ;
      }
  
      $] >= 5.008 and (utf8::downgrade($$in, 1) 
          or croak "Wide character in uncompress");    
          
      my ($obj, $status) = Compress::Raw::Zlib::_inflateInit(0,
                                  MAX_WBITS, 4096, "") ;   
                                  
      $status == Z_OK 
          or return undef;
      
      $obj->inflate($in, $output) == Z_STREAM_END 
          or return undef;
      
      return $output;
  }
   
  sub deflateInit(@)
  {
      my ($got) = ParseParameters(0,
                  {
                  'bufsize'       => [IO::Compress::Base::Common::Parse_unsigned, 4096],
                  'level'         => [IO::Compress::Base::Common::Parse_signed,   Z_DEFAULT_COMPRESSION()],
                  'method'        => [IO::Compress::Base::Common::Parse_unsigned, Z_DEFLATED()],
                  'windowbits'    => [IO::Compress::Base::Common::Parse_signed,   MAX_WBITS()],
                  'memlevel'      => [IO::Compress::Base::Common::Parse_unsigned, MAX_MEM_LEVEL()],
                  'strategy'      => [IO::Compress::Base::Common::Parse_unsigned, Z_DEFAULT_STRATEGY()],
                  'dictionary'    => [IO::Compress::Base::Common::Parse_any,      ""],
                  }, @_ ) ;
  
      croak "Compress::Zlib::deflateInit: Bufsize must be >= 1, you specified " . 
              $got->getValue('bufsize')
          unless $got->getValue('bufsize') >= 1;
  
      my $obj ;
   
      my $status = 0 ;
      ($obj, $status) = 
        Compress::Raw::Zlib::_deflateInit(0,
                  $got->getValue('level'), 
                  $got->getValue('method'), 
                  $got->getValue('windowbits'), 
                  $got->getValue('memlevel'), 
                  $got->getValue('strategy'), 
                  $got->getValue('bufsize'),
                  $got->getValue('dictionary')) ;
  
      my $x = ($status == Z_OK() ? bless $obj, "Zlib::OldDeflate"  : undef) ;
      return wantarray ? ($x, $status) : $x ;
  }
   
  sub inflateInit(@)
  {
      my ($got) = ParseParameters(0,
                  {
                  'bufsize'       => [IO::Compress::Base::Common::Parse_unsigned, 4096],
                  'windowbits'    => [IO::Compress::Base::Common::Parse_signed,   MAX_WBITS()],
                  'dictionary'    => [IO::Compress::Base::Common::Parse_any,      ""],
                  }, @_) ;
  
  
      croak "Compress::Zlib::inflateInit: Bufsize must be >= 1, you specified " . 
              $got->getValue('bufsize')
          unless $got->getValue('bufsize') >= 1;
  
      my $status = 0 ;
      my $obj ;
      ($obj, $status) = Compress::Raw::Zlib::_inflateInit(FLAG_CONSUME_INPUT,
                                  $got->getValue('windowbits'), 
                                  $got->getValue('bufsize'), 
                                  $got->getValue('dictionary')) ;
  
      my $x = ($status == Z_OK() ? bless $obj, "Zlib::OldInflate"  : undef) ;
  
      wantarray ? ($x, $status) : $x ;
  }
  
  package Zlib::OldDeflate ;
  
  our (@ISA);
  @ISA = qw(Compress::Raw::Zlib::deflateStream);
  
  
  sub deflate
  {
      my $self = shift ;
      my $output ;
  
      my $status = $self->SUPER::deflate($_[0], $output) ;
      wantarray ? ($output, $status) : $output ;
  }
  
  sub flush
  {
      my $self = shift ;
      my $output ;
      my $flag = shift || Compress::Zlib::Z_FINISH();
      my $status = $self->SUPER::flush($output, $flag) ;
      
      wantarray ? ($output, $status) : $output ;
  }
  
  package Zlib::OldInflate ;
  
  our (@ISA);
  @ISA = qw(Compress::Raw::Zlib::inflateStream);
  
  sub inflate
  {
      my $self = shift ;
      my $output ;
      my $status = $self->SUPER::inflate($_[0], $output) ;
      wantarray ? ($output, $status) : $output ;
  }
  
  package Compress::Zlib ;
  
  use IO::Compress::Gzip::Constants 2.068 ;
  
  sub memGzip($)
  {
      _set_gzerr(0);
      my $x = Compress::Raw::Zlib::_deflateInit(FLAG_APPEND|FLAG_CRC,
                                             Z_BEST_COMPRESSION,
                                             Z_DEFLATED,
                                             -MAX_WBITS(),
                                             MAX_MEM_LEVEL,
                                             Z_DEFAULT_STRATEGY,
                                             4096,
                                             '') 
              or return undef ;
   
      my $string = (ref $_[0] ? $_[0] : \$_[0]) ;
  
      $] >= 5.008 and (utf8::downgrade($$string, 1) 
          or croak "Wide character in memGzip");
  
      my $out;
      my $status ;
  
      $x->deflate($string, $out) == Z_OK
          or return undef ;
   
      $x->flush($out) == Z_OK
          or return undef ;
   
      return IO::Compress::Gzip::Constants::GZIP_MINIMUM_HEADER . 
             $out . 
             pack("V V", $x->crc32(), $x->total_in());
  }
  
  
  sub _removeGzipHeader($)
  {
      my $string = shift ;
  
      return Z_DATA_ERROR() 
          if length($$string) < GZIP_MIN_HEADER_SIZE ;
  
      my ($magic1, $magic2, $method, $flags, $time, $xflags, $oscode) = 
          unpack ('CCCCVCC', $$string);
  
      return Z_DATA_ERROR()
          unless $magic1 == GZIP_ID1 and $magic2 == GZIP_ID2 and
             $method == Z_DEFLATED() and !($flags & GZIP_FLG_RESERVED) ;
      substr($$string, 0, GZIP_MIN_HEADER_SIZE) = '' ;
  
      if ($flags & GZIP_FLG_FEXTRA)
      {
          return Z_DATA_ERROR()
              if length($$string) < GZIP_FEXTRA_HEADER_SIZE ;
  
          my ($extra_len) = unpack ('v', $$string);
          $extra_len += GZIP_FEXTRA_HEADER_SIZE;
          return Z_DATA_ERROR()
              if length($$string) < $extra_len ;
  
          substr($$string, 0, $extra_len) = '';
      }
  
      if ($flags & GZIP_FLG_FNAME)
      {
          my $name_end = index ($$string, GZIP_NULL_BYTE);
          return Z_DATA_ERROR()
             if $name_end == -1 ;
          substr($$string, 0, $name_end + 1) =  '';
      }
  
      if ($flags & GZIP_FLG_FCOMMENT)
      {
          my $comment_end = index ($$string, GZIP_NULL_BYTE);
          return Z_DATA_ERROR()
              if $comment_end == -1 ;
          substr($$string, 0, $comment_end + 1) = '';
      }
  
      if ($flags & GZIP_FLG_FHCRC)
      {
          return Z_DATA_ERROR()
              if length ($$string) < GZIP_FHCRC_SIZE ;
          substr($$string, 0, GZIP_FHCRC_SIZE) = '';
      }
      
      return Z_OK();
  }
  
  sub _ret_gun_error
  {
      $Compress::Zlib::gzerrno = $IO::Uncompress::Gunzip::GunzipError;
      return undef;
  }
  
  
  sub memGunzip($)
  {
      my $string = (ref $_[0] ? $_[0] : \$_[0]);
   
      $] >= 5.008 and (utf8::downgrade($$string, 1) 
          or croak "Wide character in memGunzip");
  
      _set_gzerr(0);
  
      my $status = _removeGzipHeader($string) ;
      $status == Z_OK() 
          or return _set_gzerr_undef($status);
       
      my $bufsize = length $$string > 4096 ? length $$string : 4096 ;
      my $x = Compress::Raw::Zlib::_inflateInit(FLAG_CRC | FLAG_CONSUME_INPUT,
                                  -MAX_WBITS(), $bufsize, '') 
                or return _ret_gun_error();
  
      my $output = '' ;
      $status = $x->inflate($string, $output);
      
      if ( $status == Z_OK() )
      {
          _set_gzerr(Z_DATA_ERROR());
          return undef;
      }
  
      return _ret_gun_error()
          if ($status != Z_STREAM_END());
  
      if (length $$string >= 8)
      {
          my ($crc, $len) = unpack ("VV", substr($$string, 0, 8));
          substr($$string, 0, 8) = '';
          return _set_gzerr_undef(Z_DATA_ERROR())
              unless $len == length($output) and
                     $crc == Compress::Raw::Zlib::crc32($output);
      }
      else
      {
          $$string = '';
      }
  
      return $output;   
  }
  
  
  1;
  __END__
  
  
COMPRESS_ZLIB

$fatpacked{"Config/IOD/Base.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'CONFIG_IOD_BASE';
  package Config::IOD::Base;
  
  our $DATE = '2015-06-07'; 
  our $VERSION = '0.17'; 
  
  use 5.010001;
  use strict;
  use warnings;
  
  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 {
      no warnings; 
  
      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) = @_;
      die 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 ($vol, $dir, $file) =
              File::Spec->splitpath($self->{_include_stack}[-1]);
          $path = File::Spec->rel2abs($path, File::Spec->catpath($vol, $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;
  
      die "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 die "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);
      die "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/Expr.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'CONFIG_IOD_EXPR';
  package Config::IOD::Expr;
  
  our $DATE = '2015-06-07'; 
  our $VERSION = '0.17'; 
  
  use 5.010;
  use strict;
  use warnings;
  
  my $EXPR_RE = qr{
  
  (?&ANSWER)
  
  (?(DEFINE)
  
  (?<ANSWER>    (?&ADD))
  (?<ADD>       (?&MULT)   | (?&MULT)  (?: \s* ([+.-]) \s* (?&MULT)  )+)
  (?<MULT>      (?&UNARY)  | (?&UNARY) (?: \s* ([*/x%]) \s* (?&UNARY))+)
  (?<UNARY>     (?&POWER)  | [!~+-] (?&POWER))
  (?<POWER>     (?&TERM)   | (?&TERM) (?: \s* \*\* \s* (?&TERM))+)
  
  (?<TERM>
      (?&NUM)
    | (?&STR_SINGLE)
    | (?&STR_DOUBLE)
    | undef
    | (?&FUNC)
    | \( \s* ((?&ANSWER)) \s* \)
  )
  
  (?<FUNC> val \s* \( (?&TERM) \))
  
  (?<NUM>
      (
       -?
       (?: 0 | [1-9]\d* )
       (?: \. \d+ )?
       (?: [eE] [-+]? \d+ )?
      )
  )
  
  (?<STR_SINGLE>
      (
       '
       (?:
           [^\\']+
         |
           \\ ['\\]
         |
           \\
       )*
       '
      )
  )
  
  (?<STR_DOUBLE>
      (
       "
       (?:
           [^\\"]+
         |
           \\ ["'\\\$tnrfbae]
  # octal, hex, wide hex
       )*
       "
      )
  )
  
  ) # DEFINE
  
  }msx;
  
  sub _parse_expr {
      my $str = shift;
  
      return [400, 'Not a valid expr'] unless $str =~ m{\A$EXPR_RE\z}o;
      my $res = eval $str;
      return [500, "Died when evaluating expr: $@"] if $@;
      [200, "OK", $res];
  }
  
  1;
  
  __END__
  
CONFIG_IOD_EXPR

$fatpacked{"Config/IOD/Reader.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'CONFIG_IOD_READER';
  package Config::IOD::Reader;
  
  our $DATE = '2015-06-07'; 
  our $VERSION = '0.17'; 
  
  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/Clean/Base.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'DATA_CLEAN_BASE';
  package Data::Clean::Base;
  
  our $DATE = '2015-06-10'; 
  our $VERSION = '0.28'; 
  
  use 5.010;
  use strict;
  use warnings;
  use Log::Any::IfLOG '$log';
  
  use Function::Fallback::CoreOrPP qw(clone);
  use Scalar::Util qw();
  
  sub new {
      my ($class, %opts) = @_;
      my $self = bless {opts=>\%opts}, $class;
      $log->tracef("Cleanser options: %s", \%opts);
      $self->_generate_cleanser_code;
      $self;
  }
  
  sub command_call_method {
      my ($self, $args) = @_;
      my $mn = $args->[0];
      die "Invalid method name syntax" unless $mn =~ /\A\w+\z/;
      return "{{var}} = {{var}}->$mn; \$ref = ref({{var}})";
  }
  
  sub command_call_func {
      my ($self, $args) = @_;
      my $fn = $args->[0];
      die "Invalid func name syntax" unless $fn =~ /\A\w+(::\w+)*\z/;
      return "{{var}} = $fn({{var}}); \$ref = ref({{var}})";
  }
  
  sub command_one_or_zero {
      my ($self, $args) = @_;
      return "{{var}} = {{var}} ? 1:0; \$ref = ''";
  }
  
  sub command_deref_scalar {
      my ($self, $args) = @_;
      return '{{var}} = ${ {{var}} }; $ref = ref({{var}})';
  }
  
  sub command_stringify {
      my ($self, $args) = @_;
      return '{{var}} = "{{var}}"';
  }
  
  sub command_replace_with_ref {
      my ($self, $args) = @_;
      return '{{var}} = $ref; $ref = ""';
  }
  
  sub command_replace_with_str {
      require String::PerlQuote;
  
      my ($self, $args) = @_;
      return "{{var}} = ".String::PerlQuote::double_quote($args->[0]).'; $ref=""';
  }
  
  sub command_unbless {
      my ($self, $args) = @_;
  
  
      my $acme_damn_available = eval { require Acme::Damn; 1 } ? 1:0;
      return join(
          "",
          "if (!\$Data::Clean::Base::_clone && $acme_damn_available) { ",
          "{{var}} = Acme::Damn::damn({{var}}) ",
          "} else { ",
          "{{var}} = Function::Fallback::CoreOrPP::_unbless_fallback({{var}}) } ",
          "\$ref = ref({{var}})",
      );
  }
  
  sub command_clone {
      my $clone_func;
      eval { require Data::Clone };
      if ($@) {
          require Clone::PP;
          $clone_func = "Clone::PP::clone";
      } else {
          $clone_func = "Data::Clone::clone";
      }
  
      my ($self, $args) = @_;
      my $limit = $args->[0] // 1;
      return join(
          "",
          "if (++\$ctr_circ <= $limit) { ",
          "{{var}} = $clone_func({{var}}); redo ",
          "} else { ",
          "{{var}} = 'CIRCULAR' } ",
          "\$ref = ref({{var}})",
      );
  }
  
  sub command_die {
      my ($self, $args) = @_;
      return "die";
  }
  
  sub _generate_cleanser_code {
      my $self = shift;
      my $opts = $self->{opts};
  
      my (@code, @stmts_ary, @stmts_hash, @stmts_main);
  
      my $n = 0;
      my $add_stmt = sub {
          my $which = shift;
          if ($which eq 'if' || $which eq 'new_if') {
              my ($cond0, $act0) = @_;
              for ([\@stmts_ary, '$e', 'ary'],
                   [\@stmts_hash, '$h->{$k}', 'hash'],
                   [\@stmts_main, '$_', 'main']) {
                  my $act  = $act0 ; $act  =~ s/\Q{{var}}\E/$_->[1]/g;
                  my $cond = $cond0; $cond =~ s/\Q{{var}}\E/$_->[1]/g;
                  push @{ $_->[0] }, "    ".($n && $which ne 'new_if' ? "els":"")."if ($cond) { $act }\n";
              }
              $n++;
          } else {
              my ($stmt0) = @_;
              for ([\@stmts_ary, '$e', 'ary'],
                   [\@stmts_hash, '$h->{$k}', 'hash'],
                   [\@stmts_main, '$_', 'main']) {
                  my $stmt = $stmt0; $stmt =~ s/\Q{{var}}\E/$_->[1]/g;
                  push @{ $_->[0] }, "    $stmt;\n";
              }
          }
      };
      my $add_if = sub {
          $add_stmt->('if', @_);
      };
      my $add_new_if = sub {
          $add_stmt->('new_if', @_);
      };
      my $add_if_ref = sub {
          my ($ref, $act0) = @_;
          $add_if->("\$ref eq '$ref'", $act0);
      };
      my $add_new_if_ref = sub {
          my ($ref, $act0) = @_;
          $add_new_if->("\$ref eq '$ref'", $act0);
      };
  
      for my $on (grep {/\A\w*(::\w+)*\z/} sort keys %$opts) {
          my $o = $opts->{$on};
          next unless $o;
          my $meth = "command_$o->[0]";
          die "Can't handle command $o->[0] for option '$on'" unless $self->can($meth);
          my @args = @$o; shift @args;
          my $act = $self->$meth(\@args);
          $add_if_ref->($on, $act);
      }
  
      for my $p ([-obj => 'Scalar::Util::blessed({{var}})']) {
          my $o = $opts->{$p->[0]};
          next unless $o;
          my $meth = "command_$o->[0]";
          die "Can't handle command $o->[0] for option '$p->[0]'" unless $self->can($meth);
          my @args = @$o; shift @args;
          $add_if->($p->[1], $self->$meth(\@args));
      }
  
      my $circ = $opts->{-circular};
      if ($circ) {
          my $meth = "command_$circ->[0]";
          die "Can't handle command $circ->[0] for option '-circular'" unless $self->can($meth);
          my @args = @$circ; shift @args;
          my $act = $self->$meth(\@args);
          $add_new_if->('$ref && $refs{ {{var}} }++', $act);
      }
  
      $add_new_if_ref->("ARRAY", '$process_array->({{var}})');
      $add_if_ref->("HASH" , '$process_hash->({{var}})');
  
      for my $p ([-ref => '$ref']) {
          my $o = $opts->{$p->[0]};
          next unless $o;
          my $meth = "command_$o->[0]";
          die "Can't handle command $o->[0] for option '$p->[0]'" unless $self->can($meth);
          my @args = @$o; shift @args;
          $add_if->($p->[1], $self->$meth(\@args));
      }
  
      push @code, 'sub {'."\n";
      push @code, 'my $data = shift;'."\n";
      push @code, 'state %refs;'."\n" if $circ;
      push @code, 'state $ctr_circ;'."\n" if $circ;
      push @code, 'state $process_array;'."\n";
      push @code, 'state $process_hash;'."\n";
      push @code, 'if (!$process_array) { $process_array = sub { my $a = shift; for my $e (@$a) { my $ref=ref($e);'."\n".join("", @stmts_ary).'} } }'."\n";
      push @code, 'if (!$process_hash) { $process_hash = sub { my $h = shift; for my $k (keys %$h) { my $ref=ref($h->{$k});'."\n".join("", @stmts_hash).'} } }'."\n";
      push @code, '%refs = (); $ctr_circ=0;'."\n" if $circ;
      push @code, 'for ($data) { my $ref=ref($_);'."\n".join("", @stmts_main).'}'."\n";
      push @code, '$data'."\n";
      push @code, '}'."\n";
  
      my $code = join("", @code).";";
  
      if ($ENV{LOG_CLEANSER_CODE} && $log->is_trace) {
          require String::LineNumber;
          $log->tracef("Cleanser code:\n%s",
                       $ENV{LINENUM} // 1 ?
                           String::LineNumber::linenum($code) : $code);
      }
      eval "\$self->{code} = $code";
      die "Can't generate code: $@" if $@;
      $self->{src} = $code;
  }
  
  sub clean_in_place {
      my ($self, $data) = @_;
  
      $self->{code}->($data);
  }
  
  sub clone_and_clean {
      my ($self, $data) = @_;
      my $clone = clone($data);
      local $Data::Clean::Base::_clone = 1;
      $self->clean_in_place($clone);
  }
  
  1;
  
  __END__
  
DATA_CLEAN_BASE

$fatpacked{"Data/Clean/FromJSON.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'DATA_CLEAN_FROMJSON';
  package Data::Clean::FromJSON;
  
  our $DATE = '2015-06-10'; 
  our $VERSION = '0.28'; 
  
  use 5.010001;
  use strict;
  use warnings;
  
  use parent qw(Data::Clean::Base);
  
  sub new {
      my ($class, %opts) = @_;
      $opts{"JSON::XS::Boolean"} //= ['one_or_zero'];
      $opts{"JSON::PP::Boolean"} //= ['one_or_zero'];
      $class->SUPER::new(%opts);
  }
  
  sub get_cleanser {
      my $class = shift;
      state $singleton = $class->new;
      $singleton;
  }
  
  1;
  
  __END__
  
DATA_CLEAN_FROMJSON

$fatpacked{"Data/Clean/JSON.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'DATA_CLEAN_JSON';
  package Data::Clean::JSON;
  
  our $DATE = '2015-06-10'; 
  our $VERSION = '0.28'; 
  
  use 5.010001;
  use strict;
  use warnings;
  
  use parent qw(Data::Clean::Base);
  
  sub new {
      my ($class, %opts) = @_;
      $opts{DateTime}  //= [call_method => 'epoch'];
      $opts{'Time::Moment'} //= [call_method => 'epoch'];
      $opts{Regexp}    //= ['stringify'];
      $opts{SCALAR}    //= ['deref_scalar'];
      $opts{-ref}      //= ['replace_with_ref'];
      $opts{-circular} //= ['clone'];
      $opts{-obj}      //= ['unbless'];
      $class->SUPER::new(%opts);
  }
  
  sub get_cleanser {
      my $class = shift;
      state $singleton = $class->new;
      $singleton;
  }
  
  1;
  
  __END__
  
DATA_CLEAN_JSON

$fatpacked{"Data/Dmp.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'DATA_DMP';
  package Data::Dmp;
  
  our $DATE = '2015-04-26'; 
  our $VERSION = '0.11'; 
  
  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/Dump.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'DATA_DUMP';
  package Data::Dump;
  
  use strict;
  use vars qw(@EXPORT @EXPORT_OK $VERSION $DEBUG);
  use subs qq(dump);
  
  require Exporter;
  *import = \&Exporter::import;
  @EXPORT = qw(dd ddx);
  @EXPORT_OK = qw(dump pp dumpf quote);
  
  $VERSION = "1.22";
  $DEBUG = 0;
  
  use overload ();
  use vars qw(%seen %refcnt @dump @fixup %require $TRY_BASE64 @FILTERS $INDENT);
  
  $TRY_BASE64 = 50 unless defined $TRY_BASE64;
  $INDENT = "  " unless defined $INDENT;
  
  sub dump
  {
      local %seen;
      local %refcnt;
      local %require;
      local @fixup;
  
      require Data::Dump::FilterContext if @FILTERS;
  
      my $name = "a";
      my @dump;
  
      for my $v (@_) {
  	my $val = _dump($v, $name, [], tied($v));
  	push(@dump, [$name, $val]);
      } continue {
  	$name++;
      }
  
      my $out = "";
      if (%require) {
  	for (sort keys %require) {
  	    $out .= "require $_;\n";
  	}
      }
      if (%refcnt) {
  	for (@dump) {
  	    my $name = $_->[0];
  	    if ($refcnt{$name}) {
  		$out .= "my \$$name = $_->[1];\n";
  		undef $_->[1];
  	    }
  	}
  	for (@fixup) {
  	    $out .= "$_;\n";
  	}
      }
  
      my $paren = (@dump != 1);
      $out .= "(" if $paren;
      $out .= format_list($paren, undef,
  			map {defined($_->[1]) ? $_->[1] : "\$".$_->[0]}
  			    @dump
  		       );
      $out .= ")" if $paren;
  
      if (%refcnt || %require) {
  	$out .= ";\n";
  	$out =~ s/^/$INDENT/gm;
  	$out = "do {\n$out}";
      }
  
      print STDERR "$out\n" unless defined wantarray;
      $out;
  }
  
  *pp = \&dump;
  
  sub dd {
      print dump(@_), "\n";
  }
  
  sub ddx {
      my(undef, $file, $line) = caller;
      $file =~ s,.*[\\/],,;
      my $out = "$file:$line: " . dump(@_) . "\n";
      $out =~ s/^/# /gm;
      print $out;
  }
  
  sub dumpf {
      require Data::Dump::Filtered;
      goto &Data::Dump::Filtered::dump_filtered;
  }
  
  sub _dump
  {
      my $ref  = ref $_[0];
      my $rval = $ref ? $_[0] : \$_[0];
      shift;
  
      my($name, $idx, $dont_remember, $pclass, $pidx) = @_;
  
      my($class, $type, $id);
      my $strval = overload::StrVal($rval);
      if ((my $i = rindex($strval, "=")) >= 0) {
  	$class = substr($strval, 0, $i);
  	$strval = substr($strval, $i+1);
      }
      if ((my $i = index($strval, "(0x")) >= 0) {
  	$type = substr($strval, 0, $i);
  	$id = substr($strval, $i + 2, -1);
      }
      else {
  	die "Can't parse " . overload::StrVal($rval);
      }
      if ($] < 5.008 && $type eq "SCALAR") {
  	$type = "REF" if $ref eq "REF";
      }
      warn "\$$name(@$idx) $class $type $id ($ref)" if $DEBUG;
  
      my $out;
      my $comment;
      my $hide_keys;
      if (@FILTERS) {
  	my $pself = "";
  	$pself = fullname("self", [@$idx[$pidx..(@$idx - 1)]]) if $pclass;
  	my $ctx = Data::Dump::FilterContext->new($rval, $class, $type, $ref, $pclass, $pidx, $idx);
  	my @bless;
  	for my $filter (@FILTERS) {
  	    if (my $f = $filter->($ctx, $rval)) {
  		if (my $v = $f->{object}) {
  		    local @FILTERS;
  		    $out = _dump($v, $name, $idx, 1);
  		    $dont_remember++;
  		}
  		if (defined(my $c = $f->{bless})) {
  		    push(@bless, $c);
  		}
  		if (my $c = $f->{comment}) {
  		    $comment = $c;
  		}
  		if (defined(my $c = $f->{dump})) {
  		    $out = $c;
  		    $dont_remember++;
  		}
  		if (my $h = $f->{hide_keys}) {
  		    if (ref($h) eq "ARRAY") {
  			$hide_keys = sub {
  			    for my $k (@$h) {
  				return 1 if $k eq $_[0];
  			    }
  			    return 0;
  			};
  		    }
  		}
  	    }
  	}
  	push(@bless, "") if defined($out) && !@bless;
  	if (@bless) {
  	    $class = shift(@bless);
  	    warn "More than one filter callback tried to bless object" if @bless;
  	}
      }
  
      unless ($dont_remember) {
  	if (my $s = $seen{$id}) {
  	    my($sname, $sidx) = @$s;
  	    $refcnt{$sname}++;
  	    my $sref = fullname($sname, $sidx,
  				($ref && $type eq "SCALAR"));
  	    warn "SEEN: [\$$name(@$idx)] => [\$$sname(@$sidx)] ($ref,$sref)" if $DEBUG;
  	    return $sref unless $sname eq $name;
  	    $refcnt{$name}++;
  	    push(@fixup, fullname($name,$idx)." = $sref");
  	    return "do{my \$fix}" if @$idx && $idx->[-1] eq '$';
  	    return "'fix'";
  	}
  	$seen{$id} = [$name, $idx];
      }
  
      if ($class) {
  	$pclass = $class;
  	$pidx = @$idx;
      }
  
      if (defined $out) {
      }
      elsif ($type eq "SCALAR" || $type eq "REF" || $type eq "REGEXP") {
  	if ($ref) {
  	    if ($class && $class eq "Regexp") {
  		my $v = "$rval";
  
  		my $mod = "";
  		if ($v =~ /^\(\?\^?([msix-]*):([\x00-\xFF]*)\)\z/) {
  		    $mod = $1;
  		    $v = $2;
  		    $mod =~ s/-.*//;
  		}
  
  		my $sep = '/';
  		my $sep_count = ($v =~ tr/\///);
  		if ($sep_count) {
  		    for ('|', ',', ':', '#') {
  			my $c = eval "\$v =~ tr/\Q$_\E//";
  			if ($c < $sep_count) {
  			    $sep = $_;
  			    $sep_count = $c;
  			    last if $sep_count == 0;
  			}
  		    }
  		}
  		$v =~ s/\Q$sep\E/\\$sep/g;
  
  		$out = "qr$sep$v$sep$mod";
  		undef($class);
  	    }
  	    else {
  		delete $seen{$id} if $type eq "SCALAR";  
  		my $val = _dump($$rval, $name, [@$idx, "\$"], 0, $pclass, $pidx);
  		$out = $class ? "do{\\(my \$o = $val)}" : "\\$val";
  	    }
  	} else {
  	    if (!defined $$rval) {
  		$out = "undef";
  	    }
  	    elsif (do {no warnings 'numeric'; $$rval + 0 eq $$rval}) {
  		$out = $$rval;
  	    }
  	    else {
  		$out = str($$rval);
  	    }
  	    if ($class && !@$idx) {
  		$refcnt{$name}++;
  		my $obj = fullname($name, $idx);
  		my $cl  = quote($class);
  		push(@fixup, "bless \\$obj, $cl");
  	    }
  	}
      }
      elsif ($type eq "GLOB") {
  	if ($ref) {
  	    delete $seen{$id};
  	    my $val = _dump($$rval, $name, [@$idx, "*"], 0, $pclass, $pidx);
  	    $out = "\\$val";
  	    if ($out =~ /^\\\*Symbol::/) {
  		$require{Symbol}++;
  		$out = "Symbol::gensym()";
  	    }
  	} else {
  	    my $val = "$$rval";
  	    $out = "$$rval";
  
  	    for my $k (qw(SCALAR ARRAY HASH)) {
  		my $gval = *$$rval{$k};
  		next unless defined $gval;
  		next if $k eq "SCALAR" && ! defined $$gval;  
  		my $f = scalar @fixup;
  		push(@fixup, "RESERVED");  
  		$gval = _dump($gval, $name, [@$idx, "*{$k}"], 0, $pclass, $pidx);
  		$refcnt{$name}++;
  		my $gname = fullname($name, $idx);
  		$fixup[$f] = "$gname = $gval";  
  	    }
  	}
      }
      elsif ($type eq "ARRAY") {
  	my @vals;
  	my $tied = tied_str(tied(@$rval));
  	my $i = 0;
  	for my $v (@$rval) {
  	    push(@vals, _dump($v, $name, [@$idx, "[$i]"], $tied, $pclass, $pidx));
  	    $i++;
  	}
  	$out = "[" . format_list(1, $tied, @vals) . "]";
      }
      elsif ($type eq "HASH") {
  	my(@keys, @vals);
  	my $tied = tied_str(tied(%$rval));
  
  	my $kstat_max = 0;
  	my $kstat_sum = 0;
  	my $kstat_sum2 = 0;
  
  	my @orig_keys = keys %$rval;
  	if ($hide_keys) {
  	    @orig_keys = grep !$hide_keys->($_), @orig_keys;
  	}
  	my $text_keys = 0;
  	for (@orig_keys) {
  	    $text_keys++, last unless /^[-+]?(?:0|[1-9]\d*)(?:\.\d+)?\z/;
  	}
  
  	if ($text_keys) {
  	    @orig_keys = sort { lc($a) cmp lc($b) } @orig_keys;
  	}
  	else {
  	    @orig_keys = sort { $a <=> $b } @orig_keys;
  	}
  
  	my $quote;
  	for my $key (@orig_keys) {
  	    next if $key =~ /^-?[a-zA-Z_]\w*\z/;
  	    next if $key =~ /^-?[1-9]\d{0,8}\z/;
  	    $quote++;
  	    last;
  	}
  
  	for my $key (@orig_keys) {
  	    my $val = \$rval->{$key};  
  	    $key = quote($key) if $quote;
  	    $kstat_max = length($key) if length($key) > $kstat_max;
  	    $kstat_sum += length($key);
  	    $kstat_sum2 += length($key)*length($key);
  
  	    push(@keys, $key);
  	    push(@vals, _dump($$val, $name, [@$idx, "{$key}"], $tied, $pclass, $pidx));
  	}
  	my $nl = "";
  	my $klen_pad = 0;
  	my $tmp = "@keys @vals";
  	if (length($tmp) > 60 || $tmp =~ /\n/ || $tied) {
  	    $nl = "\n";
  
  	    if ($kstat_max < 4) {
  		$klen_pad = $kstat_max;
  	    }
  	    elsif (@keys >= 2) {
  		my $n = @keys;
  		my $avg = $kstat_sum/$n;
  		my $stddev = sqrt(($kstat_sum2 - $n * $avg * $avg) / ($n - 1));
  
  		if ($stddev / $kstat_max < 0.25) {
  		    $klen_pad = $kstat_max;
  		}
  		if ($DEBUG) {
  		    push(@keys, "__S");
  		    push(@vals, sprintf("%.2f (%d/%.1f/%.1f)",
  					$stddev / $kstat_max,
  					$kstat_max, $avg, $stddev));
  		}
  	    }
  	}
  	$out = "{$nl";
  	$out .= "$INDENT# $tied$nl" if $tied;
  	while (@keys) {
  	    my $key = shift @keys;
  	    my $val = shift @vals;
  	    my $vpad = $INDENT . (" " x ($klen_pad ? $klen_pad + 4 : 0));
  	    $val =~ s/\n/\n$vpad/gm;
  	    my $kpad = $nl ? $INDENT : " ";
  	    $key .= " " x ($klen_pad - length($key)) if $nl;
  	    $out .= "$kpad$key => $val,$nl";
  	}
  	$out =~ s/,$/ / unless $nl;
  	$out .= "}";
      }
      elsif ($type eq "CODE") {
  	$out = 'sub { ... }';
      }
      elsif ($type eq "VSTRING") {
          $out = sprintf +($ref ? '\v%vd' : 'v%vd'), $$rval;
      }
      else {
  	warn "Can't handle $type data";
  	$out = "'#$type#'";
      }
  
      if ($class && $ref) {
  	$out = "bless($out, " . quote($class) . ")";
      }
      if ($comment) {
  	$comment =~ s/^/# /gm;
  	$comment .= "\n" unless $comment =~ /\n\z/;
  	$comment =~ s/^#[ \t]+\n/\n/;
  	$out = "$comment$out";
      }
      return $out;
  }
  
  sub tied_str {
      my $tied = shift;
      if ($tied) {
  	if (my $tied_ref = ref($tied)) {
  	    $tied = "tied $tied_ref";
  	}
  	else {
  	    $tied = "tied";
  	}
      }
      return $tied;
  }
  
  sub fullname
  {
      my($name, $idx, $ref) = @_;
      substr($name, 0, 0) = "\$";
  
      my @i = @$idx;  
      if ($ref && @i && $i[0] eq "\$") {
  	shift(@i);  
  	$ref = 0;
      }
      while (@i && $i[0] eq "\$") {
  	shift @i;
  	$name = "\$$name";
      }
  
      my $last_was_index;
      for my $i (@i) {
  	if ($i eq "*" || $i eq "\$") {
  	    $last_was_index = 0;
  	    $name = "$i\{$name}";
  	} elsif ($i =~ s/^\*//) {
  	    $name .= $i;
  	    $last_was_index++;
  	} else {
  	    $name .= "->" unless $last_was_index++;
  	    $name .= $i;
  	}
      }
      $name = "\\$name" if $ref;
      $name;
  }
  
  sub format_list
  {
      my $paren = shift;
      my $comment = shift;
      my $indent_lim = $paren ? 0 : 1;
      if (@_ > 3) {
  	my $i = 0;
  	while ($i < @_) {
  	    my $j = $i + 1;
  	    my $v = $_[$i];
  	    while ($j < @_) {
  		if ($v eq "0" || $v =~ /^-?[1-9]\d{0,9}\z/) {
  		    $v++;
  		}
  		elsif ($v =~ /^"([A-Za-z]{1,3}\d*)"\z/) {
  		    $v = $1;
  		    $v++;
  		    $v = qq("$v");
  		}
  		else {
  		    last;
  		}
  		last if $_[$j] ne $v;
  		$j++;
  	    }
  	    if ($j - $i > 3) {
  		splice(@_, $i, $j - $i, "$_[$i] .. $_[$j-1]");
  	    }
  	    $i++;
  	}
      }
      my $tmp = "@_";
      if ($comment || (@_ > $indent_lim && (length($tmp) > 60 || $tmp =~ /\n/))) {
  	my @elem = @_;
  	for (@elem) { s/^/$INDENT/gm; }
  	return "\n" . ($comment ? "$INDENT# $comment\n" : "") .
                 join(",\n", @elem, "");
      } else {
  	return join(", ", @_);
      }
  }
  
  sub str {
    if (length($_[0]) > 20) {
        for ($_[0]) {
        if (/^(.)\1\1\1/s) {
            unless (/[^\Q$1\E]/) {
                my $base = quote($1);
                my $repeat = length;
                return "($base x $repeat)"
            }
        }
        if (length($_) < 16 * 1024 && /^(.{2,5}?)\1*\z/s) {
  	  my $base   = quote($1);
  	  my $repeat = length($_)/length($1);
  	  return "($base x $repeat)";
        }
        }
    }
  
    local $_ = &quote;
  
    if (length($_) > 40  && !/\\x\{/ && length($_) > (length($_[0]) * 2)) {
  
        if ($TRY_BASE64 && length($_[0]) > $TRY_BASE64 &&
  	  (defined &utf8::is_utf8 && !utf8::is_utf8($_[0])) &&
  	  eval { require MIME::Base64 })
        {
  	  $require{"MIME::Base64"}++;
  	  return "MIME::Base64::decode(\"" .
  	             MIME::Base64::encode($_[0],"") .
  		 "\")";
        }
        return "pack(\"H*\",\"" . unpack("H*", $_[0]) . "\")";
    }
  
    return $_;
  }
  
  my %esc = (
      "\a" => "\\a",
      "\b" => "\\b",
      "\t" => "\\t",
      "\n" => "\\n",
      "\f" => "\\f",
      "\r" => "\\r",
      "\e" => "\\e",
  );
  
  sub 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("$_");
  }
  
  1;
  
  __END__
  
DATA_DUMP

$fatpacked{"Data/Dump/FilterContext.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'DATA_DUMP_FILTERCONTEXT';
  package Data::Dump::FilterContext;
  
  sub new {
      my($class, $obj, $oclass, $type, $ref, $pclass, $pidx, $idx) = @_;
      return bless {
  	object => $obj,
  	class => $ref && $oclass,
  	reftype => $type,
  	is_ref => $ref,
  	pclass => $pclass,
  	pidx => $pidx,
  	idx => $idx,
      }, $class;
  }
  
  sub object_ref {
      my $self = shift;
      return $self->{object};
  }
  
  sub class {
      my $self = shift;
      return $self->{class} || "";
  }
  
  *is_blessed = \&class;
  
  sub reftype {
      my $self = shift;
      return $self->{reftype};
  }
  
  sub is_scalar {
      my $self = shift;
      return $self->{reftype} eq "SCALAR";
  }
  
  sub is_array {
      my $self = shift;
      return $self->{reftype} eq "ARRAY";
  }
  
  sub is_hash {
      my $self = shift;
      return $self->{reftype} eq "HASH";
  }
  
  sub is_code {
      my $self = shift;
      return $self->{reftype} eq "CODE";
  }
  
  sub is_ref {
      my $self = shift;
      return $self->{is_ref};
  }
  
  sub container_class {
      my $self = shift;
      return $self->{pclass} || "";
  }
  
  sub container_self {
      my $self = shift;
      return "" unless $self->{pclass};
      my $idx = $self->{idx};
      my $pidx = $self->{pidx};
      return Data::Dump::fullname("self", [@$idx[$pidx..(@$idx - 1)]]);
  }
  
  sub expr {
      my $self = shift;
      my $top = shift || "var";
      $top =~ s/^\$//; 
      my $idx = $self->{idx};
      return Data::Dump::fullname($top, $idx);
  }
  
  sub object_isa {
      my($self, $class) = @_;
      return $self->{class} && $self->{class}->isa($class);
  }
  
  sub container_isa {
      my($self, $class) = @_;
      return $self->{pclass} && $self->{pclass}->isa($class);
  }
  
  sub depth {
      my $self = shift;
      return scalar @{$self->{idx}};
  }
  
  1;
DATA_DUMP_FILTERCONTEXT

$fatpacked{"Data/Dump/Filtered.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'DATA_DUMP_FILTERED';
  package Data::Dump::Filtered;
  
  use Data::Dump ();
  use Carp ();
  
  use base 'Exporter';
  our @EXPORT_OK = qw(add_dump_filter remove_dump_filter dump_filtered);
  
  sub add_dump_filter {
      my $filter = shift;
      unless (ref($filter) eq "CODE") {
  	Carp::croak("add_dump_filter argument must be a code reference");
      }
      push(@Data::Dump::FILTERS, $filter);
      return $filter;
  }
  
  sub remove_dump_filter {
      my $filter = shift;
      @Data::Dump::FILTERS = grep $_ ne $filter, @Data::Dump::FILTERS;
  }
  
  sub dump_filtered {
      my $filter = pop;
      if (defined($filter) && ref($filter) ne "CODE") {
  	Carp::croak("Last argument to dump_filtered must be undef or a code reference");
      }
      local @Data::Dump::FILTERS = ($filter ? $filter : ());
      return &Data::Dump::dump;
  }
  
  1;
  
DATA_DUMP_FILTERED

$fatpacked{"Data/Dump/Trace.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'DATA_DUMP_TRACE';
  package Data::Dump::Trace;
  
  $VERSION = "0.02";
  
  
  use strict;
  
  use base 'Exporter';
  our @EXPORT_OK = qw(call mcall wrap autowrap trace);
  
  use Carp qw(croak);
  use overload ();
  
  my %obj_name;
  my %autowrap_class;
  my %name_count;
  
  sub autowrap {
      while (@_) {
          my $class = shift;
          my $info = shift;
          $info = { prefix => $info } unless ref($info);
          for ($info->{prefix}) {
              unless ($_) {
                  $_ = lc($class);
                  s/.*:://;
              }
              $_ = '$' . $_ unless /^\$/;
          }
          $autowrap_class{$class} = $info;
      }
  }
  
  sub wrap {
      my %arg = @_;
      my $name = $arg{name} || "func";
      my $func = $arg{func};
      my $proto = $arg{proto};
  
      return sub {
          call($name, $func, $proto, @_);
      } if $func;
  
      if (my $obj = $arg{obj}) {
          $name = '$' . $name unless $name =~ /^\$/;
          $obj_name{overload::StrVal($obj)} = $name;
          return bless {
              name => $name,
              obj => $obj,
              proto => $arg{proto},
          }, "Data::Dump::Trace::Wrapper";
      }
  
      croak("Either the 'func' or 'obj' option must be given");
  }
  
  sub trace {
      my($symbol, $prototype) = @_;
      no strict 'refs';
      no warnings 'redefine';
      *{$symbol} = wrap(name => $symbol, func => \&{$symbol}, proto => $prototype);
  }
  
  sub call {
      my $name = shift;
      my $func = shift;
      my $proto = shift;
      my $fmt = Data::Dump::Trace::Call->new($name, $proto, \@_);
      if (!defined wantarray) {
          $func->(@_);
          return $fmt->return_void(\@_);
      }
      elsif (wantarray) {
          return $fmt->return_list(\@_, $func->(@_));
      }
      else {
          return $fmt->return_scalar(\@_, scalar $func->(@_));
      }
  }
  
  sub mcall {
      my $o = shift;
      my $method = shift;
      my $proto = shift;
      return if $method eq "DESTROY" && !$o->can("DESTROY");
      my $oname = ref($o) ? $obj_name{overload::StrVal($o)} || "\$o" : $o;
      my $fmt = Data::Dump::Trace::Call->new("$oname->$method", $proto, \@_);
      if (!defined wantarray) {
          $o->$method(@_);
          return $fmt->return_void(\@_);
      }
      elsif (wantarray) {
          return $fmt->return_list(\@_, $o->$method(@_));
      }
      else {
          return $fmt->return_scalar(\@_, scalar $o->$method(@_));
      }
  }
  
  package Data::Dump::Trace::Wrapper;
  
  sub AUTOLOAD {
      my $self = shift;
      our $AUTOLOAD;
      my $method = substr($AUTOLOAD, rindex($AUTOLOAD, '::')+2);
      Data::Dump::Trace::mcall($self->{obj}, $method, $self->{proto}{$method}, @_);
  }
  
  package Data::Dump::Trace::Call;
  
  use Term::ANSIColor ();
  use Data::Dump ();
  
  *_dump = \&Data::Dump::dump;
  
  our %COLOR = (
      name => "yellow",
      output => "cyan",
      error => "red",
      debug => "red",
  );
  
  %COLOR = () unless -t STDOUT;
  
  sub _dumpav {
      return "(" . _dump(@_) . ")" if @_ == 1;
      return _dump(@_);
  }
  
  sub _dumpkv {
      return _dumpav(@_) if @_ % 2;
      my %h = @_;
      my $str = _dump(\%h);
      $str =~ s/^\{/(/ && $str =~ s/\}\z/)/;
      return $str;
  }
  
  sub new {
      my($class, $name, $proto, $input_args) = @_;
      my $self = bless {
          name => $name,
          proto => $proto,
      }, $class;
      my $proto_arg = $self->proto_arg;
      if ($proto_arg =~ /o/) {
          for (@$input_args) {
              push(@{$self->{input_av}}, _dump($_));
          }
      }
      else {
          $self->{input} = $proto_arg eq "%" ? _dumpkv(@$input_args) : _dumpav(@$input_args);
      }
      return $self;
  }
  
  sub proto_arg {
      my $self = shift;
      my($arg, $ret) = split(/\s*=\s*/, $self->{proto} || "");
      $arg ||= '@';
      return $arg;
  }
  
  sub proto_ret {
      my $self = shift;
      my($arg, $ret) = split(/\s*=\s*/, $self->{proto} || "");
      $ret ||= '@';
      return $ret;
  }
  
  sub color {
      my($self, $category, $text) = @_;
      return $text unless $COLOR{$category};
      return Term::ANSIColor::colored($text, $COLOR{$category});
  }
  
  sub print_call {
      my $self = shift;
      my $outarg = shift;
      print $self->color("name", "$self->{name}");
      if (my $input = $self->{input}) {
          $input = "" if $input eq "()" && $self->{name} =~ /->/;
          print $self->color("input", $input);
      }
      else {
          my $proto_arg = $self->proto_arg;
          print "(";
          my $i = 0;
          for (@{$self->{input_av}}) {
              print ", " if $i;
              my $proto = substr($proto_arg, 0, 1, "");
              if ($proto ne "o") {
                  print $self->color("input", $_);
              }
              if ($proto eq "o" || $proto eq "O") {
                  print " = " if $proto eq "O";
                  print $self->color("output", _dump($outarg->[$i]));
              }
          }
          continue {
              $i++;
          }
          print ")";
      }
  }
  
  sub return_void {
      my $self = shift;
      my $arg = shift;
      $self->print_call($arg);
      print "\n";
      return;
  }
  
  sub return_scalar {
      my $self = shift;
      my $arg = shift;
      $self->print_call($arg);
      my $s = shift;
      my $name;
      my $proto_ret = $self->proto_ret;
      my $wrap = $autowrap_class{ref($s)};
      if ($proto_ret =~ /^\$\w+\z/ && ref($s) && ref($s) !~ /^(?:ARRAY|HASH|CODE|GLOB)\z/) {
          $name = $proto_ret;
      }
      else {
          $name = $wrap->{prefix} if $wrap;
      }
      if ($name) {
          $name .= $name_count{$name} if $name_count{$name}++;
          print " = ", $self->color("output", $name), "\n";
          $s = Data::Dump::Trace::wrap(name => $name, obj => $s, proto => $wrap->{proto});
      }
      else {
          print " = ", $self->color("output", _dump($s));
          if (!$s && $proto_ret =~ /!/ && $!) {
              print " ", $self->color("error", errno($!));
          }
          print "\n";
      }
      return $s;
  }
  
  sub return_list {
      my $self = shift;
      my $arg = shift;
      $self->print_call($arg);
      print " = ", $self->color("output", $self->proto_ret eq "%" ? _dumpkv(@_) : _dumpav(@_)), "\n";
      return @_;
  }
  
  sub errno {
      my $t = "";
      for (keys %!) {
          if ($!{$_}) {
              $t = $_;
              last;
          }
      }
      my $n = int($!);
      return "$t($n) $!";
  }
  
  1;
  
  __END__
  
DATA_DUMP_TRACE

$fatpacked{"Data/ModeMerge.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'DATA_MODEMERGE';
  package Data::ModeMerge;
  
  our $DATE = '2015-02-21'; 
  our $VERSION = '0.32'; 
  
  use 5.010001;
  use strict;
  use warnings;
  
  use Mo qw(build default);
  
  require Exporter;
  our @ISA = qw(Exporter);
  our @EXPORT = qw(mode_merge);
  
  sub mode_merge {
      my ($l, $r, $config_vars) = @_;
      my $mm = __PACKAGE__->new(config => $config_vars);
      $mm->merge($l, $r);
  }
  
  has config => (is => "rw");
  
  has modes => (is => 'rw', default => sub { {} });
  
  has combine_rules => (is => 'rw');
  
  has path => (is => "rw", default => sub { [] });
  has errors => (is => "rw", default => sub { [] });
  has mem => (is => "rw", default => sub { {} }); 
  has cur_mem_key => (is => "rw"); 
  
  sub _dump {
      require Data::Dumper;
  
      my ($self, $var) = @_;
      Data::Dumper->new([$var])->Indent(0)->Terse(1)->Sortkeys(1)->Dump;
  }
  
  sub _in($$) {
      my ($self, $needle, $haystack) = @_;
      return 0 unless defined($needle);
      my $r1 = ref($needle);
      my $f1 = $r1 ? $self->_dump($needle) : undef;
      for (@$haystack) {
          my $r2 = ref($_);
          next if $r1 xor $r2;
          return 1 if  $r2 && $f1 eq $self->_dump($_);
          return 1 if !$r2 && $needle eq $_;
      }
      0;
  }
  
  sub BUILD {
      require Data::ModeMerge::Config;
  
      my ($self, $args) = @_;
  
      if ($self->config) {
          my $is_hashref = ref($self->config) eq 'HASH';
          die "config must be a hashref or a Data::ModeMerge::Config" unless
              $is_hashref || UNIVERSAL::isa($self->config, "Data::ModeMerge::Config");
          $self->config(Data::ModeMerge::Config->new(%{ $self->config })) if $is_hashref;
      } else {
          $self->config(Data::ModeMerge::Config->new);
      }
  
      for (qw(NORMAL KEEP ADD CONCAT SUBTRACT DELETE)) {
  	$self->register_mode($_);
      }
  
      if (!$self->combine_rules) {
          $self->combine_rules({
              'ADD+ADD'            => ['ADD'     , 'ADD'   ],
              'ADD+DELETE'         => ['DELETE'  , 'DELETE'],
              'ADD+NORMAL'         => ['NORMAL'  , 'NORMAL'],
              'ADD+SUBTRACT'       => ['SUBTRACT', 'ADD'   ],
  
              'CONCAT+CONCAT'      => ['CONCAT'  , 'CONCAT'],
              'CONCAT+DELETE'      => ['DELETE'  , 'DELETE'],
              'CONCAT+NORMAL'      => ['NORMAL'  , 'NORMAL'],
  
              'DELETE+ADD'         => ['NORMAL'  , 'ADD'     ],
              'DELETE+CONCAT'      => ['NORMAL'  , 'CONCAT'  ],
              'DELETE+DELETE'      => ['DELETE'  , 'DELETE'  ],
              'DELETE+KEEP'        => ['NORMAL'  , 'KEEP'    ],
              'DELETE+NORMAL'      => ['NORMAL'  , 'NORMAL'  ],
              'DELETE+SUBTRACT'    => ['NORMAL'  , 'SUBTRACT'],
  
              'KEEP+ADD'          => ['KEEP', 'KEEP'],
              'KEEP+CONCAT'       => ['KEEP', 'KEEP'],
              'KEEP+DELETE'       => ['KEEP', 'KEEP'],
              'KEEP+KEEP'         => ['KEEP', 'KEEP'],
              'KEEP+NORMAL'       => ['KEEP', 'KEEP'],
              'KEEP+SUBTRACT'     => ['KEEP', 'KEEP'],
  
              'NORMAL+ADD'        => ['ADD'     , 'NORMAL'],
              'NORMAL+CONCAT'     => ['CONCAT'  , 'NORMAL'],
              'NORMAL+DELETE'     => ['DELETE'  , 'NORMAL'],
              'NORMAL+KEEP'       => ['NORMAL'  , 'KEEP'  ],
              'NORMAL+NORMAL'     => ['NORMAL'  , 'NORMAL'],
              'NORMAL+SUBTRACT'   => ['SUBTRACT', 'NORMAL'],
  
              'SUBTRACT+ADD'      => ['SUBTRACT', 'SUBTRACT'],
              'SUBTRACT+DELETE'   => ['DELETE'  , 'DELETE'  ],
              'SUBTRACT+NORMAL'   => ['NORMAL'  , 'NORMAL'  ],
              'SUBTRACT+SUBTRACT' => ['ADD'     , 'SUBTRACT'],
          });
      }
  }
  
  sub push_error {
      my ($self, $errmsg) = @_;
      push @{ $self->errors }, [[@{ $self->path }], $errmsg];
      return;
  }
  
  sub register_mode {
      my ($self, $name0) = @_;
      my $obj;
      if (ref($name0)) {
          my $obj = $name0;
      } elsif ($name0 =~ /^\w+(::\w+)+$/) {
          eval "require $name0; \$obj = $name0->new";
          die "Can't load module $name0: $@" if $@;
      } elsif ($name0 =~ /^\w+$/) {
          my $modname = "Data::ModeMerge::Mode::$name0";
          eval "require $modname; \$obj = $modname->new";
          die "Can't load module $modname: $@" if $@;
      } else {
          die "Invalid mode name $name0";
      }
      my $name = $obj->name;
      die "Mode $name already registered" if $self->modes->{$name};
      $obj->merger($self);
      $self->modes->{$name} = $obj;
  }
  
  sub check_prefix {
      my ($self, $hash_key) = @_;
      die "Hash key not a string" if ref($hash_key);
      my $dis = $self->config->disable_modes;
      if (defined($dis) && ref($dis) ne 'ARRAY') {
          $self->push_error("Invalid config value `disable_modes`: must be an array");
          return;
      }
      for my $mh (sort { $b->precedence_level <=> $a->precedence_level }
                  grep { !$dis || !$self->_in($_->name, $dis) }
                  values %{ $self->modes }) {
          if ($mh->check_prefix($hash_key)) {
              return $mh->name;
          }
      }
      return;
  }
  
  sub check_prefix_on_hash {
      my ($self, $hash) = @_;
      die "Not a hash" unless ref($hash) eq 'HASH';
      my $res = 0;
      for (keys %$hash) {
  	do { $res++; last } if $self->check_prefix($_);
      }
      $res;
  }
  
  sub add_prefix {
      my ($self, $hash_key, $mode) = @_;
      die "Hash key not a string" if ref($hash_key);
      my $dis = $self->config->disable_modes;
      if (defined($dis) && ref($dis) ne 'ARRAY') {
          die "Invalid config value `disable_modes`: must be an array";
      }
      if ($dis && $self->_in($mode, $dis)) {
          $self->push_error("Can't add prefix for currently disabled mode `$mode`");
          return $hash_key;
      }
      my $mh = $self->modes->{$mode} or die "Unknown mode: $mode";
      $mh->add_prefix($hash_key);
  }
  
  sub remove_prefix {
      my ($self, $hash_key) = @_;
      die "Hash key not a string" if ref($hash_key);
      my $dis = $self->config->disable_modes;
      if (defined($dis) && ref($dis) ne 'ARRAY') {
          die "Invalid config value `disable_modes`: must be an array";
      }
      for my $mh (sort { $b->precedence_level <=> $a->precedence_level }
                  grep { !$dis || !$self->_in($_->name, $dis) }
                  values %{ $self->modes }) {
          if ($mh->check_prefix($hash_key)) {
              my $r = $mh->remove_prefix($hash_key);
              if (wantarray) { return ($r, $mh->name) }
              else           { return $r }
          }
      }
      if (wantarray) { return ($hash_key, $self->config->default_mode) }
      else           { return $hash_key }
  }
  
  sub remove_prefix_on_hash {
      my ($self, $hash) = @_;
      die "Not a hash" unless ref($hash) eq 'HASH';
      for (keys %$hash) {
  	my $old = $_;
  	$_ = $self->remove_prefix($_);
  	next unless $old ne $_;
  	die "Conflict when removing prefix on hash: $old -> $_ but $_ already exists"
  	    if exists $hash->{$_};
  	$hash->{$_} = $hash->{$old};
  	delete $hash->{$old};
      }
      $hash;
  }
  
  sub merge {
      my ($self, $l, $r) = @_;
      $self->path([]);
      $self->errors([]);
      $self->mem({});
      $self->cur_mem_key(undef);
      my ($key, $res, $backup) = $self->_merge(undef, $l, $r);
      {
          success => !@{ $self->errors },
          error   => (@{ $self->errors } ?
                      join(", ",
                           map { sprintf("/%s: %s", join("/", @{ $_->[0] }), $_->[1]) }
                               @{ $self->errors }) : ''),
          result  => $res,
          backup  => $backup,
      };
  }
  
  sub _process_todo {
      my ($self) = @_;
      if ($self->cur_mem_key) {
          for my $mk (keys %{ $self->mem }) {
              my $res = $self->mem->{$mk}{res};
              if (defined($res) && @{ $self->mem->{$mk}{todo} }) {
                  for (@{  $self->mem->{$mk}{todo} }) {
                      $_->(@$res);
                      return if @{ $self->errors };
                  }
                  $self->mem->{$mk}{todo} = [];
              }
          }
      }
  }
  
  sub _merge {
      my ($self, $key, $l, $r, $mode) = @_;
      my $c = $self->config;
      $mode //= $c->default_mode;
  
      my $mh = $self->modes->{$mode};
      die "Can't find handler for mode $mode" unless $mh;
  
      my $rl = ref($l);
      my $rr = ref($r);
      my $tl = $rl eq 'HASH' ? 'HASH' : $rl eq 'ARRAY' ? 'ARRAY' : $rl eq 'CODE' ? 'CODE' : !$rl ? 'SCALAR' : '';
      my $tr = $rr eq 'HASH' ? 'HASH' : $rr eq 'ARRAY' ? 'ARRAY' : $rr eq 'CODE' ? 'CODE' : !$rr ? 'SCALAR' : '';
      if (!$tl) { $self->push_error("Unknown type in left side: $rl"); return }
      if (!$tr) { $self->push_error("Unknown type in right side: $rr"); return }
      if (!$c->allow_create_array && $tl ne 'ARRAY' && $tr eq 'ARRAY') {
          $self->push_error("Not allowed to create array"); return;
      }
      if (!$c->allow_create_hash && $tl ne 'HASH' && $tr eq 'HASH') {
          $self->push_error("Not allowed to create hash"); return;
      }
      if (!$c->allow_destroy_array && $tl eq 'ARRAY' && $tr ne 'ARRAY') {
          $self->push_error("Not allowed to destroy array"); return;
      }
      if (!$c->allow_destroy_hash && $tl eq 'HASH' && $tr ne 'HASH') {
          $self->push_error("Not allowed to destroy hash"); return;
      }
      my $meth = "merge_${tl}_${tr}";
      if (!$mh->can($meth)) { $self->push_error("No merge method found for $tl + $tr (mode $mode)"); return }
  
      my $memkey;
      if ($rl || $rr) {
          $memkey = sprintf "%s%s %s%s %s %s",
              (defined($l) ? ($rl ? 2 : 1) : 0),
              (defined($l) ? "$l" : ''),
              (defined($r) ? ($rr ? 2 : 1) : 0),
              (defined($r) ? "$r" : ''),
              $mode,
              $self->config;
      }
      if ($memkey) {
          if (exists $self->mem->{$memkey}) {
              $self->_process_todo;
              if (defined $self->mem->{$memkey}{res}) {
                  return @{ $self->mem->{$memkey}{res} };
              } else {
                  return ($key, undef, undef, 1);
              }
          } else {
              $self->mem->{$memkey} = {res=>undef, todo=>[]};
              $self->cur_mem_key($memkey);
              my ($newkey, $res, $backup) = $mh->$meth($key, $l, $r);
              $self->mem->{$memkey}{res} = [$newkey, $res, $backup];
              $self->_process_todo;
              return ($newkey, $res, $backup);
          }
      } else {
          $self->_process_todo;
          return $mh->$meth($key, $l, $r);
      }
  }
  
  sub _path_is_included {
      my ($self, $p1, $p2) = @_;
      my $res = 1;
      for my $i (0..@$p1-1) {
          do { $res = 0; last } if !defined($p2->[$i]) || $p1->[$i] ne $p2->[$i];
      }
      $res;
  }
  
  1;
  
  __END__
  
DATA_MODEMERGE

$fatpacked{"Data/ModeMerge/Config.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'DATA_MODEMERGE_CONFIG';
  package Data::ModeMerge::Config;
  
  our $DATE = '2015-02-21'; 
  our $VERSION = '0.32'; 
  
  use 5.010;
  use Mo qw(build default);
  
  has recurse_hash          => (is => 'rw', default => sub{1});
  has recurse_array         => (is => 'rw', default => sub{0});
  has parse_prefix          => (is => 'rw', default => sub{1});
  has wanted_path           => (is => 'rw');
  has default_mode          => (is => 'rw', default => sub{'NORMAL'});
  has disable_modes         => (is => 'rw');
  has allow_create_array    => (is => 'rw', default => sub{1});
  has allow_create_hash     => (is => 'rw', default => sub{1});
  has allow_destroy_array   => (is => 'rw', default => sub{1});
  has allow_destroy_hash    => (is => 'rw', default => sub{1});
  has exclude_parse         => (is => 'rw');
  has exclude_parse_regex   => (is => 'rw');
  has include_parse         => (is => 'rw');
  has include_parse_regex   => (is => 'rw');
  has exclude_merge         => (is => 'rw');
  has exclude_merge_regex   => (is => 'rw');
  has include_merge         => (is => 'rw');
  has include_merge_regex   => (is => 'rw');
  has set_prefix            => (is => 'rw');
  has readd_prefix          => (is => 'rw', default => sub{1});
  has premerge_pair_filter  => (is => 'rw');
  has options_key           => (is => 'rw', default => sub{''});
  has allow_override        => (is => 'rw');
  has disallow_override     => (is => 'rw');
  
  sub _config_config {
      state $a = [qw/
          wanted_path
          options_key
          allow_override
          disallow_override
                    /];
  }
  
  sub _config_ok {
      state $a = [qw/
          recurse_hash
          recurse_array
          parse_prefix
          default_mode
          disable_modes
          allow_create_array
          allow_create_hash
          allow_destroy_array
          allow_destroy_hash
          exclude_parse
          exclude_parse_regex
          include_parse
          include_parse_regex
          exclude_merge
          exclude_merge_regex
          include_merge
          include_merge_regex
          set_prefix
          readd_prefix
          premerge_pair_filter
                    /];
  }
  
  1;
  
  __END__
  
DATA_MODEMERGE_CONFIG

$fatpacked{"Data/ModeMerge/Mode/ADD.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'DATA_MODEMERGE_MODE_ADD';
  package Data::ModeMerge::Mode::ADD;
  
  our $DATE = '2015-02-21'; 
  our $VERSION = '0.32'; 
  
  use 5.010;
  use strict;
  use warnings;
  use Mo qw(build default);
  extends 'Data::ModeMerge::Mode::NORMAL';
  
  sub name { 'ADD' }
  
  sub precedence_level { 3 }
  
  sub default_prefix { '+' }
  
  sub default_prefix_re { qr/^\+/ }
  
  sub merge_SCALAR_SCALAR {
      my ($self, $key, $l, $r) = @_;
      ($key, ( $l // 0 ) + $r);
  }
  
  sub merge_SCALAR_ARRAY {
      my ($self, $key, $l, $r) = @_;
      $self->merger->push_error("Can't add scalar and array");
      return;
  }
  
  sub merge_SCALAR_HASH {
      my ($self, $key, $l, $r) = @_;
      $self->merger->push_error("Can't add scalar and hash");
      return;
  }
  
  sub merge_ARRAY_SCALAR {
      my ($self, $key, $l, $r) = @_;
      $self->merger->push_error("Can't add array and scalar");
      return;
  }
  
  sub merge_ARRAY_ARRAY {
      my ($self, $key, $l, $r) = @_;
      ($key, [ @$l, @$r ]);
  }
  
  sub merge_ARRAY_HASH {
      my ($self, $key, $l, $r) = @_;
      $self->merger->push_error("Can't add array and hash");
      return;
  }
  
  sub merge_HASH_SCALAR {
      my ($self, $key, $l, $r) = @_;
      $self->merger->push_error("Can't add hash and scalar");
      return;
  }
  
  sub merge_HASH_ARRAY {
      my ($self, $key, $l, $r) = @_;
      $self->merger->push_error("Can't add hash and array");
      return;
  }
  
  1;
  
  __END__
  
DATA_MODEMERGE_MODE_ADD

$fatpacked{"Data/ModeMerge/Mode/Base.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'DATA_MODEMERGE_MODE_BASE';
  package Data::ModeMerge::Mode::Base;
  
  our $DATE = '2015-02-21'; 
  our $VERSION = '0.32'; 
  
  use 5.010;
  use strict;
  use warnings;
  
  use Mo qw(build default);
  
  
  has merger => (is => 'rw');
  has prefix => (is => 'rw');
  has prefix_re => (is => 'rw');
  has check_prefix_sub => (is => 'rw');
  has add_prefix_sub => (is => 'rw');
  has remove_prefix_sub => (is => 'rw');
  
  sub name {
      die "Subclass must provide name()";
  }
  
  sub precedence_level {
      die "Subclass must provide precedence_level()";
  }
  
  sub default_prefix {
      die "Subclass must provide default_prefix()";
  }
  
  sub default_prefix_re {
      die "Subclass must provide default_prefix_re()";
  }
  
  sub BUILD {
      my ($self) = @_;
      $self->prefix($self->default_prefix);
      $self->prefix_re($self->default_prefix_re);
  }
  
  sub check_prefix {
      my ($self, $hash_key) = @_;
      if ($self->check_prefix_sub) {
          $self->check_prefix_sub->($hash_key);
      } else {
          $hash_key =~ $self->prefix_re;
      }
  }
  
  sub add_prefix {
      my ($self, $hash_key) = @_;
      if ($self->add_prefix_sub) {
          $self->add_prefix_sub->($hash_key);
      } else {
          $self->prefix . $hash_key;
      }
  }
  
  sub remove_prefix {
      my ($self, $hash_key) = @_;
      if ($self->remove_prefix_sub) {
          $self->remove_prefix_sub->($hash_key);
      } else {
          my $re = $self->prefix_re;
          $hash_key =~ s/$re//;
          $hash_key;
      }
  }
  
  sub merge_ARRAY_ARRAY {
      my ($self, $key, $l, $r) = @_;
      my $mm = $self->merger;
      my $c = $mm->config;
      return $self->merge_SCALAR_SCALAR($key, $l, $r) unless $c->recurse_array;
      return if $c->wanted_path && !$mm->_path_is_included($mm->path, $c->wanted_path);
  
      my @res;
      my @backup;
      my $la = @$l;
      my $lb = @$r;
      push @{ $mm->path }, -1;
      for my $i (0..($la > $lb ? $la : $lb)-1) {
          $mm->path->[-1] = $i;
          if ($i < $la && $i < $lb) {
              push @backup, $l->[$i];
              my ($subnewkey, $subres, $subbackup, $is_circular) = $mm->_merge($i, $l->[$i], $r->[$i], $c->default_mode);
              last if @{ $mm->errors };
              if ($is_circular) {
                  push @res, undef;
                  push @{ $mm->mem->{ $mm->cur_mem_key }{todo} }, sub {
                      my ($subnewkey, $subres, $subbackup) = @_;
                      $res[$i] = $subres;
                  }
              } else {
                  push @res, $subres;
              }
          } elsif ($i < $la) {
              push @res, $l->[$i];
          } else {
              push @res, $r->[$i];
          }
      }
      pop @{ $mm->path };
      ($key, \@res, \@backup);
  }
  
  sub _prefilter_hash {
      my ($self, $h, $desc, $sub) = @_;
      my $mm = $self->merger;
  
      if (ref($sub) ne 'CODE') {
          $mm->push_error("$desc failed: filter must be a coderef");
          return;
      }
  
      my $res = {};
      for (keys %$h) {
          my @r = $sub->($_, $h->{$_});
          while (my ($k, $v) = splice @r, 0, 2) {
              next unless defined $k;
              if (exists $res->{$k}) {
                  $mm->push_error("$desc failed; key conflict: ".
                                  "$_ -> $k, but key $k already exists");
                  return;
              }
              $res->{$k} = $v;
          }
      }
  
      $res;
  }
  
  sub _gen_left {
      my ($self, $l, $mode, $esub, $ep, $ip, $epr, $ipr) = @_;
      my $mm = $self->merger;
      my $c = $mm->config;
  
  
      if ($c->premerge_pair_filter) {
          $l = $self->_prefilter_hash($l, "premerge filter left hash",
                                      $c->premerge_pair_filter);
          return if @{ $mm->errors };
      }
  
      my $hl = {};
      if ($c->parse_prefix) {
          for (keys %$l) {
              my $do_parse = 1;
              $do_parse = 0 if $do_parse && $ep  &&  $mm->_in($_, $ep);
              $do_parse = 0 if $do_parse && $ip  && !$mm->_in($_, $ip);
              $do_parse = 0 if $do_parse && $epr &&  /$epr/;
              $do_parse = 0 if $do_parse && $ipr && !/$ipr/;
  
              if ($do_parse) {
                  my $old = $_;
                  my $m2;
                  ($_, $m2) = $mm->remove_prefix($_);
                  next if $esub && !$esub->($_);
                  if ($old ne $_ && exists($l->{$_})) {
                      $mm->push_error("Conflict when removing prefix on left-side ".
                                      "hash key: $old -> $_ but $_ already exists");
                      return;
                  }
                  $hl->{$_} = [$m2, $l->{$old}];
              } else {
                  next if $esub && !$esub->($_);
                  $hl->{$_} = [$mode, $l->{$_}];
              }
          }
      } else {
          for (keys %$l) {
              next if $esub && !$esub->($_);
              $hl->{$_} = [$mode, $l->{$_}];
          }
      }
  
      $hl;
  }
  
  sub _gen_right {
      my ($self, $r, $mode, $esub, $ep, $ip, $epr, $ipr) = @_;
      my $mm = $self->merger;
      my $c = $mm->config;
  
  
      if ($c->premerge_pair_filter) {
          $r = $self->_prefilter_hash($r, "premerge filter right hash",
                                      $c->premerge_pair_filter);
          return if @{ $mm->errors };
      }
  
      my $hr = {};
      if ($c->parse_prefix) {
          for (keys %$r) {
              my $do_parse = 1;
              $do_parse = 0 if $do_parse && $ep  &&  $mm->_in($_, $ep);
              $do_parse = 0 if $do_parse && $ip  && !$mm->_in($_, $ip);
              $do_parse = 0 if $do_parse && $epr &&  /$epr/;
              $do_parse = 0 if $do_parse && $ipr && !/$ipr/;
  
              if ($do_parse) {
                  my $old = $_;
                  my $m2;
                  ($_, $m2) = $mm->remove_prefix($_);
                  next if $esub && !$esub->($_);
                  if (exists $hr->{$_}{$m2}) {
                      $mm->push_error("Conflict when removing prefix on right-side ".
                                      "hash key: $old($m2) -> $_ ($m2) but $_ ($m2) ".
                                      "already exists");
                      return;
                  }
                  $hr->{$_}{$m2} = $r->{$old};
              } else {
                  next if $esub && !$esub->($_);
                  $hr->{$_} = {$mode => $r->{$_}};
              }
          }
      } else {
          for (keys %$r) {
              next if $esub && !$esub->($_);
              $hr->{$_} = {$mode => $r->{$_}}
          }
      }
      $hr;
  }
  
  sub _merge_gen {
      my ($self, $hl, $hr, $mode, $em, $im, $emr, $imr) = @_;
      my $mm = $self->merger;
      my $c = $mm->config;
  
  
      my $res = {};
      my $backup = {};
  
      my %k = map {$_=>1} keys(%$hl), keys(%$hr);
      push @{ $mm->path }, "";
    K:
      for my $k (keys %k) {
          my @o;
          $mm->path->[-1] = $k;
          my $do_merge = 1;
          $do_merge = 0 if $do_merge && $em  &&  $mm->_in($k, $em);
          $do_merge = 0 if $do_merge && $im  && !$mm->_in($k, $im);
          $do_merge = 0 if $do_merge && $emr && $k =~ /$emr/;
          $do_merge = 0 if $do_merge && $imr && $k !~ /$imr/;
  
          if (!$do_merge) {
              $res->{$k} = $hl->{$k} if $hl->{$k};
              next K;
          }
  
          $backup->{$k} = $hl->{$k}[1] if $hl->{$k} && $hr->{$k};
          if ($hl->{$k}) {
              push @o, $hl->{$k};
          }
          if ($hr->{$k}) {
              my %m = map {$_=>$mm->modes->{$_}->precedence_level} keys %{ $hr->{$k} };
              push @o, map { [$_, $hr->{$k}{$_}] } sort { $m{$b} <=> $m{$a} } keys %m;
          }
          my $final_mode;
          my $is_circular;
          my $v;
          for my $i (0..$#o) {
              if ($i == 0) {
                  my $mh = $mm->modes->{$o[$i][0]};
                  if (@o == 1 &&
                          (($hl->{$k} && $mh->can("merge_left_only")) ||
                           ($hr->{$k} && $mh->can("merge_right_only")))) {
                      my $meth = $hl->{$k} ? "merge_left_only" : "merge_right_only";
                      my ($subnewkey, $v, $subbackup, $is_circular, $newmode) = $mh->$meth($k, $o[$i][1]); 
                      next K unless defined($subnewkey);
                      $final_mode = $newmode;
                      $v = $res;
                  } else {
                      $final_mode = $o[$i][0];
                      $v = $o[$i][1];
                  }
              } else {
                  my $m = $mm->combine_rules->{"$final_mode+$o[$i][0]"}
                      or do {
                          $mm->push_error("Can't merge $final_mode + $o[$i][0]");
                          return;
                      };
                  my ($subnewkey, $subbackup);
                  ($subnewkey, $v, $subbackup, $is_circular) = $mm->_merge($k, $v, $o[$i][1], $m->[0]);
                  return if @{ $mm->errors };
                  if ($is_circular) {
                      if ($i < $#o) {
                          $mm->push_error("Can't handle circular at $i of $#o merges (mode $m->[0]): not the last merge");
                          return;
                      }
                      push @{ $mm->mem->{ $mm->cur_mem_key }{todo} }, sub {
                          my ($subnewkey, $subres, $subbackup) = @_;
                          my $final_mode = $m->[1];
                          $res->{$k} = [$m->[1], $subres];
                          if ($c->readd_prefix) {
                              $self->_readd_prefix($res, $k, $c->default_mode);
                          } else {
                              $res->{$k} = $res->{$k}[1];
                          }
                      };
                      delete $res->{$k};
                  }
                  next K unless defined $subnewkey;
                  $final_mode = $m->[1];
              }
          }
          $res->{$k} = [$final_mode, $v] unless $is_circular;
      }
      pop @{ $mm->path };
      ($res, $backup);
  }
  
  sub _readd_prefix {
      my ($self, $hh, $k, $defmode) = @_;
      my $mm = $self->merger;
      my $c = $mm->config;
  
      my $m = $hh->{$k}[0];
      if ($m eq $defmode) {
          $hh->{$k} = $hh->{$k}[1];
      } else {
          my $kp = $mm->modes->{$m}->add_prefix($k);
          if (exists $hh->{$kp}) {
              $mm->push_error("BUG: conflict when re-adding prefix after merge: $kp");
              return;
          }
          $hh->{$kp} = $hh->{$k}[1];
          delete $hh->{$k};
      }
  }
  
  sub merge_HASH_HASH {
      my ($self, $key, $l, $r, $mode) = @_;
      my $mm = $self->merger;
      my $c = $mm->config;
      $mode //= $c->default_mode;
  
      return $self->merge_SCALAR_SCALAR($key, $l, $r) unless $c->recurse_hash;
      return if $c->wanted_path && !$mm->_path_is_included($mm->path, $c->wanted_path);
  
      my $config_replaced;
      my $orig_c = $c;
      my $ok = $c->options_key;
      {
          last unless defined $ok;
  
          my $okl = $self->_gen_left ($l, $mode, sub {$_[0] eq $ok});
          return if @{ $mm->errors };
  
          my $okr = $self->_gen_right($r, $mode, sub {$_[0] eq $ok});
          return if @{ $mm->errors };
  
          push @{ $mm->path }, $ok;
          my ($res, $backup);
          {
              local $c->{readd_prefix} = 0;
              ($res, $backup) = $self->_merge_gen($okl, $okr, $mode);
          }
          pop @{ $mm->path };
          return if @{ $mm->errors };
  
  
          $res = $res->{$ok} ? $res->{$ok}[1] : undef;
          if (defined($res) && ref($res) ne 'HASH') {
              $mm->push_error("Invalid options key after merge: value must be hash");
              return;
          }
          last unless keys %$res;
          my $c2 = bless({ %$c }, ref($c));
  
          for (keys %$res) {
              if ($c->allow_override) {
                  my $re = $c->allow_override;
                  if (!/$re/) {
                      $mm->push_error("Configuration in options key `$_` not allowed by allow_override $re");
                      return;
                  }
              }
              if ($c->disallow_override) {
                  my $re = $c->disallow_override;
                  if (/$re/) {
                      $mm->push_error("Configuration in options key `$_` not allowed by disallow_override $re");
                      return;
                  }
              }
              if ($mm->_in($_, $c->_config_config)) {
                  $mm->push_error("Configuration not allowed in options key: $_");
                  return;
              }
              if ($_ ne $ok && !$mm->_in($_, $c->_config_ok)) {
                  $mm->push_error("Unknown configuration in options key: $_");
                  return;
              }
              $c2->$_($res->{$_}) unless $_ eq $ok;
          }
          $mm->config($c2);
          $config_replaced++;
          $c = $c2;
      }
  
      my $sp = $c->set_prefix;
      my $saved_prefixes;
      if (defined($sp)) {
          if (ref($sp) ne 'HASH') {
              $mm->push_error("Invalid config value `set_prefix`: must be a hash");
              return;
          }
          $saved_prefixes = {};
          for my $mh (values %{ $mm->modes }) {
              my $n = $mh->name;
              if ($sp->{$n}) {
                  $saved_prefixes->{$n} = {
                      prefix => $mh->prefix,
                      prefix_re => $mh->prefix_re,
                      check_prefix_sub => $mh->check_prefix_sub,
                      add_prefix_sub => $mh->add_prefix_sub,
                      remove_prefix_sub => $mh->remove_prefix_sub,
                  };
                  $mh->prefix($sp->{$n});
                  my $re = quotemeta($sp->{$n});
                  $mh->prefix_re(qr/^$re/);
                  $mh->check_prefix_sub(undef);
                  $mh->add_prefix_sub(undef);
                  $mh->remove_prefix_sub(undef);
              }
          }
      }
  
      my $ep = $c->exclude_parse;
      my $ip = $c->include_parse;
      if (defined($ep) && ref($ep) ne 'ARRAY') {
          $mm->push_error("Invalid config value `exclude_parse`: must be an array");
          return;
      }
      if (defined($ip) && ref($ip) ne 'ARRAY') {
          $mm->push_error("Invalid config value `include_parse`: must be an array");
          return;
      }
  
      my $epr = $c->exclude_parse_regex;
      my $ipr = $c->include_parse_regex;
      if (defined($epr)) {
          eval { $epr = qr/$epr/ };
          if ($@) {
              $mm->push_error("Invalid config value `exclude_parse_regex`: invalid regex: $@");
              return;
          }
      }
      if (defined($ipr)) {
          eval { $ipr = qr/$ipr/ };
          if ($@) {
              $mm->push_error("Invalid config value `include_parse_regex`: invalid regex: $@");
              return;
          }
      }
  
      my $hl = $self->_gen_left ($l, $mode, sub {defined($ok) ? $_[0] ne $ok : 1}, $ep, $ip, $epr, $ipr);
      return if @{ $mm->errors };
  
      my $hr = $self->_gen_right($r, $mode, sub {defined($ok) ? $_[0] ne $ok : 1}, $ep, $ip, $epr, $ipr);
      return if @{ $mm->errors };
  
  
      my $em = $c->exclude_merge;
      my $im = $c->include_merge;
      if (defined($em) && ref($em) ne 'ARRAY') {
          $mm->push_error("Invalid config value `exclude_marge`: must be an array");
          return;
      }
      if (defined($im) && ref($im) ne 'ARRAY') {
          $mm->push_error("Invalid config value `include_merge`: must be an array");
          return;
      }
  
      my $emr = $c->exclude_merge_regex;
      my $imr = $c->include_merge_regex;
      if (defined($emr)) {
          eval { $emr = qr/$emr/ };
          if ($@) {
              $mm->push_error("Invalid config value `exclude_merge_regex`: invalid regex: $@");
              return;
          }
      }
      if (defined($imr)) {
          eval { $imr = qr/$imr/ };
          if ($@) {
              $mm->push_error("Invalid config value `include_merge_regex`: invalid regex: $@");
              return;
          }
      }
  
      my ($res, $backup) = $self->_merge_gen($hl, $hr, $mode, $em, $im, $emr, $imr);
      return if @{ $mm->errors };
  
  
      if ($c->readd_prefix) {
          for my $k (keys %$res) {
              $self->_readd_prefix($res, $k, $c->default_mode);
          }
      } else {
          $res->{$_} = $res->{$_}[1] for keys %$res;
      }
  
      if ($saved_prefixes) {
          for (keys %$saved_prefixes) {
              my $mh = $mm->modes->{$_};
              my $s = $saved_prefixes->{$_};
              $mh->prefix($s->{prefix});
              $mh->prefix_re($s->{prefix_re});
              $mh->check_prefix_sub($s->{check_prefix_sub});
              $mh->add_prefix_sub($s->{add_prefix_sub});
              $mh->remove_prefix_sub($s->{remove_prefix_sub});
          }
      }
  
      if ($config_replaced) {
          $mm->config($orig_c);
      }
  
      ($key, $res, $backup);
  }
  
  1;
  
  __END__
  
DATA_MODEMERGE_MODE_BASE

$fatpacked{"Data/ModeMerge/Mode/CONCAT.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'DATA_MODEMERGE_MODE_CONCAT';
  package Data::ModeMerge::Mode::CONCAT;
  
  our $DATE = '2015-02-21'; 
  our $VERSION = '0.32'; 
  
  use 5.010;
  use strict;
  use warnings;
  use Mo qw(build default);
  extends 'Data::ModeMerge::Mode::ADD';
  
  sub name { 'CONCAT' }
  
  sub precedence_level { 2 }
  
  sub default_prefix { '.' }
  
  sub default_prefix_re { qr/^\./ }
  
  sub merge_SCALAR_SCALAR {
      my ($self, $key, $l, $r) = @_;
      ($key, ($l // "") . $r);
  }
  
  1;
  
  __END__
  
DATA_MODEMERGE_MODE_CONCAT

$fatpacked{"Data/ModeMerge/Mode/DELETE.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'DATA_MODEMERGE_MODE_DELETE';
  package Data::ModeMerge::Mode::DELETE;
  
  our $DATE = '2015-02-21'; 
  our $VERSION = '0.32'; 
  
  use 5.010;
  use strict;
  use warnings;
  use Mo qw(build default);
  extends 'Data::ModeMerge::Mode::Base';
  
  sub name { 'DELETE' }
  
  sub precedence_level { 1 }
  
  sub default_prefix { '!' }
  
  sub default_prefix_re { qr/^!/ }
  
  sub merge_left_only {
      my ($self, $key, $l) = @_;
      return;
  }
  
  sub merge_right_only {
      my ($self, $key, $r) = @_;
      return;
  }
  
  sub merge_SCALAR_SCALAR {
      return;
  }
  
  sub merge_SCALAR_ARRAY {
      return;
  }
  
  sub merge_SCALAR_HASH {
      return;
  }
  
  sub merge_ARRAY_SCALAR {
      return;
  }
  
  sub merge_ARRAY_ARRAY {
      my ($self, $key, $l, $r) = @_;
      $self->merger->config->allow_destroy_array or
          $self->merger->push_error("Now allowed to destroy array via DELETE mode");
      return;
  }
  
  sub merge_ARRAY_HASH {
      return;
  }
  
  sub merge_HASH_SCALAR {
      return;
  }
  
  sub merge_HASH_ARRAY {
      return;
  }
  
  sub merge_HASH_HASH {
      my ($self, $key, $l, $r) = @_;
      $self->merger->config->allow_destroy_hash or
          $self->merger->push_error("Now allowed to destroy hash via DELETE mode");
      return;
  }
  
  1;
  
  __END__
  
DATA_MODEMERGE_MODE_DELETE

$fatpacked{"Data/ModeMerge/Mode/KEEP.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'DATA_MODEMERGE_MODE_KEEP';
  package Data::ModeMerge::Mode::KEEP;
  
  our $DATE = '2015-02-21'; 
  our $VERSION = '0.32'; 
  
  use 5.010;
  use strict;
  use warnings;
  use Mo qw(build default);
  extends 'Data::ModeMerge::Mode::Base';
  
  sub name { 'KEEP' }
  
  sub precedence_level { 6 }
  
  sub default_prefix { '^' }
  
  sub default_prefix_re { qr/^\^/ }
  
  sub merge_SCALAR_SCALAR {
      my ($self, $key, $l, $r) = @_;
      ($key, $l);
  }
  
  sub merge_SCALAR_ARRAY {
      my ($self, $key, $l, $r) = @_;
      ($key, $l);
  }
  
  sub merge_SCALAR_HASH {
      my ($self, $key, $l, $r) = @_;
      ($key, $l);
  }
  
  sub merge_ARRAY_SCALAR {
      my ($self, $key, $l, $r) = @_;
      ($key, $l);
  }
  
  sub merge_ARRAY_ARRAY {
      my ($self, $key, $l, $r) = @_;
      $self->SUPER::merge_ARRAY_ARRAY($key, $l, $r, 'KEEP');
  };
  
  sub merge_ARRAY_HASH {
      my ($self, $key, $l, $r) = @_;
      ($key, $l);
  }
  
  sub merge_HASH_SCALAR {
      my ($self, $key, $l, $r) = @_;
      ($key, $l);
  }
  
  sub merge_HASH_ARRAY {
      my ($self, $key, $l, $r) = @_;
      ($key, $l);
  }
  
  sub merge_HASH_HASH {
      my ($self, $key, $l, $r) = @_;
      $self->SUPER::merge_HASH_HASH($key, $l, $r, 'KEEP');
  };
  
  1;
  
  __END__
  
DATA_MODEMERGE_MODE_KEEP

$fatpacked{"Data/ModeMerge/Mode/NORMAL.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'DATA_MODEMERGE_MODE_NORMAL';
  package Data::ModeMerge::Mode::NORMAL;
  
  our $DATE = '2015-02-21'; 
  our $VERSION = '0.32'; 
  
  use 5.010;
  use strict;
  use warnings;
  use Mo qw(build default);
  extends 'Data::ModeMerge::Mode::Base';
  
  sub name { 'NORMAL' }
  
  sub precedence_level { 5 }
  
  sub default_prefix { '*' }
  
  sub default_prefix_re { qr/^\*/ }
  
  sub merge_SCALAR_SCALAR {
      my ($self, $key, $l, $r) = @_;
      ($key, $r);
  }
  
  sub merge_SCALAR_ARRAY {
      my ($self, $key, $l, $r) = @_;
      ($key, $r);
  }
  
  sub merge_SCALAR_HASH {
      my ($self, $key, $l, $r) = @_;
      ($key, $r);
  }
  
  sub merge_SCALAR_CODE {
      my ($self, $key, $l, $r) = @_;
      ($key, $r);
  }
  
  sub merge_ARRAY_SCALAR {
      my ($self, $key, $l, $r) = @_;
      ($key, $r);
  }
  
  sub merge_ARRAY_HASH {
      my ($self, $key, $l, $r) = @_;
      ($key, $r);
  }
  
  sub merge_ARRAY_CODE {
      my ($self, $key, $l, $r) = @_;
      ($key, $r);
  }
  
  sub merge_HASH_SCALAR {
      my ($self, $key, $l, $r) = @_;
      ($key, $r);
  }
  
  sub merge_HASH_ARRAY {
      my ($self, $key, $l, $r) = @_;
      ($key, $r);
  }
  
  sub merge_HASH_CODE {
      my ($self, $key, $l, $r) = @_;
      ($key, $r);
  }
  
  sub merge_CODE_SCALAR {
      my ($self, $key, $l, $r) = @_;
      ($key, $r);
  }
  
  sub merge_CODE_ARRAY {
      my ($self, $key, $l, $r) = @_;
      ($key, $r);
  }
  
  sub merge_CODE_HASH {
      my ($self, $key, $l, $r) = @_;
      ($key, $r);
  }
  
  sub merge_CODE_CODE {
      my ($self, $key, $l, $r) = @_;
      ($key, $r);
  }
  
  1;
  
  __END__
  
DATA_MODEMERGE_MODE_NORMAL

$fatpacked{"Data/ModeMerge/Mode/SUBTRACT.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'DATA_MODEMERGE_MODE_SUBTRACT';
  package Data::ModeMerge::Mode::SUBTRACT;
  
  our $DATE = '2015-02-21'; 
  our $VERSION = '0.32'; 
  
  use 5.010;
  use strict;
  use warnings;
  use Mo qw(build default);
  extends 'Data::ModeMerge::Mode::NORMAL';
  
  sub name { 'SUBTRACT' }
  
  sub precedence_level { 4 }
  
  sub default_prefix { '-' }
  
  sub default_prefix_re { qr/^-/ }
  
  sub merge_SCALAR_SCALAR {
      my ($self, $key, $l, $r) = @_;
      ($key, $l - $r);
  }
  
  sub merge_SCALAR_ARRAY {
      my ($self, $key, $l, $r) = @_;
      $self->merger->push_error("Can't subtract scalar and array");
      return;
  }
  
  sub merge_SCALAR_HASH {
      my ($self, $key, $l, $r) = @_;
      $self->merger->push_error("Can't subtract scalar and hash");
      return;
  }
  
  sub merge_ARRAY_SCALAR {
      my ($self, $key, $l, $r) = @_;
      $self->merger->push_error("Can't subtract array and scalar");
      return;
  }
  
  sub merge_ARRAY_ARRAY {
      my ($self, $key, $l, $r) = @_;
      my @res;
      my $mm = $self->merger;
      for (@$l) {
          push @res, $_ unless $mm->_in($_, $r);
      }
      ($key, \@res);
  }
  
  sub merge_ARRAY_HASH {
      my ($self, $key, $l, $r) = @_;
      $self->merger->push_error("Can't subtract array and hash");
      return;
  }
  
  sub merge_HASH_SCALAR {
      my ($self, $key, $l, $r) = @_;
      $self->merger->push_error("Can't subtract hash and scalar");
      return;
  }
  
  sub merge_HASH_ARRAY {
      my ($self, $key, $l, $r) = @_;
      $self->merger->push_error("Can't subtract hash and array");
      return;
  }
  
  sub merge_HASH_HASH {
      my ($self, $key, $l, $r) = @_;
      my $mm = $self->merger;
  
      my %res;
      my $r2 = {};
      for (keys %$r) {
          my $k = $mm->check_prefix($_) ? $_ : $mm->add_prefix($_, 'DELETE');
          if ($k ne $_ && exists($r->{$k})) {
              $mm->push_error("Conflict when adding DELETE prefix on right-side hash key $_ ".
                              "for SUBTRACT merge: key $k already exists");
              return;
          }
          $r2->{$k} = $r->{$_};
      }
      $mm->_merge($key, $l, $r2, 'NORMAL');
  }
  
  1;
  
  __END__
  
DATA_MODEMERGE_MODE_SUBTRACT

$fatpacked{"Data/Sah.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'DATA_SAH';
  package Data::Sah;
  
  our $DATE = '2015-07-01'; 
  our $VERSION = '0.68'; 
  
  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($_[0]);
  }
  
  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($_[0]);
  }
  
  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-07-01'; 
  our $VERSION = '0.68'; 
  
  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-07-01'; 
  our $VERSION = '0.68'; 
  
  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';
          $hargs{hash_values}          = $cd->{args}{human_hash_values};
          $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-07-01'; 
  our $VERSION = '0.68'; 
  
  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-07-01'; 
  our $VERSION = '0.68'; 
  
  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-07-01'; 
  our $VERSION = '0.68'; 
  
  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-07-01'; 
  our $VERSION = '0.68'; 
  
  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-07-01'; 
  our $VERSION = '0.68'; 
  
  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-07-01'; 
  our $VERSION = '0.68'; 
  
  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"),
  
          field          => $self->_xlt($cd, "field"),
          fields         => $self->_xlt($cd, "fields"),
  
          %{ $cd->{args}{hash_values} // {} },
      };
      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});
          $vals = [map {$self->literal($_)} @$vals];
      } 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:
      push @{$cd->{ccls}}, $ccl;
  
      $self->_add_msg_catalog($cd, $ccl);
  }
  
  sub add_ccl {
      my ($self, $cd, @ccls) = @_;
  
      my $op     = $cd->{cl_op} // '';
  
      my $ccl;
      if (@ccls == 1) {
          $self->_add_ccl($cd, $ccls[0]);
      } else {
          my $inner_cd = $self->init_cd(outer_cd => $cd);
          $inner_cd->{args} = $cd->{args};
          $inner_cd->{clause} = $cd->{clause};
          for (@ccls) {
              $self->_add_ccl($inner_cd, $_);
          }
  
          $ccl = {
              type  => 'list',
              vals  => [],
              items => $inner_cd->{ccls},
              multi => 0,
          };
          if ($op eq 'or') {
              $ccl->{fmt} = 'any of the following %(modal_verb)s be true';
          } elsif ($op eq 'and') {
              $ccl->{fmt} = 'all of the following %(modal_verb)s be true';
          } elsif ($op eq 'none') {
              $ccl->{fmt} = 'none of the following %(modal_verb)s be true';
          }
          $self->_add_ccl($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-07-01'; 
  our $VERSION = '0.68'; 
  
  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-07-01'; 
  our $VERSION = '0.68'; 
  
  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-07-01'; 
  our $VERSION = '0.68'; 
  
  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-07-01'; 
  our $VERSION = '0.68'; 
  
  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-07-01'; 
  our $VERSION = '0.68'; 
  
  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-07-01'; 
  our $VERSION = '0.68'; 
  
  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-07-01'; 
  our $VERSION = '0.68'; 
  
  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-07-01'; 
  our $VERSION = '0.68'; 
  
  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-07-01'; 
  our $VERSION = '0.68'; 
  
  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-07-01'; 
  our $VERSION = '0.68'; 
  
  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-07-01'; 
  our $VERSION = '0.68'; 
  
  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-07-01'; 
  our $VERSION = '0.68'; 
  
  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/duration.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'DATA_SAH_COMPILER_HUMAN_TH_DURATION';
  package Data::Sah::Compiler::human::TH::duration;
  
  our $DATE = '2015-07-01'; 
  our $VERSION = '0.68'; 
  
  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::duration';
  
  sub name { "duration" }
  
  sub handle_type {
      my ($self, $cd) = @_;
      my $c = $self->compiler;
  
      $c->add_ccl($cd, {type=>'noun', fmt => ["duration", "durations"]});
  }
  
  1;
  
  __END__
  
DATA_SAH_COMPILER_HUMAN_TH_DURATION

$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-07-01'; 
  our $VERSION = '0.68'; 
  
  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-07-01'; 
  our $VERSION = '0.68'; 
  
  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)s 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)s 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)s %(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 %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)s 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 %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 %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)s 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 %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)s matching regex pattern %s],
          expr  => 1,
      });
  }
  
  sub clause_choose_one_key {
      my ($self, $cd) = @_;
      my $c  = $self->compiler;
  
      my $multi = $cd->{cl_is_multi};
      $cd->{cl_is_multi} = 0;
  
      my @ccls;
      for my $cv ($multi ? @{ $cd->{cl_value} } : ($cd->{cl_value})) {
          push @ccls, {
              fmt   => q[%(modal_verb)s contain at most one of these %(fields)s %s],
              vals  => [$cv],
          };
      }
      $c->add_ccl($cd, @ccls);
  }
  
  sub clause_choose_all_keys {
      my ($self, $cd) = @_;
      my $c  = $self->compiler;
  
      my $multi = $cd->{cl_is_multi};
      $cd->{cl_is_multi} = 0;
  
      my @ccls;
      for my $cv ($multi ? @{ $cd->{cl_value} } : ($cd->{cl_value})) {
          push @ccls, {
              fmt   => q[%(modal_verb)s contain either none or all of these %(fields)s %s],
              vals  => [$cv],
          };
      }
      $c->add_ccl($cd, @ccls);
  }
  
  sub clause_req_one_key {
      my ($self, $cd) = @_;
      my $c  = $self->compiler;
  
      my $multi = $cd->{cl_is_multi};
      $cd->{cl_is_multi} = 0;
  
      my @ccls;
      for my $cv ($multi ? @{ $cd->{cl_value} } : ($cd->{cl_value})) {
          push @ccls, {
              fmt   => q[%(modal_verb)s contain exactly one of these %(fields)s %s],
              vals  => [$cv],
          };
      }
      $c->add_ccl($cd, @ccls);
  }
  
  sub clause_dep_any {
      my ($self, $cd) = @_;
      my $c  = $self->compiler;
  
      my $multi = $cd->{cl_is_multi};
      $cd->{cl_is_multi} = 0;
  
      my @ccls;
      for my $cv ($multi ? @{ $cd->{cl_value} } : ($cd->{cl_value})) {
          if (@{ $cv->[1] } == 1) {
              push @ccls, {
                  fmt   => q[%(field)s %2$s %(modal_verb)s be present before %(field)s %1$s can be present],
                  vals  => [$cv->[0], $cv->[1][0]],
              };
          } else {
              push @ccls, {
                  fmt   => q[one of %(fields)s %2$s %(modal_verb)s be present before %(field)s %1$s can be present],
                  vals  => $cv,
                  multi => 0,
              };
          }
      }
      $c->add_ccl($cd, @ccls);
  }
  
  sub clause_dep_all {
      my ($self, $cd) = @_;
      my $c  = $self->compiler;
  
      my $multi = $cd->{cl_is_multi};
      $cd->{cl_is_multi} = 0;
  
      my @ccls;
      for my $cv ($multi ? @{ $cd->{cl_value} } : ($cd->{cl_value})) {
          if (@{ $cv->[1] } == 1) {
              push @ccls, {
                  fmt   => q[%(field)s %2$s %(modal_verb)s be present before %(field)s %1$s can be present],
                  vals  => [$cv->[0], $cv->[1][0]],
              };
          } else {
              push @ccls, {
                  fmt   => q[all of %(fields)s %2$s %(modal_verb)s be present before %(field)s %1$s can be present],
                  vals  => $cv,
              };
          }
      }
      $c->add_ccl($cd, @ccls);
  }
  
  sub clause_req_dep_any {
      my ($self, $cd) = @_;
      my $c  = $self->compiler;
  
      my $multi = $cd->{cl_is_multi};
      $cd->{cl_is_multi} = 0;
  
      my @ccls;
      for my $cv ($multi ? @{ $cd->{cl_value} } : ($cd->{cl_value})) {
          if (@{ $cv->[1] } == 1) {
              push @ccls, {
                  fmt   => q[%(field)s %1$s %(modal_verb)s be present when %(field)s %2$s is present],
                  vals  => [$cv->[0], $cv->[1][0]],
              };
          } else {
              push @ccls, {
                  fmt   => q[%(field)s %1$s %(modal_verb)s be present when one of %(fields)s %2$s is present],
                  vals  => $cv,
              };
          }
      }
      $c->add_ccl($cd, @ccls);
  }
  
  sub clause_req_dep_all {
      my ($self, $cd) = @_;
      my $c  = $self->compiler;
  
      my $multi = $cd->{cl_is_multi};
      $cd->{cl_is_multi} = 0;
  
      my @ccls;
      for my $cv ($multi ? @{ $cd->{cl_value} } : ($cd->{cl_value})) {
          if (@{ $cv->[1] } == 1) {
              push @ccls, {
                  fmt   => q[%(field)s %1$s %(modal_verb)s be present when %(field)s %2$s is present],
                  vals  => [$cv->[0], $cv->[1][0]],
              };
          } else {
              push @ccls, {
                  fmt   => q[%(field)s %1$s %(modal_verb)s be present when all of %(fields)s %2$s are present],
                  vals  => $cv,
              };
          }
      }
      $c->add_ccl($cd, @ccls);
  }
  
  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-07-01'; 
  our $VERSION = '0.68'; 
  
  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],
              });
              return;
          } elsif ($cv->[0] == 2 && $cv->[1] == 1) {
              $c->add_ccl($cd, {
                  fmt   => q[%(modal_verb)s be odd],
              });
              return;
          }
      }
  
      my @ccls;
      for my $cv ($cd->{cl_is_multi} ? @{ $cd->{cl_value} } : ($cd->{cl_value})) {
          push @ccls, {
              fmt  => q[%(modal_verb)s leave a remainder of %2$s when divided by %1$s],
              vals => $cv,
          };
      }
      $c->add_ccl($cd, @ccls);
  }
  
  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-07-01'; 
  our $VERSION = '0.68'; 
  
  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-07-01'; 
  our $VERSION = '0.68'; 
  
  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-07-01'; 
  our $VERSION = '0.68'; 
  
  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-07-01'; 
  our $VERSION = '0.68'; 
  
  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-07-01'; 
  our $VERSION = '0.68'; 
  
  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-07-01'; 
  our $VERSION = '0.68'; 
  
  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-07-01'; 
  our $VERSION = '0.68'; 
  
  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-07-01'; 
  our $VERSION = '0.68'; 
  
  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-07-01'; 
  our $VERSION = '0.68'; 
  
  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-07-01'; 
  our $VERSION = '0.68'; 
  
  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-07-01'; 
  our $VERSION = '0.68'; 
  
  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-07-01'; 
  our $VERSION = '0.68'; 
  
  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-07-01'; 
  our $VERSION = '0.68'; 
  
  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-07-01'; 
  our $VERSION = '0.68'; 
  
  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-07-01'; 
  our $VERSION = '0.68'; 
  
  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-07-01'; 
  our $VERSION = '0.68'; 
  
  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-07-01'; 
  our $VERSION = '0.68'; 
  
  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(', ')",
              ')',
          ),
        }
      );
  }
  
  sub clause_choose_one_key {
      my ($self, $cd) = @_;
      my $c  = $self->compiler;
      my $ct = $cd->{cl_term};
      my $dt = $cd->{data_term};
  
      $c->add_ccl(
          $cd,
          join(
              "",
              "($ct).map(function(x) {",
              "  return ($dt).hasOwnProperty(x) ? 1:0",
              "}).reduce(function(a,b){ return a+b }) <= 1",
          ),
          {},
      );
  }
  
  sub clause_choose_all_keys {
      my ($self, $cd) = @_;
      my $c  = $self->compiler;
      my $ct = $cd->{cl_term};
      my $dt = $cd->{data_term};
  
      $c->add_ccl(
          $cd,
          join(
              "",
              "[0, ($ct).length].indexOf(",
              "  ($ct).map(function(x) {",
              "    return ($dt).hasOwnProperty(x) ? 1:0",
              "  }).reduce(function(a,b){ return a+b })",
              ") >= 0",
          ),
          {},
      );
  }
  
  sub clause_req_one_key {
      my ($self, $cd) = @_;
      my $c  = $self->compiler;
      my $ct = $cd->{cl_term};
      my $dt = $cd->{data_term};
  
      $c->add_ccl(
          $cd,
          join(
              "",
              "($ct).map(function(x) {",
              "  return ($dt).hasOwnProperty(x) ? 1:0",
              "}).reduce(function(a,b){ return a+b }) == 1",
          ),
          {},
      );
  }
  
  sub clause_dep_any {
      my ($self, $cd) = @_;
      my $c  = $self->compiler;
      my $ct = $cd->{cl_term};
      my $dt = $cd->{data_term};
  
      $c->add_ccl(
          $cd,
          join(
              "",
              "(function(_sahv_ct, _sahv_has_prereq, _sahv_has_dep) {", 
              "  _sahv_ct = $ct; ",
              "  _sahv_has_prereq = (_sahv_ct[1]).map(function(x) {",
              "    return ($dt).hasOwnProperty(x) ? 1:0",
              "  }).reduce(function(a,b){ return a+b }) > 0; ",
              "  _sahv_has_dep    = (_sahv_ct[0].constructor===Array ? _sahv_ct[0] : [_sahv_ct[0]]).map(function(x) {",
              "    return ($dt).hasOwnProperty(x) ? 1:0",
              "  }).reduce(function(a,b){ return a+b }) > 0; ",
              "  return !_sahv_has_dep || _sahv_has_prereq",
              "})()",
          ),
          {},
      );
  }
  
  sub clause_dep_all {
      my ($self, $cd) = @_;
      my $c  = $self->compiler;
      my $ct = $cd->{cl_term};
      my $dt = $cd->{data_term};
  
      $c->add_ccl(
          $cd,
          join(
              "",
              "(function(_sahv_ct, _sahv_has_prereq, _sahv_has_dep) {", 
              "  _sahv_ct = $ct; ",
              "  _sahv_has_prereq = (_sahv_ct[1]).map(function(x) {",
              "    return ($dt).hasOwnProperty(x) ? 1:0",
              "  }).reduce(function(a,b){ return a+b }) == _sahv_ct[1].length; ",
              "  _sahv_has_dep    = (_sahv_ct[0].constructor===Array ? _sahv_ct[0] : [_sahv_ct[0]]).map(function(x) {",
              "    return ($dt).hasOwnProperty(x) ? 1:0",
              "  }).reduce(function(a,b){ return a+b }) > 0; ",
              "  return !_sahv_has_dep || _sahv_has_prereq",
              "})()",
          ),
          {},
      );
  }
  
  sub clause_req_dep_any {
      my ($self, $cd) = @_;
      my $c  = $self->compiler;
      my $ct = $cd->{cl_term};
      my $dt = $cd->{data_term};
  
      $c->add_ccl(
          $cd,
          join(
              "",
              "(function(_sahv_ct, _sahv_has_prereq, _sahv_has_dep) {", 
              "  _sahv_ct = $ct; ",
              "  _sahv_has_prereq = (_sahv_ct[1]).map(function(x) {",
              "    return ($dt).hasOwnProperty(x) ? 1:0",
              "  }).reduce(function(a,b){ return a+b }) > 0; ",
              "  _sahv_has_dep    = (_sahv_ct[0].constructor===Array ? _sahv_ct[0] : [_sahv_ct[0]]).map(function(x) {",
              "    return ($dt).hasOwnProperty(x) ? 1:0",
              "  }).reduce(function(a,b){ return a+b }) > 0; ",
              "  return _sahv_has_dep || !_sahv_has_prereq",
              "})()",
          ),
          {},
      );
  }
  
  sub clause_req_dep_all {
      my ($self, $cd) = @_;
      my $c  = $self->compiler;
      my $ct = $cd->{cl_term};
      my $dt = $cd->{data_term};
  
      $c->add_ccl(
          $cd,
          join(
              "",
              "(function(_sahv_ct, _sahv_has_prereq, _sahv_has_dep) {", 
              "  _sahv_ct = $ct; ",
              "  _sahv_has_prereq = (_sahv_ct[1]).map(function(x) {",
              "    return ($dt).hasOwnProperty(x) ? 1:0",
              "  }).reduce(function(a,b){ return a+b }) == _sahv_ct[1].length; ",
              "  _sahv_has_dep    = (_sahv_ct[0].constructor===Array ? _sahv_ct[0] : [_sahv_ct[0]]).map(function(x) {",
              "    return ($dt).hasOwnProperty(x) ? 1:0",
              "  }).reduce(function(a,b){ return a+b }) > 0; ",
              "  return _sahv_has_dep || !_sahv_has_prereq",
              "})()",
          ),
          {},
      );
  }
  
  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-07-01'; 
  our $VERSION = '0.68'; 
  
  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-07-01'; 
  our $VERSION = '0.68'; 
  
  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-07-01'; 
  our $VERSION = '0.68'; 
  
  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-07-01'; 
  our $VERSION = '0.68'; 
  
  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-07-01'; 
  our $VERSION = '0.68'; 
  
  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-07-01'; 
  our $VERSION = '0.68'; 
  
  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-07-01'; 
  our $VERSION = '0.68'; 
  
  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';
  
  our $PP;
  our $CORE;
  our $CORE_OR_PP;
  our $NO_MODULES;
  
  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} //= $PP // $ENV{DATA_SAH_PP} // 0;
      $args{core} //= $CORE // $ENV{DATA_SAH_CORE} // 0;
      $args{core_or_pp} //= $CORE_OR_PP // $ENV{DATA_SAH_CORE_OR_PP} // 0;
      $args{no_modules} //= $NO_MODULES // $ENV{DATA_SAH_NO_MODULES} // 0;
  
      $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'"]) unless $cd->{args}{no_modules};
  
      $cd;
  }
  
  sub true { "1" }
  
  sub false { "''" }
  
  sub add_module {
      my ($self, $cd, $name) = @_;
      $self->SUPER::add_module($cd, $name);
  
      if ($cd->{args}{no_modules}) {
          die "BUG: Use of module '$name' when compile option no_modules=1";
      }
  
      if ($cd->{args}{pp}) {
          if ($name =~ /\A(DateTime|List::Util|Scalar::Util|Scalar::Util::Numeric|Storable|Time::Moment|Time::Piece)\z/) {
              die "Use of XS module '$name' when compile option pp=1";
          } elsif ($name =~ /\A(experimental|warnings|DateTime::Duration|Scalar::Util::Numeric::PP)\z/) {
          } else {
              die "BUG: Haven't noted about Perl module '$name' as being pp/xs";
          }
      }
  
      if ($cd->{args}{core}) {
          if ($name =~ /\A(experimental|DateTime|DateTime::Duration|Scalar::Util::Numeric|Scalar::Util::Numeric::PP|Time::Moment)\z/) {
              die "Use of non-core module '$name' when compile option core=1";
          } elsif ($name =~ /\A(warnings|List::Util|Scalar::Util|Storable|Time::Piece)\z/) {
          } else {
              die "BUG: Haven't noted about Perl module '$name' as being core/non-core";
          }
      }
  
      if ($cd->{args}{core_or_pp}) {
          if ($name =~ /\A(DateTime|Scalar::Util::Numeric|Time::Moment)\z/) {
              die "Use of non-core XS module '$name' when compile option core_or_pp=1";
          } elsif ($name =~ /\A(experimental|warnings|DateTime::Duration|List::Util|Scalar::Util|Scalar::Util::Numeric::PP|Storable|Time::Piece)\z/) {
          } else {
              die "BUG: Haven't noted about Perl module '$name' as being core_or_pp/not";
          }
      }
  }
  
  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->{args}{core_or_pp} ||
              !eval { require Scalar::Util::Numeric; 1 }) {
          $cd->{_sun_module} = 'Scalar::Util::Numeric::PP';
      } elsif ($cd->{args}{core}) {
          $cd->{_sun_module} = 'Foo';
      } 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-07-01'; 
  our $VERSION = '0.68'; 
  
  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-07-01'; 
  our $VERSION = '0.68'; 
  
  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-07-01'; 
  our $VERSION = '0.68'; 
  
  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-07-01'; 
  our $VERSION = '0.68'; 
  
  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-07-01'; 
  our $VERSION = '0.68'; 
  
  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-07-01'; 
  our $VERSION = '0.68'; 
  
  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-07-01'; 
  our $VERSION = '0.68'; 
  
  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-07-01'; 
  our $VERSION = '0.68'; 
  
  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-07-01'; 
  our $VERSION = '0.68'; 
  
  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/duration.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'DATA_SAH_COMPILER_PERL_TH_DURATION';
  package Data::Sah::Compiler::perl::TH::duration;
  
  our $DATE = '2015-07-01'; 
  our $VERSION = '0.68'; 
  
  use 5.010;
  use strict;
  use warnings;
  
  use Mo qw(build default);
  use Role::Tiny::With;
  use Scalar::Util qw(blessed);
  
  extends 'Data::Sah::Compiler::perl::TH';
  with 'Data::Sah::Type::duration';
  
  sub expr_coerce_term {
      my ($self, $cd, $t) = @_;
  
      my $c = $self->compiler;
      $c->add_module($cd, 'DateTime::Duration');
      $c->add_module($cd, 'Scalar::Util');
  
      join(
          '',
          "(",
          "(Scalar::Util::blessed($t) && $t->isa('DateTime::Duration')) ? $t : ",
          "$t =~ /\\AP(?:([0-9]+(?:\\.[0-9]+)?)Y)? (?:([0-9]+(?:\\.[0-9]+)?)M)? (?:([0-9]+(?:\\.[0-9]+)?)W)? (?:([0-9]+(?:\\.[0-9]+)?)D)? (?: T (?:([0-9]+(?:\\.[0-9]+)?)H)? (?:([0-9]+(?:\\.[0-9]+)?)M)? (?:([0-9]+(?:\\.[0-9]+)?)S)? )?\\z/x ? DateTime::Duration->new(years=>\$1||0, months=>\$2||0, weeks=>\$3||0, days=>\$4||0, hours=>\$5||0, minutes=>\$6||0, seconds=>\$7||0) : die(\"BUG: can't coerce duration\")",
          ")",
      );
  }
  
  sub expr_coerce_value {
      my ($self, $cd, $v) = @_;
  
      my $c = $self->compiler;
      $c->add_module($cd, 'DateTime::Duration');
  
      if (blessed($v) && $v->isa('DateTime::Duration')) {
          return join(
              '',
              "DateTime::Duration->new(",
              "years=>",   $v->years,   ",",
              "months=>",  $v->months,  ",",
              "weeks=>",   $v->weeks,   ",",
              "days=>",    $v->days,    ",",
              "hours=>",   $v->hours,   ",",
              "minutes=>", $v->minutes, ",",
              "seconds=>", $v->seconds, ",",
              ")",
          );
      } elsif ($v =~ /\AP
                      (?:([0-9]+(?:\.[0-9]+)?)Y)?
                      (?:([0-9]+(?:\.[0-9]+)?)M)?
                      (?:([0-9]+(?:\.[0-9]+)?)W)?
                      (?:([0-9]+(?:\.[0-9]+)?)D)?
                      (?: T
                          (?:([0-9]+(?:\.[0-9]+)?)H)?
                          (?:([0-9]+(?:\.[0-9]+)?)M)?
                          (?:([0-9]+(?:\.[0-9]+)?)S)?
                      )?\z/x) {
          require DateTime::Duration;
          return "DateTime::Duration->new(years=>".($1||0).", months=>".($2||0).", weeks=>".($3||0).", days=>".($4||0).", hours=>".($5||0).", minutes=>".($6||0).", seconds=>".($7||0).")";
      } else {
          die "Invalid duration 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::Duration'))",
          " || ",
          "($dt =~ /\\AP(?:([0-9]+(?:\\.[0-9]+)?)Y)? (?:([0-9]+(?:\\.[0-9]+)?)M)? (?:([0-9]+(?:\\.[0-9]+)?)W)? (?:([0-9]+(?:\\.[0-9]+)?)D)? (?: T (?:([0-9]+(?:\\.[0-9]+)?)H)? (?:([0-9]+(?:\\.[0-9]+)?)M)? (?:([0-9]+(?:\\.[0-9]+)?)S)? )?\\z/x)", 
          ")",
      );
  }
  
  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);
  }
  
  1;
  
  __END__
  
DATA_SAH_COMPILER_PERL_TH_DURATION

$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-07-01'; 
  our $VERSION = '0.68'; 
  
  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};
      if ($cd->{args}{core} || $cd->{args}{no_modules}) {
          $cd->{_ccl_check_type} = "$dt =~ ".'/\A(?:[+-]?(?:0|[1-9][0-9]*)(\.[0-9]+)?([eE][+-]?[0-9]+)?|((?i)\s*nan\s*)|((?i)\s*[+-]?inf(inity)?)\s*)\z/';
      } else {
          $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}) {
          if ($cd->{args}{core} || $cd->{args}{no_modules}) {
              $c->add_ccl(
                  $cd,
                  qq[$ct ? lc($dt+0) eq "nan" : defined($ct) ? lc($dt+0) ne "nan" : 1],
              );
          } else {
              $c->add_ccl(
                  $cd,
                  join(
                      "",
                      "$ct ? $cd->{_sun_module}::isnan($dt) : ",
                      "defined($ct) ? !$cd->{_sun_module}::isnan($dt) : 1",
                  )
              );
          }
      } else {
          if ($cd->{cl_value}) {
              if ($cd->{args}{core} || $cd->{args}{no_modules}) {
                  $c->add_ccl($cd, qq[lc($dt+0) eq "nan"]);
              } else {
                  $c->add_ccl($cd, "$cd->{_sun_module}::isnan($dt)");
              }
          } elsif (defined $cd->{cl_value}) {
              if ($cd->{args}{core} || $cd->{args}{no_modules}) {
                  $c->add_ccl($cd, qq[lc($dt+0) ne "nan"]);
              } else {
                  $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}) {
          if ($cd->{args}{core} || $cd->{args}{no_modules}) {
              $c->add_ccl(
                  $cd, join(
                      '',
                      qq[$ct ? $dt =~ /\\A\\s*-inf(inity)?\\s*\\z/i : ],
                      qq[defined($ct) ? $dt !~ /\\A\\s*inf(inity)?\\s*\\z/i : 1]
                  ));
          } else {
              $c->add_ccl(
                  $cd, join(
                      '',
                      "$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}) {
              if ($cd->{args}{core} || $cd->{args}{no_modules}) {
                  $c->add_ccl($cd, qq[$dt =~ /\\A\\s*-inf(inity)?\\s*\\z/i]);
              } else {
                  $c->add_ccl($cd, "$cd->{_sun_module}::isinf($dt) && $cd->{_sun_module}::isneg($dt)");
              }
          } elsif (defined $cd->{cl_value}) {
              if ($cd->{args}{core} || $cd->{args}{no_modules}) {
                  $c->add_ccl($cd, qq[$dt !~ /\\A\\s*-inf(inity)?\\s*\\z/i]);
              } else {
                  $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}) {
          if ($cd->{args}{core} || $cd->{args}{no_modules}) {
              $c->add_ccl(
                  $cd, join(
                      '',
                      qq[$ct ? $dt =~ /\\A\\s*inf(inity)?\\s*\\z/i : ],
                      qq[defined($ct) ? $dt !~ /\\A\\s*inf(inity)?\\s*\\z/i : 1]
                  ));
          } else {
              $c->add_ccl(
                  $cd, join(
                      '',
                      "$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}) {
              if ($cd->{args}{core} || $cd->{args}{no_modules}) {
                  $c->add_ccl($cd, qq[$dt =~ /\\A\\s*inf(inity)?\\s*\\z/i]);
              } else {
                  $c->add_ccl($cd, "$cd->{_sun_module}::isinf($dt) && !$cd->{_sun_module}::isneg($dt)");
              }
          } elsif (defined $cd->{cl_value}) {
              if ($cd->{args}{core} || $cd->{args}{no_modules}) {
                  $c->add_ccl($cd, qq[$dt !~ /\\A\\s*inf(inity)?\\s*\\z/i]);
              } else {
                  $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}) {
          if ($cd->{args}{core} || $cd->{args}{no_modules}) {
              $c->add_ccl(
                  $cd, join(
                      '',
                      qq[$ct ? $dt =~ /\\A\\s*-?inf(inity)?\\s*\\z/i : ],
                      qq[defined($ct) ? $dt+0 !~ /\\A-?inf\\z/ : 1]
                  ));
          } else {
              $c->add_ccl($cd, "$ct ? $cd->{_sun_module}::isinf($dt) : ".
                              "defined($ct) ? $cd->{_sun_module}::isinf($dt) : 1");
          }
      } else {
          if ($cd->{cl_value}) {
              if ($cd->{args}{core} || $cd->{args}{no_modules}) {
                  $c->add_ccl($cd, qq[$dt =~ /\\A\\s*-?inf(inity)?\\s*\\z/i]);
              } else {
                  $c->add_ccl($cd, "$cd->{_sun_module}::isinf($dt)");
              }
          } elsif (defined $cd->{cl_value}) {
              if ($cd->{args}{core} || $cd->{args}{no_modules}) {
                  $c->add_ccl($cd, qq[$dt !~ /\\A\\s*-?inf(inity)?\\s*\\z/i]);
              } else {
                  $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-07-01'; 
  our $VERSION = '0.68'; 
  
  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 \$_sahv_h = $dt; !defined(List::Util::first(sub {!exists(\$_sahv_h\->{\$_})}, \@{ $ct })) }",
        {
          err_msg => 'TMP',
          err_expr =>
            "sprintf(".
            $c->literal($c->_xlt($cd, "hash has missing required field(s) (%s)")).
            ",join(', ', do { my \$_sahv_h = $dt; grep { !exists(\$_sahv_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 }))"
        }
      );
  }
  
  sub clause_choose_one_key {
      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 \$_sahv_h = $dt; List::Util::sum(map {exists(\$_sahv_h\->{\$_}) ? 1:0} \@{ $ct }) <= 1 }",
        {},
      );
  }
  
  sub clause_choose_all_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 \$_sahv_h = $dt; my \$_sahv_keys = $ct; my \$_sahv_tot = List::Util::sum(map {exists(\$_sahv_h\->{\$_}) ? 1:0} \@\$_sahv_keys); \$_sahv_tot==0 || \$_sahv_tot==\@\$_sahv_keys }",
        {},
      );
  }
  
  sub clause_req_one_key {
      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 \$_sahv_h = $dt; List::Util::sum(map {exists(\$_sahv_h\->{\$_}) ? 1:0} \@{ $ct }) == 1 }",
        {},
      );
  }
  
  sub clause_dep_any {
      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 \$_sahv_h = $dt; my \$_sahv_ct = $ct; ".
            "my \$_sahv_has_prereq = List::Util::sum(map {exists(\$_sahv_h\->{\$_}) ? 1:0} \@{ \$_sahv_ct->[1] }) ? 1:0; ".
            "my \$_sahv_has_dep    = List::Util::sum(map {exists(\$_sahv_h\->{\$_}) ? 1:0} (ref(\$_sahv_ct->[0]) eq 'ARRAY' ? \@{ \$_sahv_ct->[0] } : (\$_sahv_ct->[0]))) ? 1:0; ".
            "!\$_sahv_has_dep || \$_sahv_has_prereq }",
        {},
      );
  }
  
  sub clause_dep_all {
      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 \$_sahv_h = $dt; my \$_sahv_ct = $ct; ".
            "my \$_sahv_has_prereq = List::Util::sum(map {exists(\$_sahv_h\->{\$_}) ? 1:0} \@{ \$_sahv_ct->[1] }) == \@{ \$_sahv_ct->[1] } ? 1:0; ".
            "my \$_sahv_has_dep    = List::Util::sum(map {exists(\$_sahv_h\->{\$_}) ? 1:0} (ref(\$_sahv_ct->[0]) eq 'ARRAY' ? \@{ \$_sahv_ct->[0] } : (\$_sahv_ct->[0]))) ? 1:0; ".
            "!\$_sahv_has_dep || \$_sahv_has_prereq }",
        {},
      );
  }
  
  sub clause_req_dep_any {
      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 \$_sahv_h = $dt; my \$_sahv_ct = $ct; ".
            "my \$_sahv_has_prereq = List::Util::sum(map {exists(\$_sahv_h\->{\$_}) ? 1:0} \@{ \$_sahv_ct->[1] }) ? 1:0; ".
            "my \$_sahv_has_dep    = List::Util::sum(map {exists(\$_sahv_h\->{\$_}) ? 1:0} (ref(\$_sahv_ct->[0]) eq 'ARRAY' ? \@{ \$_sahv_ct->[0] } : (\$_sahv_ct->[0]))) ? 1:0; ".
            "\$_sahv_has_dep || !\$_sahv_has_prereq }",
        {},
      );
  }
  
  sub clause_req_dep_all {
      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 \$_sahv_h = $dt; my \$_sahv_ct = $ct; ".
            "my \$_sahv_has_prereq = List::Util::sum(map {exists(\$_sahv_h\->{\$_}) ? 1:0} \@{ \$_sahv_ct->[1] }) == \@{ \$_sahv_ct->[1] } ? 1:0; ".
            "my \$_sahv_has_dep    = List::Util::sum(map {exists(\$_sahv_h\->{\$_}) ? 1:0} (ref(\$_sahv_ct->[0]) eq 'ARRAY' ? \@{ \$_sahv_ct->[0] } : (\$_sahv_ct->[0]))) ? 1:0; ".
            "\$_sahv_has_dep || !\$_sahv_has_prereq }",
        {},
      );
  }
  
  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-07-01'; 
  our $VERSION = '0.68'; 
  
  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};
      if ($cd->{args}{core} || $cd->{args}{no_modules}) {
          $cd->{_ccl_check_type} = "$dt =~ ".'/\A[+-]?(?:0|[1-9][0-9]*)\z/';
      } else {
          $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-07-01'; 
  our $VERSION = '0.68'; 
  
  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};
  
      if ($cd->{args}{core} || $cd->{args}{no_modules}) {
          $cd->{_ccl_check_type} = "$dt =~ ".'/\A(?:[+-]?(?:0|[1-9][0-9]*)(\.[0-9]+)?([eE][+-]?[0-9]+)?|((?i)\s*nan\s*)|((?i)\s*[+-]?inf(inity)?)\s*)\z/';
      } else {
          $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-07-01'; 
  our $VERSION = '0.68'; 
  
  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-07-01'; 
  our $VERSION = '0.68'; 
  
  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-07-01'; 
  our $VERSION = '0.68'; 
  
  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-07-01'; 
  our $VERSION = '0.68'; 
  
  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-07-01'; 
  our $VERSION = '0.68'; 
  
  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-07-01'; 
  our $VERSION = '0.68'; 
  
  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-07-01'; 
  our $VERSION = '0.68'; 
  
  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-07-01'; 
  our $VERSION = '0.68'; 
  
  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[field],
      q[champ],
  
      q[fields],
      q[champs],
  
      q[argument],
      q[argument],
  
      q[arguments],
      q[arguments],
  
  
      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-07-01'; 
  our $VERSION = '0.68'; 
  
  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[field],
      q[field],
  
      q[fields],
      q[field],
  
      q[argument],
      q[argumen],
  
      q[arguments],
      q[argumen],
  
  
      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-07-01'; 
  our $VERSION = '0.68'; 
  
  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[field],
      q[å­æ®µ],
  
      q[fields],
      q[å­æ®µ],
  
      q[argument],
      q[åæ°],
  
      q[arguments],
      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 = '2015-04-24'; 
  our $VERSION = '0.03'; 
  
  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 = shift;
  
      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-07-01'; 
  our $VERSION = '0.68'; 
  
  
  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-07-01'; 
  our $VERSION = '0.68'; 
  
  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-07-01'; 
  our $VERSION = '0.68'; 
  
  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-07-01'; 
  our $VERSION = '0.68'; 
  
  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-07-01'; 
  our $VERSION = '0.68'; 
  
  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-07-01'; 
  our $VERSION = '0.68'; 
  
  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-07-01'; 
  our $VERSION = '0.68'; 
  
  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-07-01'; 
  our $VERSION = '0.68'; 
  
  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-07-01'; 
  our $VERSION = '0.68'; 
  
  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-07-01'; 
  our $VERSION = '0.68'; 
  
  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-07-01'; 
  our $VERSION = '0.68'; 
  
  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-07-01'; 
  our $VERSION = '0.68'; 
  
  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/duration.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'DATA_SAH_TYPE_DURATION';
  package Data::Sah::Type::duration;
  
  our $DATE = '2015-07-01'; 
  our $VERSION = '0.68'; 
  
  use Data::Sah::Util::Role 'has_clause';
  use Role::Tiny;
  use Role::Tiny::With;
  
  with 'Data::Sah::Type::BaseType';
  
  
  1;
  
  __END__
  
DATA_SAH_TYPE_DURATION

$fatpacked{"Data/Sah/Type/float.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'DATA_SAH_TYPE_FLOAT';
  package Data::Sah::Type::float;
  
  our $DATE = '2015-07-01'; 
  our $VERSION = '0.68'; 
  
  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-07-01'; 
  our $VERSION = '0.68'; 
  
  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';
  
  has_clause "choose_one_key",
      prio       => 50,
      tags       => ['constraint'],
      arg        => ['array*', {of=>'str*', min_len=>1}],
      allow_expr => 0, 
      ;
  has_clause_alias choose_one_key => 'choose_one';
  has_clause "choose_all_keys",
      prio       => 50,
      tags       => ['constraint'],
      arg        => ['array*', {of=>'str*', min_len=>1}],
      allow_expr => 0, 
      ;
  has_clause_alias choose_all_keys => 'choose_all';
  has_clause "req_one_key",
      prio       => 50,
      tags       => ['constraint'],
      arg        => ['array*', {of=>'str*', min_len=>1}],
      allow_expr => 0, 
      ;
  has_clause_alias req_one_key => 'req_one';
  has_clause_alias req_keys => 'req_all_keys';
  has_clause_alias req_keys => 'req_all';
  
  my $dep_arg = ['array*', {elems=>[ 'str*', ['array*',of=>'str*'] ]}];
  
  has_clause "dep_any",
      prio       => 50,
      tags       => ['constraint'],
      arg        => $dep_arg,
      allow_expr => 0, 
      ;
  has_clause "dep_all",
      prio       => 50,
      tags       => ['constraint'],
      arg        => $dep_arg,
      allow_expr => 0, 
      ;
  has_clause "req_dep_any",
      prio       => 50,
      tags       => ['constraint'],
      arg        => $dep_arg,
      allow_expr => 0, 
      ;
  has_clause "req_dep_all",
      prio       => 50,
      tags       => ['constraint'],
      arg        => $dep_arg,
      allow_expr => 0, 
      ;
  
  
  
  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-07-01'; 
  our $VERSION = '0.68'; 
  
  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-07-01'; 
  our $VERSION = '0.68'; 
  
  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-07-01'; 
  our $VERSION = '0.68'; 
  
  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-07-01'; 
  our $VERSION = '0.68'; 
  
  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-07-01'; 
  our $VERSION = '0.68'; 
  
  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-07-01'; 
  our $VERSION = '0.68'; 
  
  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-07-01'; 
  our $VERSION = '0.68'; 
  
  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-07-01'; 
  our $VERSION = '0.68'; 
  
  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-07-01'; 
  our $VERSION = '0.68'; 
  
  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
                         coerce_duration
                 );
  
  our $DATE_MODULE = $ENV{DATA_SAH_DATE_MODULE} // $ENV{PERL_DATE_MODULE} //
      "DateTime"; 
  
  my $re_ymd = qr/\A([0-9]{4})-([0-9]{2})-([0-9]{2})\z/;
  my $re_ymdThmsZ = qr/\A([0-9]{4})-([0-9]{2})-([0-9]{2})T([0-9]{2}):([0-9]{2}):([0-9]{2})Z\z/;
  
  sub coerce_date {
      my $val = shift;
      if (!defined($val)) {
          return undef;
      }
  
      if ($DATE_MODULE eq 'DateTime') {
          require DateTime;
          if (blessed($val) && $val->isa('DateTime')) {
              return $val;
          } elsif (looks_like_number($val) && $val >= 10**8 && $val <= 2**31) {
              return DateTime->from_epoch(epoch => $val);
          } elsif ($val =~ $re_ymd) {
              my $d;
              eval { $d = DateTime->new(year=>$1, month=>$2, day=>$3) };
              return undef if $@;
              return $d;
          } elsif ($val =~ $re_ymdThmsZ) {
              my $d;
              eval { $d = DateTime->new(year=>$1, month=>$2, day=>$3, hour=>$4, minute=>$5, second=>$6, time_zone=>'UTC') };
              return undef if $@;
              return $d;
          } elsif (blessed($val) && $val->isa('Time::Moment')) {
              return DateTime->from_epoch(epoch => $val->epoch);
          } elsif (blessed($val) && $val->isa('Time::Piece')) {
              return DateTime->from_epoch(epoch => $val->epoch);
          } else {
              return undef;
          }
      } elsif ($DATE_MODULE eq 'Time::Moment') {
          require Time::Moment;
          if (blessed($val) && $val->isa('Time::Moment')) {
              return $val;
          } elsif (looks_like_number($val) && $val >= 10**8 && $val <= 2**31) {
              return Time::Moment->from_epoch(int($val), $val-int($val));
          } elsif ($val =~ $re_ymd) {
              my $d;
              eval { $d = Time::Moment->new(year=>$1, month=>$2, day=>$3) };
              return undef if $@;
              return $d;
          } elsif ($val =~ $re_ymdThmsZ) {
              my $d;
              eval { $d = Time::Moment->new(year=>$1, month=>$2, day=>$3, hour=>$4, minute=>$5, second=>$6) };
              return undef if $@;
              return $d;
          } elsif (blessed($val) && $val->isa('DateTime')) {
              return Time::Moment->from_epoch($val->epoch);
          } elsif (blessed($val) && $val->isa('Time::Piece')) {
              return Time::Moment->from_epoch($val->epoch);
          } else {
              return undef;
          }
      } elsif ($DATE_MODULE eq 'Time::Piece') {
          require Time::Piece;
          if (blessed($val) && $val->isa('Time::Piece')) {
              return $val;
          } elsif (looks_like_number($val) && $val >= 10**8 && $val <= 2**31) {
              return scalar Time::Piece->gmtime($val);
          } elsif ($val =~ $re_ymd) {
              my $d;
              eval { $d = Time::Piece->strptime($val, "%Y-%m-%d") };
              return undef if $@;
              return $d;
          } elsif ($val =~ $re_ymdThmsZ) {
              my $d;
              eval { $d = Time::Piece->strptime($val, "%Y-%m-%dT%H:%M:%SZ") };
              return undef if $@;
              return $d;
          } elsif (blessed($val) && $val->isa('DateTime')) {
              return scalar Time::Piece->gmtime(epoch => $val->epoch);
          } elsif (blessed($val) && $val->isa('Time::Moment')) {
              return scalar Time::Piece->gmtime(epoch => $val->epoch);
          } else {
              return undef;
          }
      } else {
          die "BUG: Unknown Perl date module '$DATE_MODULE'";
      }
  }
  
  sub coerce_duration {
      my $val = shift;
      if (!defined($val)) {
          return undef;
      } elsif (blessed($val) && $val->isa('DateTime::Duration')) {
          return $val;
      } elsif ($val =~ /\AP
                        (?: ([0-9]+(?:\.[0-9]+)?)Y )?
                        (?: ([0-9]+(?:\.[0-9]+)?)M )?
                        (?: ([0-9]+(?:\.[0-9]+)?)W )?
                        (?: ([0-9]+(?:\.[0-9]+)?)D )?
                        (?:
                            T
                            (?: ([0-9]+(?:\.[0-9]+)?)H )?
                            (?: ([0-9]+(?:\.[0-9]+)?)M )?
                            (?: ([0-9]+(?:\.[0-9]+)?)S )?
                        )?
                        \z/x) {
          require DateTime::Duration;
          my $d;
          eval {
              $d = DateTime::Duration->new(
                  years   => $1 // 0,
                  months  => $2 // 0,
                  weeks   => $3 // 0,
                  days    => $4 // 0,
                  hours   => $5 // 0,
                  minutes => $6 // 0,
                  seconds => $7 // 0,
              );
          };
          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-07-01'; 
  our $VERSION = '0.68'; 
  
  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/Format.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'DATE_FORMAT';
  
  package Date::Format;
  
  use     strict;
  use     vars qw(@EXPORT @ISA $VERSION);
  require Exporter;
  
  $VERSION = "2.24";
  @ISA     = qw(Exporter);
  @EXPORT  = qw(time2str strftime ctime asctime);
  
  sub time2str ($;$$)
  {
   Date::Format::Generic->time2str(@_);
  }
  
  sub strftime ($\@;$)
  {
   Date::Format::Generic->strftime(@_);
  }
  
  sub ctime ($;$)
  {
   my($t,$tz) = @_;
   Date::Format::Generic->time2str("%a %b %e %T %Y\n", $t, $tz); 
  }
  
  sub asctime (\@;$)
  {
   my($t,$tz) = @_;
   Date::Format::Generic->strftime("%a %b %e %T %Y\n", $t, $tz); 
  }
  
  
  package Date::Format::Generic;
  
  use vars qw($epoch $tzname);
  use Time::Zone;
  use Time::Local;
  
  sub ctime
  {
   my($me,$t,$tz) = @_;
   $me->time2str("%a %b %e %T %Y\n", $t, $tz); 
  }
  
  sub asctime
  {
   my($me,$t,$tz) = @_;
   $me->strftime("%a %b %e %T %Y\n", $t, $tz); 
  }
  
  sub _subs
  {
   my $fn;
   $_[1] =~ s/
  		%(O?[%a-zA-Z])
  	   /
                  ($_[0]->can("format_$1") || sub { $1 })->($_[0]);
  	   /sgeox;
  
   $_[1];
  }
  
  sub strftime 
  {
   my($pkg,$fmt,$time);
  
   ($pkg,$fmt,$time,$tzname) = @_;
  
   my $me = ref($pkg) ? $pkg : bless [];
  
   if(defined $tzname)
    {
     $tzname = uc $tzname;
  
     $tzname = sprintf("%+05d",$tzname)
  	unless($tzname =~ /\D/);
  
     $epoch = timegm(@{$time}[0..5]);
  
     @$me = gmtime($epoch + tz_offset($tzname) - tz_offset());
    }
   else
    {
     @$me = @$time;
     undef $epoch;
    }
  
   _subs($me,$fmt);
  }
  
  sub time2str
  {
   my($pkg,$fmt,$time);
  
   ($pkg,$fmt,$time,$tzname) = @_;
  
   my $me = ref($pkg) ? $pkg : bless [], $pkg;
  
   $epoch = $time;
  
   if(defined $tzname)
    {
     $tzname = uc $tzname;
  
     $tzname = sprintf("%+05d",$tzname)
  	unless($tzname =~ /\D/);
  
     $time += tz_offset($tzname);
     @$me = gmtime($time);
    }
   else
    {
     @$me = localtime($time);
    }
   $me->[9] = $time;
   _subs($me,$fmt);
  }
  
  my(@DoW,@MoY,@DoWs,@MoYs,@AMPM,%format,@Dsuf);
  
  @DoW = qw(Sunday Monday Tuesday Wednesday Thursday Friday Saturday);
  
  @MoY = qw(January February March April May June
            July August September October November December);
  
  @DoWs = map { substr($_,0,3) } @DoW;
  @MoYs = map { substr($_,0,3) } @MoY;
  
  @AMPM = qw(AM PM);
  
  @Dsuf = (qw(th st nd rd th th th th th th)) x 3;
  @Dsuf[11,12,13] = qw(th th th);
  @Dsuf[30,31] = qw(th st);
  
  %format = ('x' => "%m/%d/%y",
             'C' => "%a %b %e %T %Z %Y",
             'X' => "%H:%M:%S",
            );
  
  my @locale;
  my $locale = "/usr/share/lib/locale/LC_TIME/default";
  local *LOCALE;
  
  if(open(LOCALE,"$locale"))
   {
    chop(@locale = <LOCALE>);
    close(LOCALE);
  
    @MoYs = @locale[0 .. 11];
    @MoY  = @locale[12 .. 23];
    @DoWs = @locale[24 .. 30];
    @DoW  = @locale[31 .. 37];
    @format{"X","x","C"} =  @locale[38 .. 40];
    @AMPM = @locale[41 .. 42];
   }
  
  sub wkyr {
      my($wstart, $wday, $yday) = @_;
      $wday = ($wday + 7 - $wstart) % 7;
      return int(($yday - $wday + 13) / 7 - 1);
  }
  
  
  my @roman = ('',qw(I II III IV V VI VII VIII IX));
  sub roman {
    my $n = shift;
  
    $n =~ s/(\d)$//;
    my $r = $roman[ $1 ];
  
    if($n =~ s/(\d)$//) {
      (my $t = $roman[$1]) =~ tr/IVX/XLC/;
      $r = $t . $r;
    }
    if($n =~ s/(\d)$//) {
      (my $t = $roman[$1]) =~ tr/IVX/CDM/;
      $r = $t . $r;
    }
    if($n =~ s/(\d)$//) {
      (my $t = $roman[$1]) =~ tr/IVX/M../;
      $r = $t . $r;
    }
    $r;
  }
  
  sub format_a { $DoWs[$_[0]->[6]] }
  sub format_A { $DoW[$_[0]->[6]] }
  sub format_b { $MoYs[$_[0]->[4]] }
  sub format_B { $MoY[$_[0]->[4]] }
  sub format_h { $MoYs[$_[0]->[4]] }
  sub format_p { $_[0]->[2] >= 12 ?  $AMPM[1] : $AMPM[0] }
  sub format_P { lc($_[0]->[2] >= 12 ?  $AMPM[1] : $AMPM[0]) }
  
  sub format_d { sprintf("%02d",$_[0]->[3]) }
  sub format_e { sprintf("%2d",$_[0]->[3]) }
  sub format_H { sprintf("%02d",$_[0]->[2]) }
  sub format_I { sprintf("%02d",$_[0]->[2] % 12 || 12)}
  sub format_j { sprintf("%03d",$_[0]->[7] + 1) }
  sub format_k { sprintf("%2d",$_[0]->[2]) }
  sub format_l { sprintf("%2d",$_[0]->[2] % 12 || 12)}
  sub format_L { $_[0]->[4] + 1 }
  sub format_m { sprintf("%02d",$_[0]->[4] + 1) }
  sub format_M { sprintf("%02d",$_[0]->[1]) }
  sub format_q { sprintf("%01d",int($_[0]->[4] / 3) + 1) }
  sub format_s { 
     $epoch = timelocal(@{$_[0]}[0..5])
  	unless defined $epoch;
     sprintf("%d",$epoch) 
  }
  sub format_S { sprintf("%02d",$_[0]->[0]) }
  sub format_U { wkyr(0, $_[0]->[6], $_[0]->[7]) }
  sub format_w { $_[0]->[6] }
  sub format_W { wkyr(1, $_[0]->[6], $_[0]->[7]) }
  sub format_y { sprintf("%02d",$_[0]->[5] % 100) }
  sub format_Y { sprintf("%04d",$_[0]->[5] + 1900) }
  
  sub format_Z {
   my $o = tz_local_offset(timelocal(@{$_[0]}[0..5]));
   defined $tzname ? $tzname : uc tz_name($o, $_[0]->[8]);
  }
  
  sub format_z {
   my $t = timelocal(@{$_[0]}[0..5]);
   my $o = defined $tzname ? tz_offset($tzname, $t) : tz_offset(undef,$t);
   sprintf("%+03d%02d", int($o / 3600), int(abs($o) % 3600) / 60);
  }
  
  sub format_c { &format_x . " " . &format_X }
  sub format_D { &format_m . "/" . &format_d . "/" . &format_y  }      
  sub format_r { &format_I . ":" . &format_M . ":" . &format_S . " " . &format_p  }   
  sub format_R { &format_H . ":" . &format_M }
  sub format_T { &format_H . ":" . &format_M . ":" . &format_S }
  sub format_t { "\t" }
  sub format_n { "\n" }
  sub format_o { sprintf("%2d%s",$_[0]->[3],$Dsuf[$_[0]->[3]]) }
  sub format_x { my $f = $format{'x'}; _subs($_[0],$f); }
  sub format_X { my $f = $format{'X'}; _subs($_[0],$f); }
  sub format_C { my $f = $format{'C'}; _subs($_[0],$f); }
  
  sub format_Od { roman(format_d(@_)) }
  sub format_Oe { roman(format_e(@_)) }
  sub format_OH { roman(format_H(@_)) }
  sub format_OI { roman(format_I(@_)) }
  sub format_Oj { roman(format_j(@_)) }
  sub format_Ok { roman(format_k(@_)) }
  sub format_Ol { roman(format_l(@_)) }
  sub format_Om { roman(format_m(@_)) }
  sub format_OM { roman(format_M(@_)) }
  sub format_Oq { roman(format_q(@_)) }
  sub format_Oy { roman(format_y(@_)) }
  sub format_OY { roman(format_Y(@_)) }
  
  sub format_G { int(($_[0]->[9] - 315993600) / 604800) }
  
  1;
  __END__
  
  
  
DATE_FORMAT

$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{"DefHash.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'DEFHASH';
  package DefHash;
  
  our $VERSION = '1.0.10'; 
  
  1;
  
  __END__
  
DEFHASH

$fatpacked{"Encode/Locale.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'ENCODE_LOCALE';
  package Encode::Locale;
  
  use strict;
  our $VERSION = "1.04";
  
  use base 'Exporter';
  our @EXPORT_OK = qw(
      decode_argv env
      $ENCODING_LOCALE $ENCODING_LOCALE_FS
      $ENCODING_CONSOLE_IN $ENCODING_CONSOLE_OUT
  );
  
  use Encode ();
  use Encode::Alias ();
  
  our $ENCODING_LOCALE;
  our $ENCODING_LOCALE_FS;
  our $ENCODING_CONSOLE_IN;
  our $ENCODING_CONSOLE_OUT;
  
  sub DEBUG () { 0 }
  
  sub _init {
      if ($^O eq "MSWin32") {
  	unless ($ENCODING_LOCALE) {
  	    eval {
  		unless (defined &GetConsoleCP) {
  		    require Win32;
                      eval { Win32::GetConsoleCP() };
  		    *GetConsoleCP = sub { &Win32::GetConsoleCP } unless $@;
  		}
  		unless (defined &GetConsoleCP) {
  		    require Win32::API;
  		    Win32::API->Import('kernel32', 'int GetConsoleCP()');
  		}
  		if (defined &GetConsoleCP) {
  		    my $cp = GetConsoleCP();
  		    $ENCODING_LOCALE = "cp$cp" if $cp;
  		}
  	    };
  	}
  
  	unless ($ENCODING_CONSOLE_IN) {
              unless (defined &GetInputCP) {
                  eval {
                      require Win32;
                      eval { Win32::GetConsoleCP() };
                      *GetInputCP = sub { &Win32::GetConsoleCP } unless $@;
                      *GetOutputCP = sub { &Win32::GetConsoleOutputCP } unless $@;
                  };
                  unless (defined &GetInputCP) {
                      eval {
                          require Win32::Console;
                          eval { Win32::Console::InputCP() };
                          *GetInputCP = sub { &Win32::Console::InputCP }
                              unless $@;
                          *GetOutputCP = sub { &Win32::Console::OutputCP }
                              unless $@;
                      };
                  }
                  unless (defined &GetInputCP) {
                      *GetInputCP = *GetOutputCP = sub {
                          ((qx(chcp) || '') =~ /^Active code page: (\d+)/)
                              ? $1 : ();
                      };
                  }
  	    }
              my $cp = GetInputCP();
              $ENCODING_CONSOLE_IN = "cp$cp" if $cp;
              $cp = GetOutputCP();
              $ENCODING_CONSOLE_OUT = "cp$cp" if $cp;
  	}
      }
  
      unless ($ENCODING_LOCALE) {
  	eval {
  	    require I18N::Langinfo;
  	    $ENCODING_LOCALE = I18N::Langinfo::langinfo(I18N::Langinfo::CODESET());
  
  	    $ENCODING_LOCALE = "ascii" if $ENCODING_LOCALE eq "646";
  
  	    $ENCODING_LOCALE = "hp-roman8" if $^O eq "hpux" && $ENCODING_LOCALE eq "roman8";
  	};
  	$ENCODING_LOCALE ||= $ENCODING_CONSOLE_IN;
      }
  
      if ($^O eq "darwin") {
  	$ENCODING_LOCALE_FS ||= "UTF-8";
      }
  
      $ENCODING_LOCALE ||= $^O eq "MSWin32" ? "cp1252" : "UTF-8";
      $ENCODING_LOCALE_FS ||= $ENCODING_LOCALE;
      $ENCODING_CONSOLE_IN ||= $ENCODING_LOCALE;
      $ENCODING_CONSOLE_OUT ||= $ENCODING_CONSOLE_IN;
  
      unless (Encode::find_encoding($ENCODING_LOCALE)) {
  	my $foundit;
  	if (lc($ENCODING_LOCALE) eq "gb18030") {
  	    eval {
  		require Encode::HanExtra;
  	    };
  	    if ($@) {
  		die "Need Encode::HanExtra to be installed to support locale codeset ($ENCODING_LOCALE), stopped";
  	    }
  	    $foundit++ if Encode::find_encoding($ENCODING_LOCALE);
  	}
  	die "The locale codeset ($ENCODING_LOCALE) isn't one that perl can decode, stopped"
  	    unless $foundit;
  
      }
  
  }
  
  _init();
  Encode::Alias::define_alias(sub {
      no strict 'refs';
      no warnings 'once';
      return ${"ENCODING_" . uc(shift)};
  }, "locale");
  
  sub _flush_aliases {
      no strict 'refs';
      for my $a (keys %Encode::Alias::Alias) {
  	if (defined ${"ENCODING_" . uc($a)}) {
  	    delete $Encode::Alias::Alias{$a};
  	    warn "Flushed alias cache for $a" if DEBUG;
  	}
      }
  }
  
  sub reinit {
      $ENCODING_LOCALE = shift;
      $ENCODING_LOCALE_FS = shift;
      $ENCODING_CONSOLE_IN = $ENCODING_LOCALE;
      $ENCODING_CONSOLE_OUT = $ENCODING_LOCALE;
      _init();
      _flush_aliases();
  }
  
  sub decode_argv {
      die if defined wantarray;
      for (@ARGV) {
  	$_ = Encode::decode(locale => $_, @_);
      }
  }
  
  sub env {
      my $k = Encode::encode(locale => shift);
      my $old = $ENV{$k};
      if (@_) {
  	my $v = shift;
  	if (defined $v) {
  	    $ENV{$k} = Encode::encode(locale => $v);
  	}
  	else {
  	    delete $ENV{$k};
  	}
      }
      return Encode::decode(locale => $old) if defined wantarray;
  }
  
  1;
  
  __END__
  
ENCODE_LOCALE

$fatpacked{"Exporter/Shiny.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'EXPORTER_SHINY';
  package Exporter::Shiny;
  
  use 5.006001;
  use strict;
  use warnings;
  
  use Exporter::Tiny ();
  
  our $AUTHORITY = 'cpan:TOBYINK';
  our $VERSION   = '0.042';
  
  sub import {
  	my $me     = shift;
  	my $caller = caller;
  	
  	(my $nominal_file = $caller) =~ s(::)(/)g;
  	$INC{"$nominal_file\.pm"} ||= __FILE__;
  	
  	if (@_ == 2 and $_[0] eq -setup)
  	{
  		my (undef, $opts) = @_;
  		@_ = @{ delete($opts->{exports}) || [] };
  		
  		if (%$opts) {
  			Exporter::Tiny::_croak(
  				'Unsupported Sub::Exporter-style options: %s',
  				join(q[, ], sort keys %$opts),
  			);
  		}
  	}
  	
  	ref($_) && Exporter::Tiny::_croak('Expected sub name, got ref %s', $_) for @_;
  	
  	no strict qw(refs);
  	push @{"$caller\::ISA"}, 'Exporter::Tiny';
  	push @{"$caller\::EXPORT_OK"}, @_;
  }
  
  1;
  
  __END__
  
EXPORTER_SHINY

$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{"File/GlobMapper.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'FILE_GLOBMAPPER';
  package File::GlobMapper;
  
  use strict;
  use warnings;
  use Carp;
  
  our ($CSH_GLOB);
  
  BEGIN
  {
      if ($] < 5.006)
      { 
          require File::BSDGlob; import File::BSDGlob qw(:glob) ;
          $CSH_GLOB = File::BSDGlob::GLOB_CSH() ;
          *globber = \&File::BSDGlob::csh_glob;
      }  
      else
      { 
          require File::Glob; import File::Glob qw(:glob) ;
          $CSH_GLOB = File::Glob::GLOB_CSH() ;
          *globber = \&File::Glob::csh_glob;
      }  
  }
  
  our ($Error);
  
  our ($VERSION, @EXPORT_OK);
  $VERSION = '1.000';
  @EXPORT_OK = qw( globmap );
  
  
  our ($noPreBS, $metachars, $matchMetaRE, %mapping, %wildCount);
  $noPreBS = '(?<!\\\)' ; 
  $metachars = '.*?[](){}';
  $matchMetaRE = '[' . quotemeta($metachars) . ']';
  
  %mapping = (
                  '*' => '([^/]*)',
                  '?' => '([^/])',
                  '.' => '\.',
                  '[' => '([',
                  '(' => '(',
                  ')' => ')',
             );
  
  %wildCount = map { $_ => 1 } qw/ * ? . { ( [ /;           
  
  sub globmap ($$;)
  {
      my $inputGlob = shift ;
      my $outputGlob = shift ;
  
      my $obj = new File::GlobMapper($inputGlob, $outputGlob, @_)
          or croak "globmap: $Error" ;
      return $obj->getFileMap();
  }
  
  sub new
  {
      my $class = shift ;
      my $inputGlob = shift ;
      my $outputGlob = shift ;
      my $flags = shift || $CSH_GLOB ;
  
      $inputGlob =~ s/^\s*\<\s*//;
      $inputGlob =~ s/\s*\>\s*$//;
  
      $outputGlob =~ s/^\s*\<\s*//;
      $outputGlob =~ s/\s*\>\s*$//;
  
      my %object =
              (   InputGlob   => $inputGlob,
                  OutputGlob  => $outputGlob,
                  GlobFlags   => $flags,
                  Braces      => 0,
                  WildCount   => 0,
                  Pairs       => [],
                  Sigil       => '#',
              );
  
      my $self = bless \%object, ref($class) || $class ;
  
      $self->_parseInputGlob()
          or return undef ;
  
      $self->_parseOutputGlob()
          or return undef ;
      
      my @inputFiles = globber($self->{InputGlob}, $flags) ;
  
      if (GLOB_ERROR)
      {
          $Error = $!;
          return undef ;
      }
  
      {
          my $missing = grep { ! -e $_ } @inputFiles ;
  
          if ($missing)
          {
              $Error = "$missing input files do not exist";
              return undef ;
          }
      }
  
      $self->{InputFiles} = \@inputFiles ;
  
      $self->_getFiles()
          or return undef ;
  
      return $self;
  }
  
  sub _retError
  {
      my $string = shift ;
      $Error = "$string in input fileglob" ;
      return undef ;
  }
  
  sub _unmatched
  {
      my $delimeter = shift ;
  
      _retError("Unmatched $delimeter");
      return undef ;
  }
  
  sub _parseBit
  {
      my $self = shift ;
  
      my $string = shift ;
  
      my $out = '';
      my $depth = 0 ;
  
      while ($string =~ s/(.*?)$noPreBS(,|$matchMetaRE)//)
      {
          $out .= quotemeta($1) ;
          $out .= $mapping{$2} if defined $mapping{$2};
  
          ++ $self->{WildCount} if $wildCount{$2} ;
  
          if ($2 eq ',')
          { 
              return _unmatched "("
                  if $depth ;
              
              $out .= '|';
          }
          elsif ($2 eq '(')
          { 
              ++ $depth ;
          }
          elsif ($2 eq ')')
          { 
              return _unmatched ")"
                  if ! $depth ;
  
              -- $depth ;
          }
          elsif ($2 eq '[')
          {
              $string =~ s#(.*?\])##
                  or return _unmatched "[" ;
              $out .= "$1)" ;
          }
          elsif ($2 eq ']')
          {
              return _unmatched "]" ;
          }
          elsif ($2 eq '{' || $2 eq '}')
          {
              return _retError "Nested {} not allowed" ;
          }
      }
  
      $out .= quotemeta $string;
  
      return _unmatched "("
          if $depth ;
  
      return $out ;
  }
  
  sub _parseInputGlob
  {
      my $self = shift ;
  
      my $string = $self->{InputGlob} ;
      my $inGlob = '';
  
  
      my $out = '';
      my $depth = 0 ;
  
      while ($string =~ s/(.*?)$noPreBS($matchMetaRE)//)
      {
          $out .= quotemeta($1) ;
          $out .= $mapping{$2} if defined $mapping{$2};
          ++ $self->{WildCount} if $wildCount{$2} ;
  
          if ($2 eq '(')
          { 
              ++ $depth ;
          }
          elsif ($2 eq ')')
          { 
              return _unmatched ")"
                  if ! $depth ;
  
              -- $depth ;
          }
          elsif ($2 eq '[')
          {
              $string =~ s#(.*?\])##
                  or return _unmatched "[";
              $out .= "$1)" ;
          }
          elsif ($2 eq ']')
          {
              return _unmatched "]" ;
          }
          elsif ($2 eq '}')
          {
              return _unmatched "}" ;
          }
          elsif ($2 eq '{')
          {
  
              my $tmp ;
              unless ( $string =~ s/(.*?)$noPreBS\}//)
              {
                  return _unmatched "{";
              }
  
              my $alt = $self->_parseBit($1);
              defined $alt or return 0 ;
              $out .= "($alt)" ;
  
              ++ $self->{Braces} ;
          }
      }
  
      return _unmatched "("
          if $depth ;
  
      $out .= quotemeta $string ;
  
  
      $self->{InputGlob} =~ s/$noPreBS[\(\)]//g;
      $self->{InputPattern} = $out ;
  
  
      return 1 ;
  
  }
  
  sub _parseOutputGlob
  {
      my $self = shift ;
  
      my $string = $self->{OutputGlob} ;
      my $maxwild = $self->{WildCount};
  
      if ($self->{GlobFlags} & GLOB_TILDE)
      {
          $string =~ s{
                ^ ~             # find a leading tilde
                (               # save this in $1
                    [^/]        # a non-slash character
                          *     # repeated 0 or more times (0 means me)
                )
              }{
                $1
                    ? (getpwnam($1))[7]
                    : ( $ENV{HOME} || $ENV{LOGDIR} )
              }ex;
  
      }
  
      while ( $string =~ m/#(\d)/g )
      {
          croak "Max wild is #$maxwild, you tried #$1"
              if $1 > $maxwild ;
      }
  
      my $noPreBS = '(?<!\\\)' ; 
  
      $string =~ s/${noPreBS}#(\d)/\${$1}/g;
      $string =~ s#${noPreBS}\*#\${inFile}#g;
      $string = '"' . $string . '"';
  
      $self->{OutputPattern} = $string ;
  
      return 1 ;
  }
  
  sub _getFiles
  {
      my $self = shift ;
  
      my %outInMapping = ();
      my %inFiles = () ;
  
      foreach my $inFile (@{ $self->{InputFiles} })
      {
          next if $inFiles{$inFile} ++ ;
  
          my $outFile = $inFile ;
  
          if ( $inFile =~ m/$self->{InputPattern}/ )
          {
              no warnings 'uninitialized';
              eval "\$outFile = $self->{OutputPattern};" ;
  
              if (defined $outInMapping{$outFile})
              {
                  $Error =  "multiple input files map to one output file";
                  return undef ;
              }
              $outInMapping{$outFile} = $inFile;
              push @{ $self->{Pairs} }, [$inFile, $outFile];
          }
      }
  
      return 1 ;
  }
  
  sub getFileMap
  {
      my $self = shift ;
  
      return $self->{Pairs} ;
  }
  
  sub getHash
  {
      my $self = shift ;
  
      return { map { $_->[0] => $_->[1] } @{ $self->{Pairs} } } ;
  }
  
  1;
  
  __END__
  
FILE_GLOBMAPPER

$fatpacked{"File/Which.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'FILE_WHICH';
  package File::Which;
  
  use 5.008001;
  use strict;
  use warnings;
  use Exporter   ();
  use File::Spec ();
  
  our $VERSION = '1.18'; 
  
  
  our @ISA       = 'Exporter';
  our @EXPORT    = 'which';
  our @EXPORT_OK = 'where';
  
  use constant {
    IS_VMS => ($^O eq 'VMS'),
    IS_MAC => ($^O eq 'MacOS'),
    IS_DOS => ($^O eq 'MSWin32' or $^O eq 'dos' or $^O eq 'os2'),
    IS_CYG => ($^O eq 'cygwin'),
  };
  
  my @PATHEXT = ('');
  if ( IS_DOS ) {
    if ( $ENV{PATHEXT} ) {
      push @PATHEXT, split ';', $ENV{PATHEXT};
    } else {
      push @PATHEXT, qw{.com .exe .bat};
    }
  } elsif ( IS_VMS ) {
    push @PATHEXT, qw{.exe .com};
  } elsif ( IS_CYG ) {
    push @PATHEXT, qw{.exe .com};
  }
  
  
  sub which {
    my ($exec) = @_;
  
    return undef unless $exec;
  
    my $all = wantarray;
    my @results = ();
  
    if ( IS_VMS ) {
      my $symbol = `SHOW SYMBOL $exec`;
      chomp($symbol);
      unless ( $? ) {
        return $symbol unless $all;
        push @results, $symbol;
      }
    }
    if ( IS_MAC ) {
      my @aliases = split /\,/, $ENV{Aliases};
      foreach my $alias ( @aliases ) {
        if ( lc($alias) eq lc($exec) ) {
          chomp(my $file = `Alias $alias`);
          last unless $file;  
          return $file unless $all;
          push @results, $file;
          last;
        }
      }
    }
  
    return $exec
            if !IS_VMS and !IS_MAC and !IS_DOS and $exec =~ /\// and -f $exec and -x $exec;
  
    my @path = File::Spec->path;
    if ( IS_DOS or IS_VMS or IS_MAC ) {
      unshift @path, File::Spec->curdir;
    }
  
    foreach my $base ( map { File::Spec->catfile($_, $exec) } @path ) {
      for my $ext ( @PATHEXT ) {
        my $file = $base.$ext;
  
        next if -d $file;
  
        if (
          -x _
          or (
            IS_MAC
            ||
            (
              ( IS_DOS or IS_CYG )
              and
              grep {
                $file =~ /$_\z/i
              } @PATHEXT[1..$#PATHEXT]
            )
            and -e _
          )
        ) {
          return $file unless $all;
          push @results, $file;
        }
      }
    }
  
    if ( $all ) {
      return @results;
    } else {
      return undef;
    }
  }
  
  
  sub where {
    my @res = which($_[0]);
    return @res;
  }
  
  1;
  
  __END__
  
  
FILE_WHICH

$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-06-11'; 
  our $VERSION = '0.83'; 
  
  use 5.010001;
  use strict;
  use warnings;
  
  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 grep {$_ 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{"HTTP/Config.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'HTTP_CONFIG';
  package HTTP::Config;
  
  use strict;
  use URI;
  use vars qw($VERSION);
  
  $VERSION = "6.00";
  
  sub new {
      my $class = shift;
      return bless [], $class;
  }
  
  sub entries {
      my $self = shift;
      @$self;
  }
  
  sub empty {
      my $self = shift;
      not @$self;
  }
  
  sub add {
      if (@_ == 2) {
          my $self = shift;
          push(@$self, shift);
          return;
      }
      my($self, %spec) = @_;
      push(@$self, \%spec);
      return;
  }
  
  sub find2 {
      my($self, %spec) = @_;
      my @found;
      my @rest;
   ITEM:
      for my $item (@$self) {
          for my $k (keys %spec) {
              if (!exists $item->{$k} || $spec{$k} ne $item->{$k}) {
                  push(@rest, $item);
                  next ITEM;
              }
          }
          push(@found, $item);
      }
      return \@found unless wantarray;
      return \@found, \@rest;
  }
  
  sub find {
      my $self = shift;
      my $f = $self->find2(@_);
      return @$f if wantarray;
      return $f->[0];
  }
  
  sub remove {
      my($self, %spec) = @_;
      my($removed, $rest) = $self->find2(%spec);
      @$self = @$rest if @$removed;
      return @$removed;
  }
  
  my %MATCH = (
      m_scheme => sub {
          my($v, $uri) = @_;
          return $uri->_scheme eq $v;  
      },
      m_secure => sub {
          my($v, $uri) = @_;
          my $secure = $uri->can("secure") ? $uri->secure : $uri->_scheme eq "https";
          return $secure == !!$v;
      },
      m_host_port => sub {
          my($v, $uri) = @_;
          return unless $uri->can("host_port");
          return $uri->host_port eq $v, 7;
      },
      m_host => sub {
          my($v, $uri) = @_;
          return unless $uri->can("host");
          return $uri->host eq $v, 6;
      },
      m_port => sub {
          my($v, $uri) = @_;
          return unless $uri->can("port");
          return $uri->port eq $v;
      },
      m_domain => sub {
          my($v, $uri) = @_;
          return unless $uri->can("host");
          my $h = $uri->host;
          $h = "$h.local" unless $h =~ /\./;
          $v = ".$v" unless $v =~ /^\./;
          return length($v), 5 if substr($h, -length($v)) eq $v;
          return 0;
      },
      m_path => sub {
          my($v, $uri) = @_;
          return unless $uri->can("path");
          return $uri->path eq $v, 4;
      },
      m_path_prefix => sub {
          my($v, $uri) = @_;
          return unless $uri->can("path");
          my $path = $uri->path;
          my $len = length($v);
          return $len, 3 if $path eq $v;
          return 0 if length($path) <= $len;
          $v .= "/" unless $v =~ m,/\z,,;
          return $len, 3 if substr($path, 0, length($v)) eq $v;
          return 0;
      },
      m_path_match => sub {
          my($v, $uri) = @_;
          return unless $uri->can("path");
          return $uri->path =~ $v;
      },
      m_uri__ => sub {
          my($v, $k, $uri) = @_;
          return unless $uri->can($k);
          return 1 unless defined $v;
          return $uri->$k eq $v;
      },
      m_method => sub {
          my($v, $uri, $request) = @_;
          return $request && $request->method eq $v;
      },
      m_proxy => sub {
          my($v, $uri, $request) = @_;
          return $request && ($request->{proxy} || "") eq $v;
      },
      m_code => sub {
          my($v, $uri, $request, $response) = @_;
          $v =~ s/xx\z//;
          return unless $response;
          return length($v), 2 if substr($response->code, 0, length($v)) eq $v;
      },
      m_media_type => sub {  
          my($v, $uri, $request, $response) = @_;
          return unless $response;
          return 1, 1 if $v eq "*/*";
          my $ct = $response->content_type;
          return 2, 1 if $v =~ s,/\*\z,, && $ct =~ m,^\Q$v\E/,;
          return 3, 1 if $v eq "html" && $response->content_is_html;
          return 4, 1 if $v eq "xhtml" && $response->content_is_xhtml;
          return 10, 1 if $v eq $ct;
          return 0;
      },
      m_header__ => sub {
          my($v, $k, $uri, $request, $response) = @_;
          return unless $request;
          return 1 if $request->header($k) eq $v;
          return 1 if $response && $response->header($k) eq $v;
          return 0;
      },
      m_response_attr__ => sub {
          my($v, $k, $uri, $request, $response) = @_;
          return unless $response;
          return 1 if !defined($v) && exists $response->{$k};
          return 0 unless exists $response->{$k};
          return 1 if $response->{$k} eq $v;
          return 0;
      },
  );
  
  sub matching {
      my $self = shift;
      if (@_ == 1) {
          if ($_[0]->can("request")) {
              unshift(@_, $_[0]->request);
              unshift(@_, undef) unless defined $_[0];
          }
          unshift(@_, $_[0]->uri_canonical) if $_[0] && $_[0]->can("uri_canonical");
      }
      my($uri, $request, $response) = @_;
      $uri = URI->new($uri) unless ref($uri);
  
      my @m;
   ITEM:
      for my $item (@$self) {
          my $order;
          for my $ikey (keys %$item) {
              my $mkey = $ikey;
              my $k;
              $k = $1 if $mkey =~ s/__(.*)/__/;
              if (my $m = $MATCH{$mkey}) {
                  my($c, $o);
                  my @arg = (
                      defined($k) ? $k : (),
                      $uri, $request, $response
                  );
                  my $v = $item->{$ikey};
                  $v = [$v] unless ref($v) eq "ARRAY";
                  for (@$v) {
                      ($c, $o) = $m->($_, @arg);
                      last if $c;
                  }
                  next ITEM unless $c;
                  $order->[$o || 0] += $c;
              }
          }
          $order->[7] ||= 0;
          $item->{_order} = join(".", reverse map sprintf("%03d", $_ || 0), @$order);
          push(@m, $item);
      }
      @m = sort { $b->{_order} cmp $a->{_order} } @m;
      delete $_->{_order} for @m;
      return @m if wantarray;
      return $m[0];
  }
  
  sub add_item {
      my $self = shift;
      my $item = shift;
      return $self->add(item => $item, @_);
  }
  
  sub remove_items {
      my $self = shift;
      return map $_->{item}, $self->remove(@_);
  }
  
  sub matching_items {
      my $self = shift;
      return map $_->{item}, $self->matching(@_);
  }
  
  1;
  
  __END__
  
HTTP_CONFIG

$fatpacked{"HTTP/Date.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'HTTP_DATE';
  package HTTP::Date;
  
  $VERSION = "6.02";
  
  require Exporter;
  @ISA = qw(Exporter);
  @EXPORT = qw(time2str str2time);
  @EXPORT_OK = qw(parse_date time2iso time2isoz);
  
  use strict;
  require Time::Local;
  
  use vars qw(@DoW @MoY %MoY);
  @DoW = qw(Sun Mon Tue Wed Thu Fri Sat);
  @MoY = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
  @MoY{@MoY} = (1..12);
  
  my %GMT_ZONE = (GMT => 1, UTC => 1, UT => 1, Z => 1);
  
  
  sub time2str (;$)
  {
      my $time = shift;
      $time = time unless defined $time;
      my ($sec, $min, $hour, $mday, $mon, $year, $wday) = gmtime($time);
      sprintf("%s, %02d %s %04d %02d:%02d:%02d GMT",
  	    $DoW[$wday],
  	    $mday, $MoY[$mon], $year+1900,
  	    $hour, $min, $sec);
  }
  
  
  sub str2time ($;$)
  {
      my $str = shift;
      return undef unless defined $str;
  
      if ($str =~ /^[SMTWF][a-z][a-z], (\d\d) ([JFMAJSOND][a-z][a-z]) (\d\d\d\d) (\d\d):(\d\d):(\d\d) GMT$/) {
  	return eval {
  	    my $t = Time::Local::timegm($6, $5, $4, $1, $MoY{$2}-1, $3);
  	    $t < 0 ? undef : $t;
  	};
      }
  
      my @d = parse_date($str);
      return undef unless @d;
      $d[1]--;        
  
      my $tz = pop(@d);
      unless (defined $tz) {
  	unless (defined($tz = shift)) {
  	    return eval { my $frac = $d[-1]; $frac -= ($d[-1] = int($frac));
  			  my $t = Time::Local::timelocal(reverse @d) + $frac;
  			  $t < 0 ? undef : $t;
  		        };
  	}
      }
  
      my $offset = 0;
      if ($GMT_ZONE{uc $tz}) {
      }
      elsif ($tz =~ /^([-+])?(\d\d?):?(\d\d)?$/) {
  	$offset = 3600 * $2;
  	$offset += 60 * $3 if $3;
  	$offset *= -1 if $1 && $1 eq '-';
      }
      else {
  	eval { require Time::Zone } || return undef;
  	$offset = Time::Zone::tz_offset($tz);
  	return undef unless defined $offset;
      }
  
      return eval { my $frac = $d[-1]; $frac -= ($d[-1] = int($frac));
  		  my $t = Time::Local::timegm(reverse @d) + $frac;
  		  $t < 0 ? undef : $t - $offset;
  		};
  }
  
  
  sub parse_date ($)
  {
      local($_) = shift;
      return unless defined;
  
      s/^\s+//;  
      s/^(?:Sun|Mon|Tue|Wed|Thu|Fri|Sat)[a-z]*,?\s*//i; 
  
      my($day, $mon, $yr, $hr, $min, $sec, $tz, $ampm);
  
      (($day,$mon,$yr,$hr,$min,$sec,$tz) =
          /^
  	 (\d\d?)               # day
  	    (?:\s+|[-\/])
  	 (\w+)                 # month
  	    (?:\s+|[-\/])
  	 (\d+)                 # year
  	 (?:
  	       (?:\s+|:)       # separator before clock
  	    (\d\d?):(\d\d)     # hour:min
  	    (?::(\d\d))?       # optional seconds
  	 )?                    # optional clock
  	    \s*
  	 ([-+]?\d{2,4}|(?![APap][Mm]\b)[A-Za-z]+)? # timezone
  	    \s*
  	 (?:\(\w+\)|\w{3,})?   # ASCII representation of timezone.
  	    \s*$
  	/x)
  
      ||
  
      (($mon, $day, $hr, $min, $sec, $tz, $yr) =
  	/^
  	 (\w{1,3})             # month
  	    \s+
  	 (\d\d?)               # day
  	    \s+
  	 (\d\d?):(\d\d)        # hour:min
  	 (?::(\d\d))?          # optional seconds
  	    \s+
  	 (?:([A-Za-z]+)\s+)?   # optional timezone
  	 (\d+)                 # year
  	    \s*$               # allow trailing whitespace
  	/x)
  
      ||
  
      (($mon, $day, $yr, $hr, $min, $sec) =
  	/^
  	 (\w{3})               # month
  	    \s+
  	 (\d\d?)               # day
  	    \s+
  	 (?:
  	    (\d\d\d\d) |       # year
  	    (\d{1,2}):(\d{2})  # hour:min
              (?::(\d\d))?       # optional seconds
  	 )
  	 \s*$
         /x)
  
      ||
  
      (($yr, $mon, $day, $hr, $min, $sec, $tz) =
  	/^
  	  (\d{4})              # year
  	     [-\/]?
  	  (\d\d?)              # numerical month
  	     [-\/]?
  	  (\d\d?)              # day
  	 (?:
  	       (?:\s+|[-:Tt])  # separator before clock
  	    (\d\d?):?(\d\d)    # hour:min
  	    (?::?(\d\d(?:\.\d*)?))?  # optional seconds (and fractional)
  	 )?                    # optional clock
  	    \s*
  	 ([-+]?\d\d?:?(:?\d\d)?
  	  |Z|z)?               # timezone  (Z is "zero meridian", i.e. GMT)
  	    \s*$
  	/x)
  
      ||
  
      (($mon, $day, $yr, $hr, $min, $ampm) =
          /^
            (\d{2})                # numerical month
               -
            (\d{2})                # day
               -
            (\d{2})                # year
               \s+
            (\d\d?):(\d\d)([APap][Mm])  # hour:min AM or PM
               \s*$
          /x)
  
      ||
      return;  
  
      $mon = $MoY{$mon} ||
             $MoY{"\u\L$mon"} ||
  	   ($mon =~ /^\d\d?$/ && $mon >= 1 && $mon <= 12 && int($mon)) ||
             return;
  
      unless (defined $yr) {
  	my $cur_mon;
  	($cur_mon, $yr) = (localtime)[4, 5];
  	$yr += 1900;
  	$cur_mon++;
  	$yr-- if $mon > $cur_mon;
      }
      elsif (length($yr) < 3) {
  	my $cur_yr = (localtime)[5] + 1900;
  	my $m = $cur_yr % 100;
  	my $tmp = $yr;
  	$yr += $cur_yr - $m;
  	$m -= $tmp;
  	$yr += ($m > 0) ? 100 : -100
  	    if abs($m) > 50;
      }
  
      $hr  = 0 unless defined($hr);
      $min = 0 unless defined($min);
      $sec = 0 unless defined($sec);
  
      if ($ampm) {
  	$ampm = uc $ampm;
  	$hr = 0 if $hr == 12 && $ampm eq 'AM';
  	$hr += 12 if $ampm eq 'PM' && $hr != 12;
      }
  
      return($yr, $mon, $day, $hr, $min, $sec, $tz)
  	if wantarray;
  
      if (defined $tz) {
  	$tz = "Z" if $tz =~ /^(GMT|UTC?|[-+]?0+)$/;
      }
      else {
  	$tz = "";
      }
      return sprintf("%04d-%02d-%02d %02d:%02d:%02d%s",
  		   $yr, $mon, $day, $hr, $min, $sec, $tz);
  }
  
  
  sub time2iso (;$)
  {
      my $time = shift;
      $time = time unless defined $time;
      my($sec,$min,$hour,$mday,$mon,$year) = localtime($time);
      sprintf("%04d-%02d-%02d %02d:%02d:%02d",
  	    $year+1900, $mon+1, $mday, $hour, $min, $sec);
  }
  
  
  sub time2isoz (;$)
  {
      my $time = shift;
      $time = time unless defined $time;
      my($sec,$min,$hour,$mday,$mon,$year) = gmtime($time);
      sprintf("%04d-%02d-%02d %02d:%02d:%02dZ",
              $year+1900, $mon+1, $mday, $hour, $min, $sec);
  }
  
  1;
  
  
  __END__
  
HTTP_DATE

$fatpacked{"HTTP/Headers.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'HTTP_HEADERS';
  package HTTP::Headers;
  
  use strict;
  use Carp ();
  
  use vars qw($VERSION $TRANSLATE_UNDERSCORE);
  $VERSION = "6.05";
  
  $TRANSLATE_UNDERSCORE = 1 unless defined $TRANSLATE_UNDERSCORE;
  
  
  my @general_headers = qw(
      Cache-Control Connection Date Pragma Trailer Transfer-Encoding Upgrade
      Via Warning
  );
  
  my @request_headers = qw(
      Accept Accept-Charset Accept-Encoding Accept-Language
      Authorization Expect From Host
      If-Match If-Modified-Since If-None-Match If-Range If-Unmodified-Since
      Max-Forwards Proxy-Authorization Range Referer TE User-Agent
  );
  
  my @response_headers = qw(
      Accept-Ranges Age ETag Location Proxy-Authenticate Retry-After Server
      Vary WWW-Authenticate
  );
  
  my @entity_headers = qw(
      Allow Content-Encoding Content-Language Content-Length Content-Location
      Content-MD5 Content-Range Content-Type Expires Last-Modified
  );
  
  my %entity_header = map { lc($_) => 1 } @entity_headers;
  
  my @header_order = (
      @general_headers,
      @request_headers,
      @response_headers,
      @entity_headers,
  );
  
  my %header_order;
  my %standard_case;
  
  {
      my $i = 0;
      for (@header_order) {
  	my $lc = lc $_;
  	$header_order{$lc} = ++$i;
  	$standard_case{$lc} = $_;
      }
  }
  
  
  
  sub new
  {
      my($class) = shift;
      my $self = bless {}, $class;
      $self->header(@_) if @_; 
      $self;
  }
  
  
  sub header
  {
      my $self = shift;
      Carp::croak('Usage: $h->header($field, ...)') unless @_;
      my(@old);
      my %seen;
      while (@_) {
  	my $field = shift;
          my $op = @_ ? ($seen{lc($field)}++ ? 'PUSH' : 'SET') : 'GET';
  	@old = $self->_header($field, shift, $op);
      }
      return @old if wantarray;
      return $old[0] if @old <= 1;
      join(", ", @old);
  }
  
  sub clear
  {
      my $self = shift;
      %$self = ();
  }
  
  
  sub push_header
  {
      my $self = shift;
      return $self->_header(@_, 'PUSH_H') if @_ == 2;
      while (@_) {
  	$self->_header(splice(@_, 0, 2), 'PUSH_H');
      }
  }
  
  
  sub init_header
  {
      Carp::croak('Usage: $h->init_header($field, $val)') if @_ != 3;
      shift->_header(@_, 'INIT');
  }
  
  
  sub remove_header
  {
      my($self, @fields) = @_;
      my $field;
      my @values;
      foreach $field (@fields) {
  	$field =~ tr/_/-/ if $field !~ /^:/ && $TRANSLATE_UNDERSCORE;
  	my $v = delete $self->{lc $field};
  	push(@values, ref($v) eq 'ARRAY' ? @$v : $v) if defined $v;
      }
      return @values;
  }
  
  sub remove_content_headers
  {
      my $self = shift;
      unless (defined(wantarray)) {
  	delete @$self{grep $entity_header{$_} || /^content-/, keys %$self};
  	return;
      }
  
      my $c = ref($self)->new;
      for my $f (grep $entity_header{$_} || /^content-/, keys %$self) {
  	$c->{$f} = delete $self->{$f};
      }
      if (exists $self->{'::std_case'}) {
  	$c->{'::std_case'} = $self->{'::std_case'};
      }
      $c;
  }
  
  
  sub _header
  {
      my($self, $field, $val, $op) = @_;
  
      Carp::croak("Illegal field name '$field'")
          if rindex($field, ':') > 1 || !length($field);
  
      unless ($field =~ /^:/) {
  	$field =~ tr/_/-/ if $TRANSLATE_UNDERSCORE;
  	my $old = $field;
  	$field = lc $field;
  	unless($standard_case{$field} || $self->{'::std_case'}{$field}) {
  	    $old =~ s/\b(\w)/\u$1/g;
  	    $self->{'::std_case'}{$field} = $old;
  	}
      }
  
      $op ||= defined($val) ? 'SET' : 'GET';
      if ($op eq 'PUSH_H') {
  	if (exists $self->{$field}) {
  	    my $h = $self->{$field};
  	    if (ref($h) eq 'ARRAY') {
  		push(@$h, ref($val) eq "ARRAY" ? @$val : $val);
  	    }
  	    else {
  		$self->{$field} = [$h, ref($val) eq "ARRAY" ? @$val : $val]
  	    }
  	    return;
  	}
  	$self->{$field} = $val;
  	return;
      }
  
      my $h = $self->{$field};
      my @old = ref($h) eq 'ARRAY' ? @$h : (defined($h) ? ($h) : ());
  
      unless ($op eq 'GET' || ($op eq 'INIT' && @old)) {
  	if (defined($val)) {
  	    my @new = ($op eq 'PUSH') ? @old : ();
  	    if (ref($val) ne 'ARRAY') {
  		push(@new, $val);
  	    }
  	    else {
  		push(@new, @$val);
  	    }
  	    $self->{$field} = @new > 1 ? \@new : $new[0];
  	}
  	elsif ($op ne 'PUSH') {
  	    delete $self->{$field};
  	}
      }
      @old;
  }
  
  
  sub _sorted_field_names
  {
      my $self = shift;
      return [ sort {
          ($header_order{$a} || 999) <=> ($header_order{$b} || 999) ||
           $a cmp $b
      } grep !/^::/, keys %$self ];
  }
  
  
  sub header_field_names {
      my $self = shift;
      return map $standard_case{$_} || $self->{'::std_case'}{$_} || $_, @{ $self->_sorted_field_names },
  	if wantarray;
      return grep !/^::/, keys %$self;
  }
  
  
  sub scan
  {
      my($self, $sub) = @_;
      my $key;
      for $key (@{ $self->_sorted_field_names }) {
  	my $vals = $self->{$key};
  	if (ref($vals) eq 'ARRAY') {
  	    my $val;
  	    for $val (@$vals) {
  		$sub->($standard_case{$key} || $self->{'::std_case'}{$key} || $key, $val);
  	    }
  	}
  	else {
  	    $sub->($standard_case{$key} || $self->{'::std_case'}{$key} || $key, $vals);
  	}
      }
  }
  
  
  sub as_string
  {
      my($self, $endl) = @_;
      $endl = "\n" unless defined $endl;
  
      my @result = ();
      for my $key (@{ $self->_sorted_field_names }) {
  	next if index($key, '_') == 0;
  	my $vals = $self->{$key};
  	if ( ref($vals) eq 'ARRAY' ) {
  	    for my $val (@$vals) {
  		my $field = $standard_case{$key} || $self->{'::std_case'}{$key} || $key;
  		$field =~ s/^://;
  		if ( index($val, "\n") >= 0 ) {
  		    $val = _process_newline($val, $endl);
  		}
  		push @result, $field . ': ' . $val;
  	    }
  	}
  	else {
  	    my $field = $standard_case{$key} || $self->{'::std_case'}{$key} || $key;
  	    $field =~ s/^://;
  	    if ( index($vals, "\n") >= 0 ) {
  		$vals = _process_newline($vals, $endl);
  	    }
  	    push @result, $field . ': ' . $vals;
  	}
      }
  
      join($endl, @result, '');
  }
  
  sub _process_newline {
      local $_ = shift;
      my $endl = shift;
      s/\s+$//;        
      s/\n(\x0d?\n)+/\n/g;     
      s/\n([^\040\t])/\n $1/g; 
      s/\n/$endl/g;    
      $_;
  }
  
  
  
  if (eval { require Storable; 1 }) {
      *clone = \&Storable::dclone;
  } else {
      *clone = sub {
  	my $self = shift;
  	my $clone = HTTP::Headers->new;
  	$self->scan(sub { $clone->push_header(@_);} );
  	$clone;
      };
  }
  
  
  sub _date_header
  {
      require HTTP::Date;
      my($self, $header, $time) = @_;
      my($old) = $self->_header($header);
      if (defined $time) {
  	$self->_header($header, HTTP::Date::time2str($time));
      }
      $old =~ s/;.*// if defined($old);
      HTTP::Date::str2time($old);
  }
  
  
  sub date                { shift->_date_header('Date',                @_); }
  sub expires             { shift->_date_header('Expires',             @_); }
  sub if_modified_since   { shift->_date_header('If-Modified-Since',   @_); }
  sub if_unmodified_since { shift->_date_header('If-Unmodified-Since', @_); }
  sub last_modified       { shift->_date_header('Last-Modified',       @_); }
  
  sub client_date         { shift->_date_header('Client-Date',         @_); }
  
  
  sub content_type      {
      my $self = shift;
      my $ct = $self->{'content-type'};
      $self->{'content-type'} = shift if @_;
      $ct = $ct->[0] if ref($ct) eq 'ARRAY';
      return '' unless defined($ct) && length($ct);
      my @ct = split(/;\s*/, $ct, 2);
      for ($ct[0]) {
  	s/\s+//g;
  	$_ = lc($_);
      }
      wantarray ? @ct : $ct[0];
  }
  
  sub content_type_charset {
      my $self = shift;
      require HTTP::Headers::Util;
      my $h = $self->{'content-type'};
      $h = $h->[0] if ref($h);
      $h = "" unless defined $h;
      my @v = HTTP::Headers::Util::split_header_words($h);
      if (@v) {
  	my($ct, undef, %ct_param) = @{$v[0]};
  	my $charset = $ct_param{charset};
  	if ($ct) {
  	    $ct = lc($ct);
  	    $ct =~ s/\s+//;
  	}
  	if ($charset) {
  	    $charset = uc($charset);
  	    $charset =~ s/^\s+//;  $charset =~ s/\s+\z//;
  	    undef($charset) if $charset eq "";
  	}
  	return $ct, $charset if wantarray;
  	return $charset;
      }
      return undef, undef if wantarray;
      return undef;
  }
  
  sub content_is_text {
      my $self = shift;
      return $self->content_type =~ m,^text/,;
  }
  
  sub content_is_html {
      my $self = shift;
      return $self->content_type eq 'text/html' || $self->content_is_xhtml;
  }
  
  sub content_is_xhtml {
      my $ct = shift->content_type;
      return $ct eq "application/xhtml+xml" ||
             $ct eq "application/vnd.wap.xhtml+xml";
  }
  
  sub content_is_xml {
      my $ct = shift->content_type;
      return 1 if $ct eq "text/xml";
      return 1 if $ct eq "application/xml";
      return 1 if $ct =~ /\+xml$/;
      return 0;
  }
  
  sub referer           {
      my $self = shift;
      if (@_ && $_[0] =~ /#/) {
  	my $uri = shift;
  	if (ref($uri)) {
  	    $uri = $uri->clone;
  	    $uri->fragment(undef);
  	}
  	else {
  	    $uri =~ s/\#.*//;
  	}
  	unshift @_, $uri;
      }
      ($self->_header('Referer', @_))[0];
  }
  *referrer = \&referer;  
  
  sub title             { (shift->_header('Title',            @_))[0] }
  sub content_encoding  { (shift->_header('Content-Encoding', @_))[0] }
  sub content_language  { (shift->_header('Content-Language', @_))[0] }
  sub content_length    { (shift->_header('Content-Length',   @_))[0] }
  
  sub user_agent        { (shift->_header('User-Agent',       @_))[0] }
  sub server            { (shift->_header('Server',           @_))[0] }
  
  sub from              { (shift->_header('From',             @_))[0] }
  sub warning           { (shift->_header('Warning',          @_))[0] }
  
  sub www_authenticate  { (shift->_header('WWW-Authenticate', @_))[0] }
  sub authorization     { (shift->_header('Authorization',    @_))[0] }
  
  sub proxy_authenticate  { (shift->_header('Proxy-Authenticate',  @_))[0] }
  sub proxy_authorization { (shift->_header('Proxy-Authorization', @_))[0] }
  
  sub authorization_basic       { shift->_basic_auth("Authorization",       @_) }
  sub proxy_authorization_basic { shift->_basic_auth("Proxy-Authorization", @_) }
  
  sub _basic_auth {
      require MIME::Base64;
      my($self, $h, $user, $passwd) = @_;
      my($old) = $self->_header($h);
      if (defined $user) {
  	Carp::croak("Basic authorization user name can't contain ':'")
  	  if $user =~ /:/;
  	$passwd = '' unless defined $passwd;
  	$self->_header($h => 'Basic ' .
                               MIME::Base64::encode("$user:$passwd", ''));
      }
      if (defined $old && $old =~ s/^\s*Basic\s+//) {
  	my $val = MIME::Base64::decode($old);
  	return $val unless wantarray;
  	return split(/:/, $val, 2);
      }
      return;
  }
  
  
  1;
  
  __END__
  
HTTP_HEADERS

$fatpacked{"HTTP/Headers/Auth.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'HTTP_HEADERS_AUTH';
  package HTTP::Headers::Auth;
  
  use strict;
  use vars qw($VERSION);
  $VERSION = "6.00";
  
  use HTTP::Headers;
  
  package HTTP::Headers;
  
  BEGIN {
      undef(&www_authenticate);
      undef(&proxy_authenticate);
  }
  
  require HTTP::Headers::Util;
  
  sub _parse_authenticate
  {
      my @ret;
      for (HTTP::Headers::Util::split_header_words(@_)) {
  	if (!defined($_->[1])) {
  	    push(@ret, shift(@$_) => {});
  	    shift @$_;
  	}
  	if (@ret) {
  	    while (@$_) {
  		my $k = shift @$_;
  		my $v = shift @$_;
  	        $ret[-1]{$k} = $v;
  	    }
  	}
  	else {
  	}
      }
      @ret;
  }
  
  sub _authenticate
  {
      my $self = shift;
      my $header = shift;
      my @old = $self->_header($header);
      if (@_) {
  	$self->remove_header($header);
  	my @new = @_;
  	while (@new) {
  	    my $a_scheme = shift(@new);
  	    if ($a_scheme =~ /\s/) {
  		$self->push_header($header, $a_scheme);
  	    }
  	    else {
  		my @param;
  		if (@new) {
  		    my $p = $new[0];
  		    if (ref($p) eq "ARRAY") {
  			@param = @$p;
  			shift(@new);
  		    }
  		    elsif (ref($p) eq "HASH") {
  			@param = %$p;
  			shift(@new);
  		    }
  		}
  		my $val = ucfirst(lc($a_scheme));
  		if (@param) {
  		    my $sep = " ";
  		    while (@param) {
  			my $k = shift @param;
  			my $v = shift @param;
  			if ($v =~ /[^0-9a-zA-Z]/ || lc($k) eq "realm") {
  			    $v =~ s,([\\\"]),\\$1,g;
  			    $v = qq("$v");
  			}
  			$val .= "$sep$k=$v";
  			$sep = ", ";
  		    }
  		}
  		$self->push_header($header, $val);
  	    }
  	}
      }
      return unless defined wantarray;
      wantarray ? _parse_authenticate(@old) : join(", ", @old);
  }
  
  
  sub www_authenticate    { shift->_authenticate("WWW-Authenticate", @_)   }
  sub proxy_authenticate  { shift->_authenticate("Proxy-Authenticate", @_) }
  
  1;
HTTP_HEADERS_AUTH

$fatpacked{"HTTP/Headers/ETag.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'HTTP_HEADERS_ETAG';
  package HTTP::Headers::ETag;
  
  use strict;
  use vars qw($VERSION);
  $VERSION = "6.00";
  
  require HTTP::Date;
  
  require HTTP::Headers;
  package HTTP::Headers;
  
  sub _etags
  {
      my $self = shift;
      my $header = shift;
      my @old = _split_etag_list($self->_header($header));
      if (@_) {
  	$self->_header($header => join(", ", _split_etag_list(@_)));
      }
      wantarray ? @old : join(", ", @old);
  }
  
  sub etag          { shift->_etags("ETag", @_); }
  sub if_match      { shift->_etags("If-Match", @_); }
  sub if_none_match { shift->_etags("If-None-Match", @_); }
  
  sub if_range {
      my $self = shift;
      my @old = $self->_header("If-Range");
      if (@_) {
  	my $new = shift;
  	if (!defined $new) {
  	    $self->remove_header("If-Range");
  	}
  	elsif ($new =~ /^\d+$/) {
  	    $self->_date_header("If-Range", $new);
  	}
  	else {
  	    $self->_etags("If-Range", $new);
  	}
      }
      return unless defined(wantarray);
      for (@old) {
  	my $t = HTTP::Date::str2time($_);
  	$_ = $t if $t;
      }
      wantarray ? @old : join(", ", @old);
  }
  
  
  
  
  sub _split_etag_list
  {
      my(@val) = @_;
      my @res;
      for (@val) {
          while (length) {
              my $weak = "";
  	    $weak = "W/" if s,^\s*[wW]/,,;
              my $etag = "";
  	    if (s/^\s*(\"[^\"\\]*(?:\\.[^\"\\]*)*\")//) {
  		push(@res, "$weak$1");
              }
              elsif (s/^\s*,//) {
                  push(@res, qq(W/"")) if $weak;
              }
              elsif (s/^\s*([^,\s]+)//) {
                  $etag = $1;
  		$etag =~ s/([\"\\])/\\$1/g;
  	        push(@res, qq($weak"$etag"));
              }
              elsif (s/^\s+// || !length) {
                  push(@res, qq(W/"")) if $weak;
              }
              else {
  	 	die "This should not happen: '$_'";
              }
          }
     }
     @res;
  }
  
  1;
HTTP_HEADERS_ETAG

$fatpacked{"HTTP/Headers/Util.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'HTTP_HEADERS_UTIL';
  package HTTP::Headers::Util;
  
  use strict;
  use vars qw($VERSION @ISA @EXPORT_OK);
  
  $VERSION = "6.03";
  
  require Exporter;
  @ISA=qw(Exporter);
  
  @EXPORT_OK=qw(split_header_words _split_header_words join_header_words);
  
  
  
  sub split_header_words {
      my @res = &_split_header_words;
      for my $arr (@res) {
  	for (my $i = @$arr - 2; $i >= 0; $i -= 2) {
  	    $arr->[$i] = lc($arr->[$i]);
  	}
      }
      return @res;
  }
  
  sub _split_header_words
  {
      my(@val) = @_;
      my @res;
      for (@val) {
  	my @cur;
  	while (length) {
  	    if (s/^\s*(=*[^\s=;,]+)//) {  
  		push(@cur, $1);
  		if (s/^\s*=\s*\"([^\"\\]*(?:\\.[^\"\\]*)*)\"//) {
  		    my $val = $1;
  		    $val =~ s/\\(.)/$1/g;
  		    push(@cur, $val);
  		}
  		elsif (s/^\s*=\s*([^;,\s]*)//) {
  		    my $val = $1;
  		    $val =~ s/\s+$//;
  		    push(@cur, $val);
  		}
  		else {
  		    push(@cur, undef);
  		}
  	    }
  	    elsif (s/^\s*,//) {
  		push(@res, [@cur]) if @cur;
  		@cur = ();
  	    }
  	    elsif (s/^\s*;// || s/^\s+//) {
  	    }
  	    else {
  		die "This should not happen: '$_'";
  	    }
  	}
  	push(@res, \@cur) if @cur;
      }
      @res;
  }
  
  
  sub join_header_words
  {
      @_ = ([@_]) if @_ && !ref($_[0]);
      my @res;
      for (@_) {
  	my @cur = @$_;
  	my @attr;
  	while (@cur) {
  	    my $k = shift @cur;
  	    my $v = shift @cur;
  	    if (defined $v) {
  		if ($v =~ /[\x00-\x20()<>@,;:\\\"\/\[\]?={}\x7F-\xFF]/ || !length($v)) {
  		    $v =~ s/([\"\\])/\\$1/g;  
  		    $k .= qq(="$v");
  		}
  		else {
  		    $k .= "=$v";
  		}
  	    }
  	    push(@attr, $k);
  	}
  	push(@res, join("; ", @attr)) if @attr;
      }
      join(", ", @res);
  }
  
  
  1;
  
  __END__
  
HTTP_HEADERS_UTIL

$fatpacked{"HTTP/Message.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'HTTP_MESSAGE';
  package HTTP::Message;
  
  use strict;
  use vars qw($VERSION $AUTOLOAD);
  $VERSION = "6.06";
  
  require HTTP::Headers;
  require Carp;
  
  my $CRLF = "\015\012";   
  unless ($HTTP::URI_CLASS) {
      if ($ENV{PERL_HTTP_URI_CLASS}
      &&  $ENV{PERL_HTTP_URI_CLASS} =~ /^([\w:]+)$/) {
          $HTTP::URI_CLASS = $1;
      } else {
          $HTTP::URI_CLASS = "URI";
      }
  }
  eval "require $HTTP::URI_CLASS"; die $@ if $@;
  
  *_utf8_downgrade = defined(&utf8::downgrade) ?
      sub {
          utf8::downgrade($_[0], 1) or
              Carp::croak("HTTP::Message content must be bytes")
      }
      :
      sub {
      };
  
  sub new
  {
      my($class, $header, $content) = @_;
      if (defined $header) {
  	Carp::croak("Bad header argument") unless ref $header;
          if (ref($header) eq "ARRAY") {
  	    $header = HTTP::Headers->new(@$header);
  	}
  	else {
  	    $header = $header->clone;
  	}
      }
      else {
  	$header = HTTP::Headers->new;
      }
      if (defined $content) {
          _utf8_downgrade($content);
      }
      else {
          $content = '';
      }
  
      bless {
  	'_headers' => $header,
  	'_content' => $content,
      }, $class;
  }
  
  
  sub parse
  {
      my($class, $str) = @_;
  
      my @hdr;
      while (1) {
  	if ($str =~ s/^([^\s:]+)[ \t]*: ?(.*)\n?//) {
  	    push(@hdr, $1, $2);
  	    $hdr[-1] =~ s/\r\z//;
  	}
  	elsif (@hdr && $str =~ s/^([ \t].*)\n?//) {
  	    $hdr[-1] .= "\n$1";
  	    $hdr[-1] =~ s/\r\z//;
  	}
  	else {
  	    $str =~ s/^\r?\n//;
  	    last;
  	}
      }
      local $HTTP::Headers::TRANSLATE_UNDERSCORE;
      new($class, \@hdr, $str);
  }
  
  
  sub clone
  {
      my $self  = shift;
      my $clone = HTTP::Message->new($self->headers,
  				   $self->content);
      $clone->protocol($self->protocol);
      $clone;
  }
  
  
  sub clear {
      my $self = shift;
      $self->{_headers}->clear;
      $self->content("");
      delete $self->{_parts};
      return;
  }
  
  
  sub protocol {
      shift->_elem('_protocol',  @_);
  }
  
  sub headers {
      my $self = shift;
  
      $self->_content unless exists $self->{_content};
  
      $self->{_headers};
  }
  
  sub headers_as_string {
      shift->headers->as_string(@_);
  }
  
  
  sub content  {
  
      my $self = $_[0];
      if (defined(wantarray)) {
  	$self->_content unless exists $self->{_content};
  	my $old = $self->{_content};
  	$old = $$old if ref($old) eq "SCALAR";
  	&_set_content if @_ > 1;
  	return $old;
      }
  
      if (@_ > 1) {
  	&_set_content;
      }
      else {
  	Carp::carp("Useless content call in void context") if $^W;
      }
  }
  
  
  sub _set_content {
      my $self = $_[0];
      _utf8_downgrade($_[1]);
      if (!ref($_[1]) && ref($self->{_content}) eq "SCALAR") {
  	${$self->{_content}} = $_[1];
      }
      else {
  	die "Can't set content to be a scalar reference" if ref($_[1]) eq "SCALAR";
  	$self->{_content} = $_[1];
  	delete $self->{_content_ref};
      }
      delete $self->{_parts} unless $_[2];
  }
  
  
  sub add_content
  {
      my $self = shift;
      $self->_content unless exists $self->{_content};
      my $chunkref = \$_[0];
      $chunkref = $$chunkref if ref($$chunkref);  
  
      _utf8_downgrade($$chunkref);
  
      my $ref = ref($self->{_content});
      if (!$ref) {
  	$self->{_content} .= $$chunkref;
      }
      elsif ($ref eq "SCALAR") {
  	${$self->{_content}} .= $$chunkref;
      }
      else {
  	Carp::croak("Can't append to $ref content");
      }
      delete $self->{_parts};
  }
  
  sub add_content_utf8 {
      my($self, $buf)  = @_;
      utf8::upgrade($buf);
      utf8::encode($buf);
      $self->add_content($buf);
  }
  
  sub content_ref
  {
      my $self = shift;
      $self->_content unless exists $self->{_content};
      delete $self->{_parts};
      my $old = \$self->{_content};
      my $old_cref = $self->{_content_ref};
      if (@_) {
  	my $new = shift;
  	Carp::croak("Setting content_ref to a non-ref") unless ref($new);
  	delete $self->{_content};  
  	$self->{_content} = $new;
  	$self->{_content_ref}++;
      }
      $old = $$old if $old_cref;
      return $old;
  }
  
  
  sub content_charset
  {
      my $self = shift;
      if (my $charset = $self->content_type_charset) {
  	return $charset;
      }
  
      my $cref = $self->decoded_content(ref => 1, charset => "none");
  
      for ($$cref) {
  	return "UTF-8"     if /^\xEF\xBB\xBF/;
  	return "UTF-32LE" if /^\xFF\xFE\x00\x00/;
  	return "UTF-32BE" if /^\x00\x00\xFE\xFF/;
  	return "UTF-16LE" if /^\xFF\xFE/;
  	return "UTF-16BE" if /^\xFE\xFF/;
      }
  
      if ($self->content_is_xml) {
  	for ($$cref) {
  	    return "UTF-32BE" if /^\x00\x00\x00</;
  	    return "UTF-32LE" if /^<\x00\x00\x00/;
  	    return "UTF-16BE" if /^(?:\x00\s)*\x00</;
  	    return "UTF-16LE" if /^(?:\s\x00)*<\x00/;
  	    if (/^\s*(<\?xml[^\x00]*?\?>)/) {
  		if ($1 =~ /\sencoding\s*=\s*(["'])(.*?)\1/) {
  		    my $enc = $2;
  		    $enc =~ s/^\s+//; $enc =~ s/\s+\z//;
  		    return $enc if $enc;
  		}
  	    }
  	}
  	return "UTF-8";
      }
      elsif ($self->content_is_html) {
  	require IO::HTML;
  	my $encoding = IO::HTML::find_charset_in($$cref, { encoding    => 1,
  	                                                   need_pragma => 0 });
  	return $encoding->mime_name if $encoding;
      }
      elsif ($self->content_type eq "application/json") {
  	for ($$cref) {
  	    return "UTF-32BE" if /^\x00\x00\x00./s;
  	    return "UTF-32LE" if /^.\x00\x00\x00/s;
  	    return "UTF-16BE" if /^\x00.\x00./s;
  	    return "UTF-16LE" if /^.\x00.\x00/s;
  	    return "UTF-8";
  	}
      }
      if ($self->content_type =~ /^text\//) {
  	for ($$cref) {
  	    if (length) {
  		return "US-ASCII" unless /[\x80-\xFF]/;
  		require Encode;
  		eval {
  		    Encode::decode_utf8($_, Encode::FB_CROAK() | Encode::LEAVE_SRC());
  		};
  		return "UTF-8" unless $@;
  		return "ISO-8859-1";
  	    }
  	}
      }
  
      return undef;
  }
  
  
  sub decoded_content
  {
      my($self, %opt) = @_;
      my $content_ref;
      my $content_ref_iscopy;
  
      eval {
  	$content_ref = $self->content_ref;
  	die "Can't decode ref content" if ref($content_ref) ne "SCALAR";
  
  	if (my $h = $self->header("Content-Encoding")) {
  	    $h =~ s/^\s+//;
  	    $h =~ s/\s+$//;
  	    for my $ce (reverse split(/\s*,\s*/, lc($h))) {
  		next unless $ce;
  		next if $ce eq "identity";
  		if ($ce eq "gzip" || $ce eq "x-gzip") {
  		    require IO::Uncompress::Gunzip;
  		    my $output;
  		    IO::Uncompress::Gunzip::gunzip($content_ref, \$output, Transparent => 0)
  			or die "Can't gunzip content: $IO::Uncompress::Gunzip::GunzipError";
  		    $content_ref = \$output;
  		    $content_ref_iscopy++;
  		}
  		elsif ($ce eq "x-bzip2" or $ce eq "bzip2") {
  		    require IO::Uncompress::Bunzip2;
  		    my $output;
  		    IO::Uncompress::Bunzip2::bunzip2($content_ref, \$output, Transparent => 0)
  			or die "Can't bunzip content: $IO::Uncompress::Bunzip2::Bunzip2Error";
  		    $content_ref = \$output;
  		    $content_ref_iscopy++;
  		}
  		elsif ($ce eq "deflate") {
  		    require IO::Uncompress::Inflate;
  		    my $output;
  		    my $status = IO::Uncompress::Inflate::inflate($content_ref, \$output, Transparent => 0);
  		    my $error = $IO::Uncompress::Inflate::InflateError;
  		    unless ($status) {
  			$output = undef;
  			require IO::Uncompress::RawInflate;
  			unless (IO::Uncompress::RawInflate::rawinflate($content_ref, \$output)) {
  			    $self->push_header("Client-Warning" =>
  				"Could not raw inflate content: $IO::Uncompress::RawInflate::RawInflateError");
  			    $output = undef;
  			}
  		    }
  		    die "Can't inflate content: $error" unless defined $output;
  		    $content_ref = \$output;
  		    $content_ref_iscopy++;
  		}
  		elsif ($ce eq "compress" || $ce eq "x-compress") {
  		    die "Can't uncompress content";
  		}
  		elsif ($ce eq "base64") {  
  		    require MIME::Base64;
  		    $content_ref = \MIME::Base64::decode($$content_ref);
  		    $content_ref_iscopy++;
  		}
  		elsif ($ce eq "quoted-printable") { 
  		    require MIME::QuotedPrint;
  		    $content_ref = \MIME::QuotedPrint::decode($$content_ref);
  		    $content_ref_iscopy++;
  		}
  		else {
  		    die "Don't know how to decode Content-Encoding '$ce'";
  		}
  	    }
  	}
  
  	if ($self->content_is_text || (my $is_xml = $self->content_is_xml)) {
  	    my $charset = lc(
  	        $opt{charset} ||
  		$self->content_type_charset ||
  		$opt{default_charset} ||
  		$self->content_charset ||
  		"ISO-8859-1"
  	    );
  	    if ($charset eq "none") {
  	    }
  	    elsif ($charset eq "us-ascii" || $charset eq "iso-8859-1") {
  		if ($$content_ref =~ /[^\x00-\x7F]/ && defined &utf8::upgrade) {
  		    unless ($content_ref_iscopy) {
  			my $copy = $$content_ref;
  			$content_ref = \$copy;
  			$content_ref_iscopy++;
  		    }
  		    utf8::upgrade($$content_ref);
  		}
  	    }
  	    else {
  		require Encode;
  		eval {
  		    $content_ref = \Encode::decode($charset, $$content_ref,
  			 ($opt{charset_strict} ? Encode::FB_CROAK() : 0) | Encode::LEAVE_SRC());
  		};
  		if ($@) {
  		    my $retried;
  		    if ($@ =~ /^Unknown encoding/) {
  			my $alt_charset = lc($opt{alt_charset} || "");
  			if ($alt_charset && $charset ne $alt_charset) {
  			    $content_ref = \Encode::decode($alt_charset, $$content_ref,
  				 ($opt{charset_strict} ? Encode::FB_CROAK() : 0) | Encode::LEAVE_SRC())
  			        unless $alt_charset eq "none";
  			    $retried++;
  			}
  		    }
  		    die unless $retried;
  		}
  		die "Encode::decode() returned undef improperly" unless defined $$content_ref;
  		if ($is_xml) {
  		    $$content_ref =~ s/^\x{FEFF}//;
  		    if ($$content_ref =~ /^(\s*<\?xml[^\x00]*?\?>)/) {
  			substr($$content_ref, 0, length($1)) =~ s/\sencoding\s*=\s*(["']).*?\1//;
  		    }
  		}
  	    }
  	}
      };
      if ($@) {
  	Carp::croak($@) if $opt{raise_error};
  	return undef;
      }
  
      return $opt{ref} ? $content_ref : $$content_ref;
  }
  
  
  sub decodable
  {
      my $self = shift;
      my @enc;
      eval {
          require IO::Uncompress::Gunzip;
          push(@enc, "gzip", "x-gzip");
      };
      eval {
          require IO::Uncompress::Inflate;
          require IO::Uncompress::RawInflate;
          push(@enc, "deflate");
      };
      eval {
          require IO::Uncompress::Bunzip2;
          push(@enc, "x-bzip2");
      };
      return wantarray ? @enc : join(", ", @enc);
  }
  
  
  sub decode
  {
      my $self = shift;
      return 1 unless $self->header("Content-Encoding");
      if (defined(my $content = $self->decoded_content(charset => "none"))) {
  	$self->remove_header("Content-Encoding", "Content-Length", "Content-MD5");
  	$self->content($content);
  	return 1;
      }
      return 0;
  }
  
  
  sub encode
  {
      my($self, @enc) = @_;
  
      Carp::croak("Can't encode multipart/* messages") if $self->content_type =~ m,^multipart/,;
      Carp::croak("Can't encode message/* messages") if $self->content_type =~ m,^message/,;
  
      return 1 unless @enc;  
  
      my $content = $self->content;
      for my $encoding (@enc) {
  	if ($encoding eq "identity") {
  	}
  	elsif ($encoding eq "base64") {
  	    require MIME::Base64;
  	    $content = MIME::Base64::encode($content);
  	}
  	elsif ($encoding eq "gzip" || $encoding eq "x-gzip") {
  	    require IO::Compress::Gzip;
  	    my $output;
  	    IO::Compress::Gzip::gzip(\$content, \$output, Minimal => 1)
  		or die "Can't gzip content: $IO::Compress::Gzip::GzipError";
  	    $content = $output;
  	}
  	elsif ($encoding eq "deflate") {
  	    require IO::Compress::Deflate;
  	    my $output;
  	    IO::Compress::Deflate::deflate(\$content, \$output)
  		or die "Can't deflate content: $IO::Compress::Deflate::DeflateError";
  	    $content = $output;
  	}
  	elsif ($encoding eq "x-bzip2") {
  	    require IO::Compress::Bzip2;
  	    my $output;
  	    IO::Compress::Bzip2::bzip2(\$content, \$output)
  		or die "Can't bzip2 content: $IO::Compress::Bzip2::Bzip2Error";
  	    $content = $output;
  	}
  	elsif ($encoding eq "rot13") {  
  	    $content =~ tr/A-Za-z/N-ZA-Mn-za-m/;
  	}
  	else {
  	    return 0;
  	}
      }
      my $h = $self->header("Content-Encoding");
      unshift(@enc, $h) if $h;
      $self->header("Content-Encoding", join(", ", @enc));
      $self->remove_header("Content-Length", "Content-MD5");
      $self->content($content);
      return 1;
  }
  
  
  sub as_string
  {
      my($self, $eol) = @_;
      $eol = "\n" unless defined $eol;
  
      my $content = $self->content;
  
      return join("", $self->{'_headers'}->as_string($eol),
  		    $eol,
  		    $content,
  		    (@_ == 1 && length($content) &&
  		     $content !~ /\n\z/) ? "\n" : "",
  		);
  }
  
  
  sub dump
  {
      my($self, %opt) = @_;
      my $content = $self->content;
      my $chopped = 0;
      if (!ref($content)) {
  	my $maxlen = $opt{maxlength};
  	$maxlen = 512 unless defined($maxlen);
  	if ($maxlen && length($content) > $maxlen * 1.1 + 3) {
  	    $chopped = length($content) - $maxlen;
  	    $content = substr($content, 0, $maxlen) . "...";
  	}
  
  	$content =~ s/\\/\\\\/g;
  	$content =~ s/\t/\\t/g;
  	$content =~ s/\r/\\r/g;
  
  	$content =~ s/([\0-\11\13-\037])(?!\d)/sprintf('\\%o',ord($1))/eg;
  
  	$content =~ s/([\0-\11\13-\037\177-\377])/sprintf('\\x%02X',ord($1))/eg;
  	$content =~ s/([^\12\040-\176])/sprintf('\\x{%X}',ord($1))/eg;
  
  	$content =~ s/( +)\n/("\\40" x length($1)) . "\n"/eg;
  	$content =~ s/(\n+)\n/("\\n" x length($1)) . "\n"/eg;
  	$content =~ s/\n\z/\\n/;
  
  	my $no_content = $opt{no_content};
  	$no_content = "(no content)" unless defined $no_content;
  	if ($content eq $no_content) {
  	    $content =~ s/^(.)/sprintf('\\x%02X',ord($1))/eg;
  	}
  	elsif ($content eq "") {
  	    $content = $no_content;
  	}
      }
  
      my @dump;
      push(@dump, $opt{preheader}) if $opt{preheader};
      push(@dump, $self->{_headers}->as_string, $content);
      push(@dump, "(+ $chopped more bytes not shown)") if $chopped;
  
      my $dump = join("\n", @dump, "");
      $dump =~ s/^/$opt{prefix}/gm if $opt{prefix};
  
      print $dump unless defined wantarray;
      return $dump;
  }
  
  
  sub parts {
      my $self = shift;
      if (defined(wantarray) && (!exists $self->{_parts} || ref($self->{_content}) eq "SCALAR")) {
  	$self->_parts;
      }
      my $old = $self->{_parts};
      if (@_) {
  	my @parts = map { ref($_) eq 'ARRAY' ? @$_ : $_ } @_;
  	my $ct = $self->content_type || "";
  	if ($ct =~ m,^message/,) {
  	    Carp::croak("Only one part allowed for $ct content")
  		if @parts > 1;
  	}
  	elsif ($ct !~ m,^multipart/,) {
  	    $self->remove_content_headers;
  	    $self->content_type("multipart/mixed");
  	}
  	$self->{_parts} = \@parts;
  	_stale_content($self);
      }
      return @$old if wantarray;
      return $old->[0];
  }
  
  sub add_part {
      my $self = shift;
      if (($self->content_type || "") !~ m,^multipart/,) {
  	my $p = HTTP::Message->new($self->remove_content_headers,
  				   $self->content(""));
  	$self->content_type("multipart/mixed");
  	$self->{_parts} = [];
          if ($p->headers->header_field_names || $p->content ne "") {
              push(@{$self->{_parts}}, $p);
          }
      }
      elsif (!exists $self->{_parts} || ref($self->{_content}) eq "SCALAR") {
  	$self->_parts;
      }
  
      push(@{$self->{_parts}}, @_);
      _stale_content($self);
      return;
  }
  
  sub _stale_content {
      my $self = shift;
      if (ref($self->{_content}) eq "SCALAR") {
  	$self->_content;
      }
      else {
  	delete $self->{_content};
  	delete $self->{_content_ref};
      }
  }
  
  
  sub AUTOLOAD
  {
      my $method = substr($AUTOLOAD, rindex($AUTOLOAD, '::')+2);
  
      no strict 'refs';
      *$method = sub { local $Carp::Internal{+__PACKAGE__} = 1; shift->headers->$method(@_) };
      goto &$method;
  }
  
  
  sub DESTROY {}  
  
  
  sub _elem
  {
      my $self = shift;
      my $elem = shift;
      my $old = $self->{$elem};
      $self->{$elem} = $_[0] if @_;
      return $old;
  }
  
  
  sub _parts {
      my $self = shift;
      my $ct = $self->content_type;
      if ($ct =~ m,^multipart/,) {
  	require HTTP::Headers::Util;
  	my @h = HTTP::Headers::Util::split_header_words($self->header("Content-Type"));
  	die "Assert" unless @h;
  	my %h = @{$h[0]};
  	if (defined(my $b = $h{boundary})) {
  	    my $str = $self->content;
  	    $str =~ s/\r?\n--\Q$b\E--.*//s;
  	    if ($str =~ s/(^|.*?\r?\n)--\Q$b\E\r?\n//s) {
  		$self->{_parts} = [map HTTP::Message->parse($_),
  				   split(/\r?\n--\Q$b\E\r?\n/, $str)]
  	    }
  	}
      }
      elsif ($ct eq "message/http") {
  	require HTTP::Request;
  	require HTTP::Response;
  	my $content = $self->content;
  	my $class = ($content =~ m,^(HTTP/.*)\n,) ?
  	    "HTTP::Response" : "HTTP::Request";
  	$self->{_parts} = [$class->parse($content)];
      }
      elsif ($ct =~ m,^message/,) {
  	$self->{_parts} = [ HTTP::Message->parse($self->content) ];
      }
  
      $self->{_parts} ||= [];
  }
  
  
  sub _content {
      my $self = shift;
      my $ct = $self->{_headers}->header("Content-Type") || "multipart/mixed";
      if ($ct =~ m,^\s*message/,i) {
  	_set_content($self, $self->{_parts}[0]->as_string($CRLF), 1);
  	return;
      }
  
      require HTTP::Headers::Util;
      my @v = HTTP::Headers::Util::split_header_words($ct);
      Carp::carp("Multiple Content-Type headers") if @v > 1;
      @v = @{$v[0]};
  
      my $boundary;
      my $boundary_index;
      for (my @tmp = @v; @tmp;) {
  	my($k, $v) = splice(@tmp, 0, 2);
  	if ($k eq "boundary") {
  	    $boundary = $v;
  	    $boundary_index = @v - @tmp - 1;
  	    last;
  	}
      }
  
      my @parts = map $_->as_string($CRLF), @{$self->{_parts}};
  
      my $bno = 0;
      $boundary = _boundary() unless defined $boundary;
   CHECK_BOUNDARY:
      {
  	for (@parts) {
  	    if (index($_, $boundary) >= 0) {
  		$boundary = _boundary(++$bno);
  		redo CHECK_BOUNDARY;
  	    }
  	}
      }
  
      if ($boundary_index) {
  	$v[$boundary_index] = $boundary;
      }
      else {
  	push(@v, boundary => $boundary);
      }
  
      $ct = HTTP::Headers::Util::join_header_words(@v);
      $self->{_headers}->header("Content-Type", $ct);
  
      _set_content($self, "--$boundary$CRLF" .
  	                join("$CRLF--$boundary$CRLF", @parts) .
  			"$CRLF--$boundary--$CRLF",
                          1);
  }
  
  
  sub _boundary
  {
      my $size = shift || return "xYzZY";
      require MIME::Base64;
      my $b = MIME::Base64::encode(join("", map chr(rand(256)), 1..$size*3), "");
      $b =~ s/[\W]/X/g;  
      $b;
  }
  
  
  1;
  
  
  __END__
  
HTTP_MESSAGE

$fatpacked{"HTTP/Request.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'HTTP_REQUEST';
  package HTTP::Request;
  
  require HTTP::Message;
  @ISA = qw(HTTP::Message);
  $VERSION = "6.00";
  
  use strict;
  
  
  
  sub new
  {
      my($class, $method, $uri, $header, $content) = @_;
      my $self = $class->SUPER::new($header, $content);
      $self->method($method);
      $self->uri($uri);
      $self;
  }
  
  
  sub parse
  {
      my($class, $str) = @_;
      my $request_line;
      if ($str =~ s/^(.*)\n//) {
  	$request_line = $1;
      }
      else {
  	$request_line = $str;
  	$str = "";
      }
  
      my $self = $class->SUPER::parse($str);
      my($method, $uri, $protocol) = split(' ', $request_line);
      $self->method($method) if defined($method);
      $self->uri($uri) if defined($uri);
      $self->protocol($protocol) if $protocol;
      $self;
  }
  
  
  sub clone
  {
      my $self = shift;
      my $clone = bless $self->SUPER::clone, ref($self);
      $clone->method($self->method);
      $clone->uri($self->uri);
      $clone;
  }
  
  
  sub method
  {
      shift->_elem('_method', @_);
  }
  
  
  sub uri
  {
      my $self = shift;
      my $old = $self->{'_uri'};
      if (@_) {
  	my $uri = shift;
  	if (!defined $uri) {
  	}
  	elsif (ref $uri) {
  	    Carp::croak("A URI can't be a " . ref($uri) . " reference")
  		if ref($uri) eq 'HASH' or ref($uri) eq 'ARRAY';
  	    Carp::croak("Can't use a " . ref($uri) . " object as a URI")
  		unless $uri->can('scheme');
  	    $uri = $uri->clone;
  	    unless ($HTTP::URI_CLASS eq "URI") {
  		eval { local $SIG{__DIE__}; $uri = $uri->abs; };
  		die $@ if $@ && $@ !~ /Missing base argument/;
  	    }
  	}
  	else {
  	    $uri = $HTTP::URI_CLASS->new($uri);
  	}
  	$self->{'_uri'} = $uri;
          delete $self->{'_uri_canonical'};
      }
      $old;
  }
  
  *url = \&uri;  
  
  sub uri_canonical
  {
      my $self = shift;
      return $self->{'_uri_canonical'} ||= $self->{'_uri'}->canonical;
  }
  
  
  sub accept_decodable
  {
      my $self = shift;
      $self->header("Accept-Encoding", scalar($self->decodable));
  }
  
  sub as_string
  {
      my $self = shift;
      my($eol) = @_;
      $eol = "\n" unless defined $eol;
  
      my $req_line = $self->method || "-";
      my $uri = $self->uri;
      $uri = (defined $uri) ? $uri->as_string : "-";
      $req_line .= " $uri";
      my $proto = $self->protocol;
      $req_line .= " $proto" if $proto;
  
      return join($eol, $req_line, $self->SUPER::as_string(@_));
  }
  
  sub dump
  {
      my $self = shift;
      my @pre = ($self->method || "-", $self->uri || "-");
      if (my $prot = $self->protocol) {
  	push(@pre, $prot);
      }
  
      return $self->SUPER::dump(
          preheader => join(" ", @pre),
  	@_,
      );
  }
  
  
  1;
  
  __END__
  
HTTP_REQUEST

$fatpacked{"HTTP/Request/Common.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'HTTP_REQUEST_COMMON';
  package HTTP::Request::Common;
  
  use strict;
  use vars qw(@EXPORT @EXPORT_OK $VERSION $DYNAMIC_FILE_UPLOAD);
  
  $DYNAMIC_FILE_UPLOAD ||= 0;  
  
  require Exporter;
  *import = \&Exporter::import;
  @EXPORT =qw(GET HEAD PUT POST);
  @EXPORT_OK = qw($DYNAMIC_FILE_UPLOAD DELETE);
  
  require HTTP::Request;
  use Carp();
  
  $VERSION = "6.04";
  
  my $CRLF = "\015\012";   
  
  sub GET  { _simple_req('GET',  @_); }
  sub HEAD { _simple_req('HEAD', @_); }
  sub PUT  { _simple_req('PUT' , @_); }
  sub DELETE { _simple_req('DELETE', @_); }
  
  sub POST
  {
      my $url = shift;
      my $req = HTTP::Request->new(POST => $url);
      my $content;
      $content = shift if @_ and ref $_[0];
      my($k, $v);
      while (($k,$v) = splice(@_, 0, 2)) {
  	if (lc($k) eq 'content') {
  	    $content = $v;
  	}
  	else {
  	    $req->push_header($k, $v);
  	}
      }
      my $ct = $req->header('Content-Type');
      unless ($ct) {
  	$ct = 'application/x-www-form-urlencoded';
      }
      elsif ($ct eq 'form-data') {
  	$ct = 'multipart/form-data';
      }
  
      if (ref $content) {
  	if ($ct =~ m,^multipart/form-data\s*(;|$),i) {
  	    require HTTP::Headers::Util;
  	    my @v = HTTP::Headers::Util::split_header_words($ct);
  	    Carp::carp("Multiple Content-Type headers") if @v > 1;
  	    @v = @{$v[0]};
  
  	    my $boundary;
  	    my $boundary_index;
  	    for (my @tmp = @v; @tmp;) {
  		my($k, $v) = splice(@tmp, 0, 2);
  		if ($k eq "boundary") {
  		    $boundary = $v;
  		    $boundary_index = @v - @tmp - 1;
  		    last;
  		}
  	    }
  
  	    ($content, $boundary) = form_data($content, $boundary, $req);
  
  	    if ($boundary_index) {
  		$v[$boundary_index] = $boundary;
  	    }
  	    else {
  		push(@v, boundary => $boundary);
  	    }
  
  	    $ct = HTTP::Headers::Util::join_header_words(@v);
  	}
  	else {
  	    require URI;
  	    my $url = URI->new('http:');
  	    $url->query_form(ref($content) eq "HASH" ? %$content : @$content);
  	    $content = $url->query;
  
  	    $content =~ s/(?<!%0D)%0A/%0D%0A/g if defined($content);
  	}
      }
  
      $req->header('Content-Type' => $ct);  
      if (defined($content)) {
  	$req->header('Content-Length' =>
  		     length($content)) unless ref($content);
  	$req->content($content);
      }
      else {
          $req->header('Content-Length' => 0);
      }
      $req;
  }
  
  
  sub _simple_req
  {
      my($method, $url) = splice(@_, 0, 2);
      my $req = HTTP::Request->new($method => $url);
      my($k, $v);
      my $content;
      while (($k,$v) = splice(@_, 0, 2)) {
  	if (lc($k) eq 'content') {
  	    $req->add_content($v);
              $content++;
  	}
  	else {
  	    $req->push_header($k, $v);
  	}
      }
      if ($content && !defined($req->header("Content-Length"))) {
          $req->header("Content-Length", length(${$req->content_ref}));
      }
      $req;
  }
  
  
  sub form_data   
  {
      my($data, $boundary, $req) = @_;
      my @data = ref($data) eq "HASH" ? %$data : @$data;  
      my $fhparts;
      my @parts;
      my($k,$v);
      while (($k,$v) = splice(@data, 0, 2)) {
  	if (!ref($v)) {
  	    $k =~ s/([\\\"])/\\$1/g;  
  	    push(@parts,
  		 qq(Content-Disposition: form-data; name="$k"$CRLF$CRLF$v));
  	}
  	else {
  	    my($file, $usename, @headers) = @$v;
  	    unless (defined $usename) {
  		$usename = $file;
  		$usename =~ s,.*/,, if defined($usename);
  	    }
              $k =~ s/([\\\"])/\\$1/g;
  	    my $disp = qq(form-data; name="$k");
              if (defined($usename) and length($usename)) {
                  $usename =~ s/([\\\"])/\\$1/g;
                  $disp .= qq(; filename="$usename");
              }
  	    my $content = "";
  	    my $h = HTTP::Headers->new(@headers);
  	    if ($file) {
  		open(my $fh, "<", $file) or Carp::croak("Can't open file $file: $!");
  		binmode($fh);
  		if ($DYNAMIC_FILE_UPLOAD) {
                      close($fh);
  		    $content = \$file;
  		}
  		else {
  		    local($/) = undef; 
  		    $content = <$fh>;
  		    close($fh);
  		}
  		unless ($h->header("Content-Type")) {
  		    require LWP::MediaTypes;
  		    LWP::MediaTypes::guess_media_type($file, $h);
  		}
  	    }
  	    if ($h->header("Content-Disposition")) {
  		$disp = $h->header("Content-Disposition");
  		$h->remove_header("Content-Disposition");
  	    }
  	    if ($h->header("Content")) {
  		$content = $h->header("Content");
  		$h->remove_header("Content");
  	    }
  	    my $head = join($CRLF, "Content-Disposition: $disp",
  			           $h->as_string($CRLF),
  			           "");
  	    if (ref $content) {
  		push(@parts, [$head, $$content]);
  		$fhparts++;
  	    }
  	    else {
  		push(@parts, $head . $content);
  	    }
  	}
      }
      return ("", "none") unless @parts;
  
      my $content;
      if ($fhparts) {
  	$boundary = boundary(10) 
  	    unless $boundary;
  
  	for (1..@parts-1) {
  	    splice(@parts, $_*2-1, 0, "$CRLF--$boundary$CRLF");
  	}
  	unshift(@parts, "--$boundary$CRLF");
  	push(@parts, "$CRLF--$boundary--$CRLF");
  
  	my $length = 0;
  	for (@parts) {
  	    if (ref $_) {
  	 	my ($head, $f) = @$_;
  		my $file_size;
  		unless ( -f $f && ($file_size = -s _) ) {
  		    undef $length;
  		    last;
  		}
  	    	$length += $file_size + length $head;
  	    }
  	    else {
  		$length += length;
  	    }
          }
          $length && $req->header('Content-Length' => $length);
  
  	$content = sub {
  	    for (;;) {
  		unless (@parts) {
  		    defined $length && $length != 0 &&
  		    	Carp::croak "length of data sent did not match calculated Content-Length header.  Probably because uploaded file changed in size during transfer.";
  		    return;
  		}
  		my $p = shift @parts;
  		unless (ref $p) {
  		    $p .= shift @parts while @parts && !ref($parts[0]);
  		    defined $length && ($length -= length $p);
  		    return $p;
  		}
  		my($buf, $fh) = @$p;
                  unless (ref($fh)) {
                      my $file = $fh;
                      undef($fh);
                      open($fh, "<", $file) || Carp::croak("Can't open file $file: $!");
                      binmode($fh);
                  }
  		my $buflength = length $buf;
  		my $n = read($fh, $buf, 2048, $buflength);
  		if ($n) {
  		    $buflength += $n;
  		    unshift(@parts, ["", $fh]);
  		}
  		else {
  		    close($fh);
  		}
  		if ($buflength) {
  		    defined $length && ($length -= $buflength);
  		    return $buf 
  	    	}
  	    }
  	};
  
      }
      else {
  	$boundary = boundary() unless $boundary;
  
  	my $bno = 0;
        CHECK_BOUNDARY:
  	{
  	    for (@parts) {
  		if (index($_, $boundary) >= 0) {
  		    $boundary = boundary(++$bno);
  		    redo CHECK_BOUNDARY;
  		}
  	    }
  	    last;
  	}
  	$content = "--$boundary$CRLF" .
  	           join("$CRLF--$boundary$CRLF", @parts) .
  		   "$CRLF--$boundary--$CRLF";
      }
  
      wantarray ? ($content, $boundary) : $content;
  }
  
  
  sub boundary
  {
      my $size = shift || return "xYzZY";
      require MIME::Base64;
      my $b = MIME::Base64::encode(join("", map chr(rand(256)), 1..$size*3), "");
      $b =~ s/[\W]/X/g;  
      $b;
  }
  
  1;
  
  __END__
  
  
HTTP_REQUEST_COMMON

$fatpacked{"HTTP/Response.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'HTTP_RESPONSE';
  package HTTP::Response;
  
  require HTTP::Message;
  @ISA = qw(HTTP::Message);
  $VERSION = "6.04";
  
  use strict;
  use HTTP::Status ();
  
  
  
  sub new
  {
      my($class, $rc, $msg, $header, $content) = @_;
      my $self = $class->SUPER::new($header, $content);
      $self->code($rc);
      $self->message($msg);
      $self;
  }
  
  
  sub parse
  {
      my($class, $str) = @_;
      my $status_line;
      if ($str =~ s/^(.*)\n//) {
  	$status_line = $1;
      }
      else {
  	$status_line = $str;
  	$str = "";
      }
  
      my $self = $class->SUPER::parse($str);
      my($protocol, $code, $message);
      if ($status_line =~ /^\d{3} /) {
         ($code, $message) = split(' ', $status_line, 2);
      } else {
         ($protocol, $code, $message) = split(' ', $status_line, 3);
      }
      $self->protocol($protocol) if $protocol;
      $self->code($code) if defined($code);
      $self->message($message) if defined($message);
      $self;
  }
  
  
  sub clone
  {
      my $self = shift;
      my $clone = bless $self->SUPER::clone, ref($self);
      $clone->code($self->code);
      $clone->message($self->message);
      $clone->request($self->request->clone) if $self->request;
      $clone;
  }
  
  
  sub code      { shift->_elem('_rc',      @_); }
  sub message   { shift->_elem('_msg',     @_); }
  sub previous  { shift->_elem('_previous',@_); }
  sub request   { shift->_elem('_request', @_); }
  
  
  sub status_line
  {
      my $self = shift;
      my $code = $self->{'_rc'}  || "000";
      my $mess = $self->{'_msg'} || HTTP::Status::status_message($code) || "Unknown code";
      return "$code $mess";
  }
  
  
  sub base
  {
      my $self = shift;
      my $base = (
  	$self->header('Content-Base'),        
  	$self->header('Content-Location'),    
  	$self->header('Base'),                
      )[0];
      if ($base && $base =~ /^$URI::scheme_re:/o) {
  	return $HTTP::URI_CLASS->new($base);
      }
  
      my $req = $self->request;
      if ($req) {
          return $HTTP::URI_CLASS->new_abs($base, $req->uri);
      }
  
      return undef;
  }
  
  
  sub redirects {
      my $self = shift;
      my @r;
      my $r = $self;
      while (my $p = $r->previous) {
          push(@r, $p);
          $r = $p;
      }
      return @r unless wantarray;
      return reverse @r;
  }
  
  
  sub filename
  {
      my $self = shift;
      my $file;
  
      my $cd = $self->header('Content-Disposition');
      if ($cd) {
  	require HTTP::Headers::Util;
  	if (my @cd = HTTP::Headers::Util::split_header_words($cd)) {
  	    my ($disposition, undef, %cd_param) = @{$cd[-1]};
  	    $file = $cd_param{filename};
  
  	    if ($file && $file =~ /^=\?(.+?)\?(.+?)\?(.+)\?=$/) {
  		my $charset = $1;
  		my $encoding = uc($2);
  		my $encfile = $3;
  
  		if ($encoding eq 'Q' || $encoding eq 'B') {
  		    local($SIG{__DIE__});
  		    eval {
  			if ($encoding eq 'Q') {
  			    $encfile =~ s/_/ /g;
  			    require MIME::QuotedPrint;
  			    $encfile = MIME::QuotedPrint::decode($encfile);
  			}
  			else { 
  			    require MIME::Base64;
  			    $encfile = MIME::Base64::decode($encfile);
  			}
  
  			require Encode;
  			require Encode::Locale;
  			Encode::from_to($encfile, $charset, "locale_fs");
  		    };
  
  		    $file = $encfile unless $@;
  		}
  	    }
  	}
      }
  
      unless (defined($file) && length($file)) {
  	my $uri;
  	if (my $cl = $self->header('Content-Location')) {
  	    $uri = URI->new($cl);
  	}
  	elsif (my $request = $self->request) {
  	    $uri = $request->uri;
  	}
  
  	if ($uri) {
  	    $file = ($uri->path_segments)[-1];
  	}
      }
  
      if ($file) {
  	$file =~ s,.*[\\/],,;  
      }
  
      if ($file && !length($file)) {
  	$file = undef;
      }
  
      $file;
  }
  
  
  sub as_string
  {
      my $self = shift;
      my($eol) = @_;
      $eol = "\n" unless defined $eol;
  
      my $status_line = $self->status_line;
      my $proto = $self->protocol;
      $status_line = "$proto $status_line" if $proto;
  
      return join($eol, $status_line, $self->SUPER::as_string(@_));
  }
  
  
  sub dump
  {
      my $self = shift;
  
      my $status_line = $self->status_line;
      my $proto = $self->protocol;
      $status_line = "$proto $status_line" if $proto;
  
      return $self->SUPER::dump(
  	preheader => $status_line,
          @_,
      );
  }
  
  
  sub is_info     { HTTP::Status::is_info     (shift->{'_rc'}); }
  sub is_success  { HTTP::Status::is_success  (shift->{'_rc'}); }
  sub is_redirect { HTTP::Status::is_redirect (shift->{'_rc'}); }
  sub is_error    { HTTP::Status::is_error    (shift->{'_rc'}); }
  
  
  sub error_as_HTML
  {
      my $self = shift;
      my $title = 'An Error Occurred';
      my $body  = $self->status_line;
      $body =~ s/&/&amp;/g;
      $body =~ s/</&lt;/g;
      return <<EOM;
  <html>
  <head><title>$title</title></head>
  <body>
  <h1>$title</h1>
  <p>$body</p>
  </body>
  </html>
  EOM
  }
  
  
  sub current_age
  {
      my $self = shift;
      my $time = shift;
  
      my $response_time = $self->client_date;
      my $date = $self->date;
  
      my $age = 0;
      if ($response_time && $date) {
  	$age = $response_time - $date;  
  	$age = 0 if $age < 0;
      }
  
      my $age_v = $self->header('Age');
      if ($age_v && $age_v > $age) {
  	$age = $age_v;   
      }
  
      if ($response_time) {
  	my $request = $self->request;
  	if ($request) {
  	    my $request_time = $request->date;
  	    if ($request_time && $request_time < $response_time) {
  		$age += $response_time - $request_time;
  	    }
  	}
  	$age += ($time || time) - $response_time;
      }
      return $age;
  }
  
  
  sub freshness_lifetime
  {
      my($self, %opt) = @_;
  
      for my $cc ($self->header('Cache-Control')) {
  	for my $cc_dir (split(/\s*,\s*/, $cc)) {
  	    return $1 if $cc_dir =~ /^max-age\s*=\s*(\d+)/i;
  	}
      }
  
      my $date = $self->date || $self->client_date || $opt{time} || time;
      if (my $expires = $self->expires) {
  	return $expires - $date;
      }
  
      return undef if exists $opt{heuristic_expiry} && !$opt{heuristic_expiry};
  
      $opt{h_min} ||= 60;
      $opt{h_max} ||= 24 * 3600;
      $opt{h_lastmod_fraction} ||= 0.10; 
      $opt{h_default} ||= 3600;
  
  
      if (my $last_modified = $self->last_modified) {
  	my $h_exp = ($date - $last_modified) * $opt{h_lastmod_fraction};
  	return $opt{h_min} if $h_exp < $opt{h_min};
  	return $opt{h_max} if $h_exp > $opt{h_max};
  	return $h_exp;
      }
  
      return $opt{h_min} if $opt{h_min} > $opt{h_default};
      return $opt{h_default};
  }
  
  
  sub is_fresh
  {
      my($self, %opt) = @_;
      $opt{time} ||= time;
      my $f = $self->freshness_lifetime(%opt);
      return undef unless defined($f);
      return $f > $self->current_age($opt{time});
  }
  
  
  sub fresh_until
  {
      my($self, %opt) = @_;
      $opt{time} ||= time;
      my $f = $self->freshness_lifetime(%opt);
      return undef unless defined($f);
      return $f - $self->current_age($opt{time}) + $opt{time};
  }
  
  1;
  
  
  __END__
  
HTTP_RESPONSE

$fatpacked{"HTTP/Status.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'HTTP_STATUS';
  package HTTP::Status;
  
  use strict;
  require 5.002;   
  
  use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);
  
  require Exporter;
  @ISA = qw(Exporter);
  @EXPORT = qw(is_info is_success is_redirect is_error status_message);
  @EXPORT_OK = qw(is_client_error is_server_error);
  $VERSION = "6.03";
  
  
  
  my %StatusCode = (
      100 => 'Continue',
      101 => 'Switching Protocols',
      102 => 'Processing',                      
      200 => 'OK',
      201 => 'Created',
      202 => 'Accepted',
      203 => 'Non-Authoritative Information',
      204 => 'No Content',
      205 => 'Reset Content',
      206 => 'Partial Content',
      207 => 'Multi-Status',                    
      208 => 'Already Reported',		      
      300 => 'Multiple Choices',
      301 => 'Moved Permanently',
      302 => 'Found',
      303 => 'See Other',
      304 => 'Not Modified',
      305 => 'Use Proxy',
      307 => 'Temporary Redirect',
      400 => 'Bad Request',
      401 => 'Unauthorized',
      402 => 'Payment Required',
      403 => 'Forbidden',
      404 => 'Not Found',
      405 => 'Method Not Allowed',
      406 => 'Not Acceptable',
      407 => 'Proxy Authentication Required',
      408 => 'Request Timeout',
      409 => 'Conflict',
      410 => 'Gone',
      411 => 'Length Required',
      412 => 'Precondition Failed',
      413 => 'Request Entity Too Large',
      414 => 'Request-URI Too Large',
      415 => 'Unsupported Media Type',
      416 => 'Request Range Not Satisfiable',
      417 => 'Expectation Failed',
      418 => 'I\'m a teapot',		      
      422 => 'Unprocessable Entity',            
      423 => 'Locked',                          
      424 => 'Failed Dependency',               
      425 => 'No code',                         
      426 => 'Upgrade Required',                
      428 => 'Precondition Required',
      429 => 'Too Many Requests',
      431 => 'Request Header Fields Too Large',
      449 => 'Retry with',                      
      500 => 'Internal Server Error',
      501 => 'Not Implemented',
      502 => 'Bad Gateway',
      503 => 'Service Unavailable',
      504 => 'Gateway Timeout',
      505 => 'HTTP Version Not Supported',
      506 => 'Variant Also Negotiates',         
      507 => 'Insufficient Storage',            
      509 => 'Bandwidth Limit Exceeded',        
      510 => 'Not Extended',                    
      511 => 'Network Authentication Required',
  );
  
  my $mnemonicCode = '';
  my ($code, $message);
  while (($code, $message) = each %StatusCode) {
      $message =~ s/I'm/I am/;
      $message =~ tr/a-z \-/A-Z__/;
      $mnemonicCode .= "sub HTTP_$message () { $code }\n";
      $mnemonicCode .= "*RC_$message = \\&HTTP_$message;\n";  
      $mnemonicCode .= "push(\@EXPORT_OK, 'HTTP_$message');\n";
      $mnemonicCode .= "push(\@EXPORT, 'RC_$message');\n";
  }
  eval $mnemonicCode; 
  die if $@;
  
  *RC_MOVED_TEMPORARILY = \&RC_FOUND;  
  push(@EXPORT, "RC_MOVED_TEMPORARILY");
  
  %EXPORT_TAGS = (
     constants => [grep /^HTTP_/, @EXPORT_OK],
     is => [grep /^is_/, @EXPORT, @EXPORT_OK],
  );
  
  
  sub status_message  ($) { $StatusCode{$_[0]}; }
  
  sub is_info         ($) { $_[0] >= 100 && $_[0] < 200; }
  sub is_success      ($) { $_[0] >= 200 && $_[0] < 300; }
  sub is_redirect     ($) { $_[0] >= 300 && $_[0] < 400; }
  sub is_error        ($) { $_[0] >= 400 && $_[0] < 600; }
  sub is_client_error ($) { $_[0] >= 400 && $_[0] < 500; }
  sub is_server_error ($) { $_[0] >= 500 && $_[0] < 600; }
  
  1;
  
  
  __END__
  
HTTP_STATUS

$fatpacked{"HTTP/Tiny.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'HTTP_TINY';
  package HTTP::Tiny;
  use strict;
  use warnings;
  
  our $VERSION = '0.054';
  
  use Carp ();
  
  
  my @attributes;
  BEGIN {
      @attributes = qw(
          cookie_jar default_headers http_proxy https_proxy keep_alive
          local_address max_redirect max_size proxy no_proxy timeout
          SSL_options verify_SSL
      );
      my %persist_ok = map {; $_ => 1 } qw(
          cookie_jar default_headers max_redirect max_size
      );
      no strict 'refs';
      no warnings 'uninitialized';
      for my $accessor ( @attributes ) {
          *{$accessor} = sub {
              @_ > 1
                  ? do {
                      delete $_[0]->{handle} if !$persist_ok{$accessor} && $_[1] ne $_[0]->{$accessor};
                      $_[0]->{$accessor} = $_[1]
                  }
                  : $_[0]->{$accessor};
          };
      }
  }
  
  sub agent {
      my($self, $agent) = @_;
      if( @_ > 1 ){
          $self->{agent} =
              (defined $agent && $agent =~ / $/) ? $agent . $self->_agent : $agent;
      }
      return $self->{agent};
  }
  
  sub new {
      my($class, %args) = @_;
  
      my $self = {
          max_redirect => 5,
          timeout      => 60,
          keep_alive   => 1,
          verify_SSL   => $args{verify_SSL} || $args{verify_ssl} || 0, 
          no_proxy     => $ENV{no_proxy},
      };
  
      bless $self, $class;
  
      $class->_validate_cookie_jar( $args{cookie_jar} ) if $args{cookie_jar};
  
      for my $key ( @attributes ) {
          $self->{$key} = $args{$key} if exists $args{$key}
      }
  
      $self->agent( exists $args{agent} ? $args{agent} : $class->_agent );
  
      $self->_set_proxies;
  
      return $self;
  }
  
  sub _set_proxies {
      my ($self) = @_;
  
  
      if (! exists $self->{proxy} ) {
          $self->{proxy} = $ENV{all_proxy} || $ENV{ALL_PROXY};
      }
  
      if ( defined $self->{proxy} ) {
          $self->_split_proxy( 'generic proxy' => $self->{proxy} ); 
      }
      else {
          delete $self->{proxy};
      }
  
      if (! exists $self->{http_proxy} ) {
          local $ENV{HTTP_PROXY} if $ENV{REQUEST_METHOD};
          $self->{http_proxy} = $ENV{http_proxy} || $ENV{HTTP_PROXY} || $self->{proxy};
      }
  
      if ( defined $self->{http_proxy} ) {
          $self->_split_proxy( http_proxy => $self->{http_proxy} ); 
          $self->{_has_proxy}{http} = 1;
      }
      else {
          delete $self->{http_proxy};
      }
  
      if (! exists $self->{https_proxy} ) {
          $self->{https_proxy} = $ENV{https_proxy} || $ENV{HTTPS_PROXY} || $self->{proxy};
      }
  
      if ( $self->{https_proxy} ) {
          $self->_split_proxy( https_proxy => $self->{https_proxy} ); 
          $self->{_has_proxy}{https} = 1;
      }
      else {
          delete $self->{https_proxy};
      }
  
      unless ( ref $self->{no_proxy} eq 'ARRAY' ) {
          $self->{no_proxy} =
              (defined $self->{no_proxy}) ? [ split /\s*,\s*/, $self->{no_proxy} ] : [];
      }
  
      return;
  }
  
  
  for my $sub_name ( qw/get head put post delete/ ) {
      my $req_method = uc $sub_name;
      no strict 'refs';
      eval <<"HERE"; 
      sub $sub_name {
          my (\$self, \$url, \$args) = \@_;
          \@_ == 2 || (\@_ == 3 && ref \$args eq 'HASH')
          or Carp::croak(q/Usage: \$http->$sub_name(URL, [HASHREF])/ . "\n");
          return \$self->request('$req_method', \$url, \$args || {});
      }
  HERE
  }
  
  
  sub post_form {
      my ($self, $url, $data, $args) = @_;
      (@_ == 3 || @_ == 4 && ref $args eq 'HASH')
          or Carp::croak(q/Usage: $http->post_form(URL, DATAREF, [HASHREF])/ . "\n");
  
      my $headers = {};
      while ( my ($key, $value) = each %{$args->{headers} || {}} ) {
          $headers->{lc $key} = $value;
      }
      delete $args->{headers};
  
      return $self->request('POST', $url, {
              %$args,
              content => $self->www_form_urlencode($data),
              headers => {
                  %$headers,
                  'content-type' => 'application/x-www-form-urlencoded'
              },
          }
      );
  }
  
  
  sub mirror {
      my ($self, $url, $file, $args) = @_;
      @_ == 3 || (@_ == 4 && ref $args eq 'HASH')
        or Carp::croak(q/Usage: $http->mirror(URL, FILE, [HASHREF])/ . "\n");
      if ( -e $file and my $mtime = (stat($file))[9] ) {
          $args->{headers}{'if-modified-since'} ||= $self->_http_date($mtime);
      }
      my $tempfile = $file . int(rand(2**31));
  
      require Fcntl;
      sysopen my $fh, $tempfile, Fcntl::O_CREAT()|Fcntl::O_EXCL()|Fcntl::O_WRONLY()
         or Carp::croak(qq/Error: Could not create temporary file $tempfile for downloading: $!\n/);
      binmode $fh;
      $args->{data_callback} = sub { print {$fh} $_[0] };
      my $response = $self->request('GET', $url, $args);
      close $fh
          or Carp::croak(qq/Error: Caught error closing temporary file $tempfile: $!\n/);
  
      if ( $response->{success} ) {
          rename $tempfile, $file
              or Carp::croak(qq/Error replacing $file with $tempfile: $!\n/);
          my $lm = $response->{headers}{'last-modified'};
          if ( $lm and my $mtime = $self->_parse_http_date($lm) ) {
              utime $mtime, $mtime, $file;
          }
      }
      $response->{success} ||= $response->{status} eq '304';
      unlink $tempfile;
      return $response;
  }
  
  
  my %idempotent = map { $_ => 1 } qw/GET HEAD PUT DELETE OPTIONS TRACE/;
  
  sub request {
      my ($self, $method, $url, $args) = @_;
      @_ == 3 || (@_ == 4 && ref $args eq 'HASH')
        or Carp::croak(q/Usage: $http->request(METHOD, URL, [HASHREF])/ . "\n");
      $args ||= {}; 
  
      my $response;
      for ( 0 .. 1 ) {
          $response = eval { $self->_request($method, $url, $args) };
          last unless $@ && $idempotent{$method}
              && $@ =~ m{^(?:Socket closed|Unexpected end)};
      }
  
      if (my $e = $@) {
          if ( ref $e eq 'HASH' && exists $e->{status} ) {
              return $e;
          }
  
          $e = "$e";
          $response = {
              url     => $url,
              success => q{},
              status  => 599,
              reason  => 'Internal Exception',
              content => $e,
              headers => {
                  'content-type'   => 'text/plain',
                  'content-length' => length $e,
              }
          };
      }
      return $response;
  }
  
  
  sub www_form_urlencode {
      my ($self, $data) = @_;
      (@_ == 2 && ref $data)
          or Carp::croak(q/Usage: $http->www_form_urlencode(DATAREF)/ . "\n");
      (ref $data eq 'HASH' || ref $data eq 'ARRAY')
          or Carp::croak("form data must be a hash or array reference\n");
  
      my @params = ref $data eq 'HASH' ? %$data : @$data;
      @params % 2 == 0
          or Carp::croak("form data reference must have an even number of terms\n");
  
      my @terms;
      while( @params ) {
          my ($key, $value) = splice(@params, 0, 2);
          if ( ref $value eq 'ARRAY' ) {
              unshift @params, map { $key => $_ } @$value;
          }
          else {
              push @terms, join("=", map { $self->_uri_escape($_) } $key, $value);
          }
      }
  
      return join("&", (ref $data eq 'ARRAY') ? (@terms) : (sort @terms) );
  }
  
  
  my %DefaultPort = (
      http => 80,
      https => 443,
  );
  
  sub _agent {
      my $class = ref($_[0]) || $_[0];
      (my $default_agent = $class) =~ s{::}{-}g;
      return $default_agent . "/" . $class->VERSION;
  }
  
  sub _request {
      my ($self, $method, $url, $args) = @_;
  
      my ($scheme, $host, $port, $path_query, $auth) = $self->_split_url($url);
  
      my $request = {
          method    => $method,
          scheme    => $scheme,
          host      => $host,
          port      => $port,
          host_port => ($port == $DefaultPort{$scheme} ? $host : "$host:$port"),
          uri       => $path_query,
          headers   => {},
      };
  
      my $handle = delete $self->{handle};
      if ( $handle ) {
          unless ( $handle->can_reuse( $scheme, $host, $port ) ) {
              $handle->close;
              undef $handle;
          }
      }
      $handle ||= $self->_open_handle( $request, $scheme, $host, $port );
  
      $self->_prepare_headers_and_cb($request, $args, $url, $auth);
      $handle->write_request($request);
  
      my $response;
      do { $response = $handle->read_response_header }
          until (substr($response->{status},0,1) ne '1');
  
      $self->_update_cookie_jar( $url, $response ) if $self->{cookie_jar};
  
      if ( my @redir_args = $self->_maybe_redirect($request, $response, $args) ) {
          $handle->close;
          return $self->_request(@redir_args, $args);
      }
  
      my $known_message_length;
      if ($method eq 'HEAD' || $response->{status} =~ /^[23]04/) {
          $known_message_length = 1;
      }
      else {
          my $data_cb = $self->_prepare_data_cb($response, $args);
          $known_message_length = $handle->read_body($data_cb, $response);
      }
  
      if ( $self->{keep_alive}
          && $known_message_length
          && $response->{protocol} eq 'HTTP/1.1'
          && ($response->{headers}{connection} || '') ne 'close'
      ) {
          $self->{handle} = $handle;
      }
      else {
          $handle->close;
      }
  
      $response->{success} = substr( $response->{status}, 0, 1 ) eq '2';
      $response->{url} = $url;
      return $response;
  }
  
  sub _open_handle {
      my ($self, $request, $scheme, $host, $port) = @_;
  
      my $handle  = HTTP::Tiny::Handle->new(
          timeout         => $self->{timeout},
          SSL_options     => $self->{SSL_options},
          verify_SSL      => $self->{verify_SSL},
          local_address   => $self->{local_address},
          keep_alive      => $self->{keep_alive}
      );
  
      if ($self->{_has_proxy}{$scheme} && ! grep { $host =~ /\Q$_\E$/ } @{$self->{no_proxy}}) {
          return $self->_proxy_connect( $request, $handle );
      }
      else {
          return $handle->connect($scheme, $host, $port);
      }
  }
  
  sub _proxy_connect {
      my ($self, $request, $handle) = @_;
  
      my @proxy_vars;
      if ( $request->{scheme} eq 'https' ) {
          Carp::croak(qq{No https_proxy defined}) unless $self->{https_proxy};
          @proxy_vars = $self->_split_proxy( https_proxy => $self->{https_proxy} );
          if ( $proxy_vars[0] eq 'https' ) {
              Carp::croak(qq{Can't proxy https over https: $request->{uri} via $self->{https_proxy}});
          }
      }
      else {
          Carp::croak(qq{No http_proxy defined}) unless $self->{http_proxy};
          @proxy_vars = $self->_split_proxy( http_proxy => $self->{http_proxy} );
      }
  
      my ($p_scheme, $p_host, $p_port, $p_auth) = @proxy_vars;
  
      if ( length $p_auth && ! defined $request->{headers}{'proxy-authorization'} ) {
          $self->_add_basic_auth_header( $request, 'proxy-authorization' => $p_auth );
      }
  
      $handle->connect($p_scheme, $p_host, $p_port);
  
      if ($request->{scheme} eq 'https') {
          $self->_create_proxy_tunnel( $request, $handle );
      }
      else {
          $request->{uri} = "$request->{scheme}://$request->{host_port}$request->{uri}";
      }
  
      return $handle;
  }
  
  sub _split_proxy {
      my ($self, $type, $proxy) = @_;
  
      my ($scheme, $host, $port, $path_query, $auth) = eval { $self->_split_url($proxy) };
  
      unless(
          defined($scheme) && length($scheme) && length($host) && length($port)
          && $path_query eq '/'
      ) {
          Carp::croak(qq{$type URL must be in format http[s]://[auth@]<host>:<port>/\n});
      }
  
      return ($scheme, $host, $port, $auth);
  }
  
  sub _create_proxy_tunnel {
      my ($self, $request, $handle) = @_;
  
      $handle->_assert_ssl;
  
      my $agent = exists($request->{headers}{'user-agent'})
          ? $request->{headers}{'user-agent'} : $self->{agent};
  
      my $connect_request = {
          method    => 'CONNECT',
          uri       => "$request->{host}:$request->{port}",
          headers   => {
              host => "$request->{host}:$request->{port}",
              'user-agent' => $agent,
          }
      };
  
      if ( $request->{headers}{'proxy-authorization'} ) {
          $connect_request->{headers}{'proxy-authorization'} =
              delete $request->{headers}{'proxy-authorization'};
      }
  
      $handle->write_request($connect_request);
      my $response;
      do { $response = $handle->read_response_header }
          until (substr($response->{status},0,1) ne '1');
  
      unless (substr($response->{status},0,1) eq '2') {
          die $response;
      }
  
      $handle->start_ssl( $request->{host} );
  
      return;
  }
  
  sub _prepare_headers_and_cb {
      my ($self, $request, $args, $url, $auth) = @_;
  
      for ($self->{default_headers}, $args->{headers}) {
          next unless defined;
          while (my ($k, $v) = each %$_) {
              $request->{headers}{lc $k} = $v;
          }
      }
  
      if (exists $request->{headers}{'host'}) {
          die(qq/The 'Host' header must not be provided as header option\n/);
      }
  
      $request->{headers}{'host'}         = $request->{host_port};
      $request->{headers}{'user-agent'} ||= $self->{agent};
      $request->{headers}{'connection'}   = "close"
          unless $self->{keep_alive};
  
      if ( defined $args->{content} ) {
          if (ref $args->{content} eq 'CODE') {
              $request->{headers}{'content-type'} ||= "application/octet-stream";
              $request->{headers}{'transfer-encoding'} = 'chunked'
                unless $request->{headers}{'content-length'}
                    || $request->{headers}{'transfer-encoding'};
              $request->{cb} = $args->{content};
          }
          elsif ( length $args->{content} ) {
              my $content = $args->{content};
              if ( $] ge '5.008' ) {
                  utf8::downgrade($content, 1)
                      or die(qq/Wide character in request message body\n/);
              }
              $request->{headers}{'content-type'} ||= "application/octet-stream";
              $request->{headers}{'content-length'} = length $content
                unless $request->{headers}{'content-length'}
                    || $request->{headers}{'transfer-encoding'};
              $request->{cb} = sub { substr $content, 0, length $content, '' };
          }
          $request->{trailer_cb} = $args->{trailer_callback}
              if ref $args->{trailer_callback} eq 'CODE';
      }
  
      if ( $self->{cookie_jar} ) {
          my $cookies = $self->cookie_jar->cookie_header( $url );
          $request->{headers}{cookie} = $cookies if length $cookies;
      }
  
      if ( length $auth && ! defined $request->{headers}{authorization} ) {
          $self->_add_basic_auth_header( $request, 'authorization' => $auth );
      }
  
      return;
  }
  
  sub _add_basic_auth_header {
      my ($self, $request, $header, $auth) = @_;
      require MIME::Base64;
      $request->{headers}{$header} =
          "Basic " . MIME::Base64::encode_base64($auth, "");
      return;
  }
  
  sub _prepare_data_cb {
      my ($self, $response, $args) = @_;
      my $data_cb = $args->{data_callback};
      $response->{content} = '';
  
      if (!$data_cb || $response->{status} !~ /^2/) {
          if (defined $self->{max_size}) {
              $data_cb = sub {
                  $_[1]->{content} .= $_[0];
                  die(qq/Size of response body exceeds the maximum allowed of $self->{max_size}\n/)
                    if length $_[1]->{content} > $self->{max_size};
              };
          }
          else {
              $data_cb = sub { $_[1]->{content} .= $_[0] };
          }
      }
      return $data_cb;
  }
  
  sub _update_cookie_jar {
      my ($self, $url, $response) = @_;
  
      my $cookies = $response->{headers}->{'set-cookie'};
      return unless defined $cookies;
  
      my @cookies = ref $cookies ? @$cookies : $cookies;
  
      $self->cookie_jar->add( $url, $_ ) for @cookies;
  
      return;
  }
  
  sub _validate_cookie_jar {
      my ($class, $jar) = @_;
  
      for my $method ( qw/add cookie_header/ ) {
          Carp::croak(qq/Cookie jar must provide the '$method' method\n/)
              unless ref($jar) && ref($jar)->can($method);
      }
  
      return;
  }
  
  sub _maybe_redirect {
      my ($self, $request, $response, $args) = @_;
      my $headers = $response->{headers};
      my ($status, $method) = ($response->{status}, $request->{method});
      if (($status eq '303' or ($status =~ /^30[127]/ && $method =~ /^GET|HEAD$/))
          and $headers->{location}
          and ++$args->{redirects} <= $self->{max_redirect}
      ) {
          my $location = ($headers->{location} =~ /^\//)
              ? "$request->{scheme}://$request->{host_port}$headers->{location}"
              : $headers->{location} ;
          return (($status eq '303' ? 'GET' : $method), $location);
      }
      return;
  }
  
  sub _split_url {
      my $url = pop;
  
      my ($scheme, $host, $path_query) = $url =~ m<\A([^:/?#]+)://([^/?#]*)([^#]*)>
        or die(qq/Cannot parse URL: '$url'\n/);
  
      $scheme     = lc $scheme;
      $path_query = "/$path_query" unless $path_query =~ m<\A/>;
  
      my $auth = '';
      if ( (my $i = index $host, '@') != -1 ) {
          $auth = substr $host, 0, $i, ''; 
          substr $host, 0, 1, '';          
  
          $auth =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg;
      }
      my $port = $host =~ s/:(\d*)\z// && length $1 ? $1
               : $scheme eq 'http'                  ? 80
               : $scheme eq 'https'                 ? 443
               : undef;
  
      return ($scheme, (length $host ? lc $host : "localhost") , $port, $path_query, $auth);
  }
  
  my $DoW = "Sun|Mon|Tue|Wed|Thu|Fri|Sat";
  my $MoY = "Jan|Feb|Mar|Apr|May|Jun|Jul|Aug|Sep|Oct|Nov|Dec";
  sub _http_date {
      my ($sec, $min, $hour, $mday, $mon, $year, $wday) = gmtime($_[1]);
      return sprintf("%s, %02d %s %04d %02d:%02d:%02d GMT",
          substr($DoW,$wday*4,3),
          $mday, substr($MoY,$mon*4,3), $year+1900,
          $hour, $min, $sec
      );
  }
  
  sub _parse_http_date {
      my ($self, $str) = @_;
      require Time::Local;
      my @tl_parts;
      if ($str =~ /^[SMTWF][a-z]+, +(\d{1,2}) ($MoY) +(\d\d\d\d) +(\d\d):(\d\d):(\d\d) +GMT$/) {
          @tl_parts = ($6, $5, $4, $1, (index($MoY,$2)/4), $3);
      }
      elsif ($str =~ /^[SMTWF][a-z]+, +(\d\d)-($MoY)-(\d{2,4}) +(\d\d):(\d\d):(\d\d) +GMT$/ ) {
          @tl_parts = ($6, $5, $4, $1, (index($MoY,$2)/4), $3);
      }
      elsif ($str =~ /^[SMTWF][a-z]+ +($MoY) +(\d{1,2}) +(\d\d):(\d\d):(\d\d) +(?:[^0-9]+ +)?(\d\d\d\d)$/ ) {
          @tl_parts = ($5, $4, $3, $2, (index($MoY,$1)/4), $6);
      }
      return eval {
          my $t = @tl_parts ? Time::Local::timegm(@tl_parts) : -1;
          $t < 0 ? undef : $t;
      };
  }
  
  my %escapes = map { chr($_) => sprintf("%%%02X", $_) } 0..255;
  $escapes{' '}="+";
  my $unsafe_char = qr/[^A-Za-z0-9\-\._~]/;
  
  sub _uri_escape {
      my ($self, $str) = @_;
      if ( $] ge '5.008' ) {
          utf8::encode($str);
      }
      else {
          $str = pack("U*", unpack("C*", $str)) 
              if ( length $str == do { use bytes; length $str } );
          $str = pack("C*", unpack("C*", $str)); 
      }
      $str =~ s/($unsafe_char)/$escapes{$1}/ge;
      return $str;
  }
  
  package
      HTTP::Tiny::Handle; 
  use strict;
  use warnings;
  
  use Errno      qw[EINTR EPIPE];
  use IO::Socket qw[SOCK_STREAM];
  
  my $SOCKET_CLASS =
      $ENV{PERL_HTTP_TINY_IPV4_ONLY} ? 'IO::Socket::INET' :
      eval { require IO::Socket::IP; IO::Socket::IP->VERSION(0.25) } ? 'IO::Socket::IP' :
      'IO::Socket::INET';
  
  sub BUFSIZE () { 32768 } 
  
  my $Printable = sub {
      local $_ = shift;
      s/\r/\\r/g;
      s/\n/\\n/g;
      s/\t/\\t/g;
      s/([^\x20-\x7E])/sprintf('\\x%.2X', ord($1))/ge;
      $_;
  };
  
  my $Token = qr/[\x21\x23-\x27\x2A\x2B\x2D\x2E\x30-\x39\x41-\x5A\x5E-\x7A\x7C\x7E]/;
  
  sub new {
      my ($class, %args) = @_;
      return bless {
          rbuf             => '',
          timeout          => 60,
          max_line_size    => 16384,
          max_header_lines => 64,
          verify_SSL       => 0,
          SSL_options      => {},
          %args
      }, $class;
  }
  
  sub connect {
      @_ == 4 || die(q/Usage: $handle->connect(scheme, host, port)/ . "\n");
      my ($self, $scheme, $host, $port) = @_;
  
      if ( $scheme eq 'https' ) {
          $self->_assert_ssl;
      }
      elsif ( $scheme ne 'http' ) {
        die(qq/Unsupported URL scheme '$scheme'\n/);
      }
      $self->{fh} = $SOCKET_CLASS->new(
          PeerHost  => $host,
          PeerPort  => $port,
          $self->{local_address} ?
              ( LocalAddr => $self->{local_address} ) : (),
          Proto     => 'tcp',
          Type      => SOCK_STREAM,
          Timeout   => $self->{timeout},
          KeepAlive => !!$self->{keep_alive}
      ) or die(qq/Could not connect to '$host:$port': $@\n/);
  
      binmode($self->{fh})
        or die(qq/Could not binmode() socket: '$!'\n/);
  
      $self->start_ssl($host) if $scheme eq 'https';
  
      $self->{scheme} = $scheme;
      $self->{host} = $host;
      $self->{port} = $port;
      $self->{pid} = $$;
      $self->{tid} = _get_tid();
  
      return $self;
  }
  
  sub start_ssl {
      my ($self, $host) = @_;
  
      if ( ref($self->{fh}) eq 'IO::Socket::SSL' ) {
          unless ( $self->{fh}->stop_SSL ) {
              my $ssl_err = IO::Socket::SSL->errstr;
              die(qq/Error halting prior SSL connection: $ssl_err/);
          }
      }
  
      my $ssl_args = $self->_ssl_args($host);
      IO::Socket::SSL->start_SSL(
          $self->{fh},
          %$ssl_args,
          SSL_create_ctx_callback => sub {
              my $ctx = shift;
              Net::SSLeay::CTX_set_mode($ctx, Net::SSLeay::MODE_AUTO_RETRY());
          },
      );
  
      unless ( ref($self->{fh}) eq 'IO::Socket::SSL' ) {
          my $ssl_err = IO::Socket::SSL->errstr;
          die(qq/SSL connection failed for $host: $ssl_err\n/);
      }
  }
  
  sub close {
      @_ == 1 || die(q/Usage: $handle->close()/ . "\n");
      my ($self) = @_;
      CORE::close($self->{fh})
        or die(qq/Could not close socket: '$!'\n/);
  }
  
  sub write {
      @_ == 2 || die(q/Usage: $handle->write(buf)/ . "\n");
      my ($self, $buf) = @_;
  
      if ( $] ge '5.008' ) {
          utf8::downgrade($buf, 1)
              or die(qq/Wide character in write()\n/);
      }
  
      my $len = length $buf;
      my $off = 0;
  
      local $SIG{PIPE} = 'IGNORE';
  
      while () {
          $self->can_write
            or die(qq/Timed out while waiting for socket to become ready for writing\n/);
          my $r = syswrite($self->{fh}, $buf, $len, $off);
          if (defined $r) {
              $len -= $r;
              $off += $r;
              last unless $len > 0;
          }
          elsif ($! == EPIPE) {
              die(qq/Socket closed by remote server: $!\n/);
          }
          elsif ($! != EINTR) {
              if ($self->{fh}->can('errstr')){
                  my $err = $self->{fh}->errstr();
                  die (qq/Could not write to SSL socket: '$err'\n /);
              }
              else {
                  die(qq/Could not write to socket: '$!'\n/);
              }
  
          }
      }
      return $off;
  }
  
  sub read {
      @_ == 2 || @_ == 3 || die(q/Usage: $handle->read(len [, allow_partial])/ . "\n");
      my ($self, $len, $allow_partial) = @_;
  
      my $buf  = '';
      my $got = length $self->{rbuf};
  
      if ($got) {
          my $take = ($got < $len) ? $got : $len;
          $buf  = substr($self->{rbuf}, 0, $take, '');
          $len -= $take;
      }
  
      while ($len > 0) {
          $self->can_read
            or die(q/Timed out while waiting for socket to become ready for reading/ . "\n");
          my $r = sysread($self->{fh}, $buf, $len, length $buf);
          if (defined $r) {
              last unless $r;
              $len -= $r;
          }
          elsif ($! != EINTR) {
              if ($self->{fh}->can('errstr')){
                  my $err = $self->{fh}->errstr();
                  die (qq/Could not read from SSL socket: '$err'\n /);
              }
              else {
                  die(qq/Could not read from socket: '$!'\n/);
              }
          }
      }
      if ($len && !$allow_partial) {
          die(qq/Unexpected end of stream\n/);
      }
      return $buf;
  }
  
  sub readline {
      @_ == 1 || die(q/Usage: $handle->readline()/ . "\n");
      my ($self) = @_;
  
      while () {
          if ($self->{rbuf} =~ s/\A ([^\x0D\x0A]* \x0D?\x0A)//x) {
              return $1;
          }
          if (length $self->{rbuf} >= $self->{max_line_size}) {
              die(qq/Line size exceeds the maximum allowed size of $self->{max_line_size}\n/);
          }
          $self->can_read
            or die(qq/Timed out while waiting for socket to become ready for reading\n/);
          my $r = sysread($self->{fh}, $self->{rbuf}, BUFSIZE, length $self->{rbuf});
          if (defined $r) {
              last unless $r;
          }
          elsif ($! != EINTR) {
              if ($self->{fh}->can('errstr')){
                  my $err = $self->{fh}->errstr();
                  die (qq/Could not read from SSL socket: '$err'\n /);
              }
              else {
                  die(qq/Could not read from socket: '$!'\n/);
              }
          }
      }
      die(qq/Unexpected end of stream while looking for line\n/);
  }
  
  sub read_header_lines {
      @_ == 1 || @_ == 2 || die(q/Usage: $handle->read_header_lines([headers])/ . "\n");
      my ($self, $headers) = @_;
      $headers ||= {};
      my $lines   = 0;
      my $val;
  
      while () {
           my $line = $self->readline;
  
           if (++$lines >= $self->{max_header_lines}) {
               die(qq/Header lines exceeds maximum number allowed of $self->{max_header_lines}\n/);
           }
           elsif ($line =~ /\A ([^\x00-\x1F\x7F:]+) : [\x09\x20]* ([^\x0D\x0A]*)/x) {
               my ($field_name) = lc $1;
               if (exists $headers->{$field_name}) {
                   for ($headers->{$field_name}) {
                       $_ = [$_] unless ref $_ eq "ARRAY";
                       push @$_, $2;
                       $val = \$_->[-1];
                   }
               }
               else {
                   $val = \($headers->{$field_name} = $2);
               }
           }
           elsif ($line =~ /\A [\x09\x20]+ ([^\x0D\x0A]*)/x) {
               $val
                 or die(qq/Unexpected header continuation line\n/);
               next unless length $1;
               $$val .= ' ' if length $$val;
               $$val .= $1;
           }
           elsif ($line =~ /\A \x0D?\x0A \z/x) {
              last;
           }
           else {
              die(q/Malformed header line: / . $Printable->($line) . "\n");
           }
      }
      return $headers;
  }
  
  sub write_request {
      @_ == 2 || die(q/Usage: $handle->write_request(request)/ . "\n");
      my($self, $request) = @_;
      $self->write_request_header(@{$request}{qw/method uri headers/});
      $self->write_body($request) if $request->{cb};
      return;
  }
  
  my %HeaderCase = (
      'content-md5'      => 'Content-MD5',
      'etag'             => 'ETag',
      'te'               => 'TE',
      'www-authenticate' => 'WWW-Authenticate',
      'x-xss-protection' => 'X-XSS-Protection',
  );
  
  sub write_header_lines {
      (@_ == 2 || @_ == 3 && ref $_[1] eq 'HASH') || die(q/Usage: $handle->write_header_lines(headers[,prefix])/ . "\n");
      my($self, $headers, $prefix_data) = @_;
  
      my $buf = (defined $prefix_data ? $prefix_data : '');
      while (my ($k, $v) = each %$headers) {
          my $field_name = lc $k;
          if (exists $HeaderCase{$field_name}) {
              $field_name = $HeaderCase{$field_name};
          }
          else {
              $field_name =~ /\A $Token+ \z/xo
                or die(q/Invalid HTTP header field name: / . $Printable->($field_name) . "\n");
              $field_name =~ s/\b(\w)/\u$1/g;
              $HeaderCase{lc $field_name} = $field_name;
          }
          for (ref $v eq 'ARRAY' ? @$v : $v) {
              $_ = '' unless defined $_;
              $buf .= "$field_name: $_\x0D\x0A";
          }
      }
      $buf .= "\x0D\x0A";
      return $self->write($buf);
  }
  
  sub read_body {
      @_ == 3 || die(q/Usage: $handle->read_body(callback, response)/ . "\n");
      my ($self, $cb, $response) = @_;
      my $te = $response->{headers}{'transfer-encoding'} || '';
      my $chunked = grep { /chunked/i } ( ref $te eq 'ARRAY' ? @$te : $te ) ;
      return $chunked
          ? $self->read_chunked_body($cb, $response)
          : $self->read_content_body($cb, $response);
  }
  
  sub write_body {
      @_ == 2 || die(q/Usage: $handle->write_body(request)/ . "\n");
      my ($self, $request) = @_;
      if ($request->{headers}{'content-length'}) {
          return $self->write_content_body($request);
      }
      else {
          return $self->write_chunked_body($request);
      }
  }
  
  sub read_content_body {
      @_ == 3 || @_ == 4 || die(q/Usage: $handle->read_content_body(callback, response, [read_length])/ . "\n");
      my ($self, $cb, $response, $content_length) = @_;
      $content_length ||= $response->{headers}{'content-length'};
  
      if ( defined $content_length ) {
          my $len = $content_length;
          while ($len > 0) {
              my $read = ($len > BUFSIZE) ? BUFSIZE : $len;
              $cb->($self->read($read, 0), $response);
              $len -= $read;
          }
          return length($self->{rbuf}) == 0;
      }
  
      my $chunk;
      $cb->($chunk, $response) while length( $chunk = $self->read(BUFSIZE, 1) );
  
      return;
  }
  
  sub write_content_body {
      @_ == 2 || die(q/Usage: $handle->write_content_body(request)/ . "\n");
      my ($self, $request) = @_;
  
      my ($len, $content_length) = (0, $request->{headers}{'content-length'});
      while () {
          my $data = $request->{cb}->();
  
          defined $data && length $data
            or last;
  
          if ( $] ge '5.008' ) {
              utf8::downgrade($data, 1)
                  or die(qq/Wide character in write_content()\n/);
          }
  
          $len += $self->write($data);
      }
  
      $len == $content_length
        or die(qq/Content-Length mismatch (got: $len expected: $content_length)\n/);
  
      return $len;
  }
  
  sub read_chunked_body {
      @_ == 3 || die(q/Usage: $handle->read_chunked_body(callback, $response)/ . "\n");
      my ($self, $cb, $response) = @_;
  
      while () {
          my $head = $self->readline;
  
          $head =~ /\A ([A-Fa-f0-9]+)/x
            or die(q/Malformed chunk head: / . $Printable->($head) . "\n");
  
          my $len = hex($1)
            or last;
  
          $self->read_content_body($cb, $response, $len);
  
          $self->read(2) eq "\x0D\x0A"
            or die(qq/Malformed chunk: missing CRLF after chunk data\n/);
      }
      $self->read_header_lines($response->{headers});
      return 1;
  }
  
  sub write_chunked_body {
      @_ == 2 || die(q/Usage: $handle->write_chunked_body(request)/ . "\n");
      my ($self, $request) = @_;
  
      my $len = 0;
      while () {
          my $data = $request->{cb}->();
  
          defined $data && length $data
            or last;
  
          if ( $] ge '5.008' ) {
              utf8::downgrade($data, 1)
                  or die(qq/Wide character in write_chunked_body()\n/);
          }
  
          $len += length $data;
  
          my $chunk  = sprintf '%X', length $data;
             $chunk .= "\x0D\x0A";
             $chunk .= $data;
             $chunk .= "\x0D\x0A";
  
          $self->write($chunk);
      }
      $self->write("0\x0D\x0A");
      $self->write_header_lines($request->{trailer_cb}->())
          if ref $request->{trailer_cb} eq 'CODE';
      return $len;
  }
  
  sub read_response_header {
      @_ == 1 || die(q/Usage: $handle->read_response_header()/ . "\n");
      my ($self) = @_;
  
      my $line = $self->readline;
  
      $line =~ /\A (HTTP\/(0*\d+\.0*\d+)) [\x09\x20]+ ([0-9]{3}) [\x09\x20]+ ([^\x0D\x0A]*) \x0D?\x0A/x
        or die(q/Malformed Status-Line: / . $Printable->($line). "\n");
  
      my ($protocol, $version, $status, $reason) = ($1, $2, $3, $4);
  
      die (qq/Unsupported HTTP protocol: $protocol\n/)
          unless $version =~ /0*1\.0*[01]/;
  
      return {
          status       => $status,
          reason       => $reason,
          headers      => $self->read_header_lines,
          protocol     => $protocol,
      };
  }
  
  sub write_request_header {
      @_ == 4 || die(q/Usage: $handle->write_request_header(method, request_uri, headers)/ . "\n");
      my ($self, $method, $request_uri, $headers) = @_;
  
      return $self->write_header_lines($headers, "$method $request_uri HTTP/1.1\x0D\x0A");
  }
  
  sub _do_timeout {
      my ($self, $type, $timeout) = @_;
      $timeout = $self->{timeout}
          unless defined $timeout && $timeout >= 0;
  
      my $fd = fileno $self->{fh};
      defined $fd && $fd >= 0
        or die(qq/select(2): 'Bad file descriptor'\n/);
  
      my $initial = time;
      my $pending = $timeout;
      my $nfound;
  
      vec(my $fdset = '', $fd, 1) = 1;
  
      while () {
          $nfound = ($type eq 'read')
              ? select($fdset, undef, undef, $pending)
              : select(undef, $fdset, undef, $pending) ;
          if ($nfound == -1) {
              $! == EINTR
                or die(qq/select(2): '$!'\n/);
              redo if !$timeout || ($pending = $timeout - (time - $initial)) > 0;
              $nfound = 0;
          }
          last;
      }
      $! = 0;
      return $nfound;
  }
  
  sub can_read {
      @_ == 1 || @_ == 2 || die(q/Usage: $handle->can_read([timeout])/ . "\n");
      my $self = shift;
      if ( ref($self->{fh}) eq 'IO::Socket::SSL' ) {
          return 1 if $self->{fh}->pending;
      }
      return $self->_do_timeout('read', @_)
  }
  
  sub can_write {
      @_ == 1 || @_ == 2 || die(q/Usage: $handle->can_write([timeout])/ . "\n");
      my $self = shift;
      return $self->_do_timeout('write', @_)
  }
  
  sub _assert_ssl {
      die(qq/IO::Socket::SSL 1.42 must be installed for https support\n/)
          unless eval {require IO::Socket::SSL; IO::Socket::SSL->VERSION(1.42)};
      die(qq/Net::SSLeay 1.49 must be installed for https support\n/)
          unless eval {require Net::SSLeay; Net::SSLeay->VERSION(1.49)};
  }
  
  sub can_reuse {
      my ($self,$scheme,$host,$port) = @_;
      return 0 if
          $self->{pid} != $$
          || $self->{tid} != _get_tid()
          || length($self->{rbuf})
          || $scheme ne $self->{scheme}
          || $host ne $self->{host}
          || $port ne $self->{port}
          || eval { $self->can_read(0) }
          || $@ ;
          return 1;
  }
  
  sub _find_CA_file {
      my $self = shift();
  
      return $self->{SSL_options}->{SSL_ca_file}
          if $self->{SSL_options}->{SSL_ca_file} and -e $self->{SSL_options}->{SSL_ca_file};
  
      return Mozilla::CA::SSL_ca_file()
          if eval { require Mozilla::CA };
  
      foreach my $ca_bundle (
          "/etc/ssl/certs/ca-certificates.crt",     
          "/etc/pki/tls/certs/ca-bundle.crt",       
          "/etc/ssl/ca-bundle.pem",                 
          "/etc/openssl/certs/ca-certificates.crt", 
          "/etc/ssl/cert.pem",                      
          "/usr/local/share/certs/ca-root-nss.crt", 
          "/etc/pki/tls/cacert.pem",                
          "/etc/certs/ca-certificates.crt",         
      ) {
          return $ca_bundle if -e $ca_bundle;
      }
  
      die qq/Couldn't find a CA bundle with which to verify the SSL certificate.\n/
        . qq/Try installing Mozilla::CA from CPAN\n/;
  }
  
  sub _get_tid {
      no warnings 'reserved'; 
      return threads->can("tid") ? threads->tid : 0;
  }
  
  sub _ssl_args {
      my ($self, $host) = @_;
  
      my %ssl_args;
  
      if ( Net::SSLeay::OPENSSL_VERSION_NUMBER() >= 0x01000000 ) {
          $ssl_args{SSL_hostname} = $host,          
      }
  
      if ($self->{verify_SSL}) {
          $ssl_args{SSL_verifycn_scheme}  = 'http'; 
          $ssl_args{SSL_verifycn_name}    = $host;  
          $ssl_args{SSL_verify_mode}      = 0x01;   
          $ssl_args{SSL_ca_file}          = $self->_find_CA_file;
      }
      else {
          $ssl_args{SSL_verifycn_scheme}  = 'none'; 
          $ssl_args{SSL_verify_mode}      = 0x00;   
      }
  
      for my $k ( keys %{$self->{SSL_options}} ) {
          $ssl_args{$k} = $self->{SSL_options}{$k} if $k =~ m/^SSL_/;
      }
  
      return \%ssl_args;
  }
  
  1;
  
  __END__
  
HTTP_TINY

$fatpacked{"HTTP/Tiny/UNIX.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'HTTP_TINY_UNIX';
  package HTTP::Tiny::UNIX;
  
  use 5.010001;
  use strict;
  use warnings;
  
  our $DATE = '2014-07-04'; 
  our $VERSION = '0.04'; 
  
  
  use parent qw(HTTP::Tiny);
  
  use IO::Socket::UNIX;
  
  sub _split_url {
      my ($self, $url) = @_;
  
      if ($url =~ m<\A[^:/?#]+://>) {
          $self->{_unix} = 0;
          return $self->SUPER::_split_url($url);
      }
  
      my ($scheme, $sock_path, $path_query) =
          $url =~ m<\A(\w+):(.+?)/(/[^#]*)>
              or die "Cannot parse HTTP-over-Unix URL: '$url'\n";
  
      $self->{_unix} = 1;
      $self->{_path_query} = $path_query;
  
      $scheme = lc $scheme;
      die "Only http scheme is supported\n" unless $scheme eq 'http';
  
      return  ($scheme, $sock_path, -1,    $path_query, '');
  }
  
  sub _open_handle {
      my ($self, $request, $scheme, $host, $port) = @_;
  
      return $self->SUPER::_open_handle($request, $scheme, $host, $port)
          unless $self->{_unix};
  
      my $handle = HTTP::Tiny::Handle::UNIX->new(
          timeout => $self->{timeout},
      );
  
      $handle->connect($scheme, $host, $port, $self);
  }
  
  package
      HTTP::Tiny::Handle::UNIX;
  
  use parent -norequire, 'HTTP::Tiny::Handle';
  
  use IO::Socket;
  
  sub connect {
      my ($self, $scheme, $host, $port, $tiny) = @_;
  
      my $path = $host;
  
      local($^W) = 0;
      my $sock = IO::Socket::UNIX->new(
          Peer    => $path,
          Type    => SOCK_STREAM,
          Timeout => $self->{timeout},
          Host    => 'localhost',
      );
  
      unless ($sock) {
          $@ =~ s/^.*?: //;
          die "Can't open Unix socket $path\: $@";
      }
  
      eval { $sock->blocking(0); };
  
      $self->{fh} = $sock;
  
      $self->{scheme} = $scheme;
      $self->{host} = $host;
      $self->{port} = $port;
      $self->{_unix} = 1;
      $self->{_tiny} = $tiny;
      $self;
  }
  
  sub write_request_header {
      my ($self, $method, $request_uri, $headers) = @_;
  
      return $self->write_request_header($method, $request_uri, $headers)
          unless $self->{_unix};
  
      return $self->write_header_lines($headers, "$method $self->{_tiny}{_path_query} HTTP/1.1\x0D\x0A");
  }
  
  1;
  
  __END__
  
HTTP_TINY_UNIX

$fatpacked{"IO/Compress/Adapter/Bzip2.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'IO_COMPRESS_ADAPTER_BZIP2';
  package IO::Compress::Adapter::Bzip2 ;
  
  use strict;
  use warnings;
  use bytes;
  
  use IO::Compress::Base::Common  2.068 qw(:Status);
  
  use Compress::Raw::Bzip2  2.068 ;
  
  our ($VERSION);
  $VERSION = '2.068';
  
  sub mkCompObject
  {
      my $BlockSize100K = shift ;
      my $WorkFactor = shift ;
      my $Verbosity  = shift ;
  
      $BlockSize100K = 1 if ! defined $BlockSize100K ;
      $WorkFactor    = 0 if ! defined $WorkFactor ;
      $Verbosity     = 0 if ! defined $Verbosity ;
  
      my ($def, $status) = new Compress::Raw::Bzip2(1, $BlockSize100K,
                                                   $WorkFactor, $Verbosity);
  
      return (undef, "Could not create Deflate object: $status", $status)
          if $status != BZ_OK ;
  
      return bless {'Def'        => $def,
                    'Error'      => '',
                    'ErrorNo'    => 0,
                   }  ;     
  }
  
  sub compr
  {
      my $self = shift ;
  
      my $def   = $self->{Def};
  
      my $status = $def->bzdeflate($_[0], $_[1]) ;
      $self->{ErrorNo} = $status;
  
      if ($status != BZ_RUN_OK)
      {
          $self->{Error} = "Deflate Error: $status"; 
          return STATUS_ERROR;
      }
  
      return STATUS_OK;    
  }
  
  sub flush
  {
      my $self = shift ;
  
      my $def   = $self->{Def};
  
      my $status = $def->bzflush($_[0]);
      $self->{ErrorNo} = $status;
  
      if ($status != BZ_RUN_OK)
      {
          $self->{Error} = "Deflate Error: $status"; 
          return STATUS_ERROR;
      }
  
      return STATUS_OK;    
      
  }
  
  sub close
  {
      my $self = shift ;
  
      my $def   = $self->{Def};
  
      my $status = $def->bzclose($_[0]);
      $self->{ErrorNo} = $status;
  
      if ($status != BZ_STREAM_END)
      {
          $self->{Error} = "Deflate Error: $status"; 
          return STATUS_ERROR;
      }
  
      return STATUS_OK;    
      
  }
  
  
  sub reset
  {
      my $self = shift ;
  
      my $outer = $self->{Outer};
  
      my ($def, $status) = new Compress::Raw::Bzip2();
      $self->{ErrorNo} = ($status == BZ_OK) ? 0 : $status ;
  
      if ($status != BZ_OK)
      {
          $self->{Error} = "Cannot create Deflate object: $status"; 
          return STATUS_ERROR;
      }
  
      $self->{Def} = $def;
  
      return STATUS_OK;    
  }
  
  sub compressedBytes
  {
      my $self = shift ;
      $self->{Def}->compressedBytes();
  }
  
  sub uncompressedBytes
  {
      my $self = shift ;
      $self->{Def}->uncompressedBytes();
  }
  
  
  
  
  1;
  
  __END__
  
IO_COMPRESS_ADAPTER_BZIP2

$fatpacked{"IO/Compress/Adapter/Deflate.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'IO_COMPRESS_ADAPTER_DEFLATE';
  package IO::Compress::Adapter::Deflate ;
  
  use strict;
  use warnings;
  use bytes;
  
  use IO::Compress::Base::Common 2.068 qw(:Status);
  use Compress::Raw::Zlib  2.068 qw( !crc32 !adler32 ) ;
                                    
  require Exporter;                                     
  our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, @EXPORT, %DEFLATE_CONSTANTS);
  
  $VERSION = '2.068';
  @ISA = qw(Exporter);
  @EXPORT_OK = @Compress::Raw::Zlib::DEFLATE_CONSTANTS;
  %EXPORT_TAGS = %Compress::Raw::Zlib::DEFLATE_CONSTANTS;
  @EXPORT = @EXPORT_OK;
  %DEFLATE_CONSTANTS = %EXPORT_TAGS ;
  
  sub mkCompObject
  {
      my $crc32    = shift ;
      my $adler32  = shift ;
      my $level    = shift ;
      my $strategy = shift ;
  
      my ($def, $status) = new Compress::Raw::Zlib::Deflate
                                  -AppendOutput   => 1,
                                  -CRC32          => $crc32,
                                  -ADLER32        => $adler32,
                                  -Level          => $level,
                                  -Strategy       => $strategy,
                                  -WindowBits     => - MAX_WBITS;
  
      return (undef, "Cannot create Deflate object: $status", $status) 
          if $status != Z_OK;    
  
      return bless {'Def'        => $def,
                    'Error'      => '',
                   } ;     
  }
  
  sub compr
  {
      my $self = shift ;
  
      my $def   = $self->{Def};
  
      my $status = $def->deflate($_[0], $_[1]) ;
      $self->{ErrorNo} = $status;
  
      if ($status != Z_OK)
      {
          $self->{Error} = "Deflate Error: $status"; 
          return STATUS_ERROR;
      }
  
      return STATUS_OK;    
  }
  
  sub flush
  {
      my $self = shift ;
  
      my $def   = $self->{Def};
  
      my $opt = $_[1] || Z_FINISH;
      my $status = $def->flush($_[0], $opt);
      $self->{ErrorNo} = $status;
  
      if ($status != Z_OK)
      {
          $self->{Error} = "Deflate Error: $status"; 
          return STATUS_ERROR;
      }
  
      return STATUS_OK;        
  }
  
  sub close
  {
      my $self = shift ;
  
      my $def   = $self->{Def};
  
      $def->flush($_[0], Z_FINISH)
          if defined $def ;
  }
  
  sub reset
  {
      my $self = shift ;
  
      my $def   = $self->{Def};
  
      my $status = $def->deflateReset() ;
      $self->{ErrorNo} = $status;
      if ($status != Z_OK)
      {
          $self->{Error} = "Deflate Error: $status"; 
          return STATUS_ERROR;
      }
  
      return STATUS_OK;    
  }
  
  sub deflateParams 
  {
      my $self = shift ;
  
      my $def   = $self->{Def};
  
      my $status = $def->deflateParams(@_);
      $self->{ErrorNo} = $status;
      if ($status != Z_OK)
      {
          $self->{Error} = "deflateParams Error: $status"; 
          return STATUS_ERROR;
      }
  
      return STATUS_OK;   
  }
  
  
  
  
  sub compressedBytes
  {
      my $self = shift ;
  
      $self->{Def}->compressedBytes();
  }
  
  sub uncompressedBytes
  {
      my $self = shift ;
      $self->{Def}->uncompressedBytes();
  }
  
  
  
  
  sub crc32
  {
      my $self = shift ;
      $self->{Def}->crc32();
  }
  
  sub adler32
  {
      my $self = shift ;
      $self->{Def}->adler32();
  }
  
  
  1;
  
  __END__
  
IO_COMPRESS_ADAPTER_DEFLATE

$fatpacked{"IO/Compress/Adapter/Identity.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'IO_COMPRESS_ADAPTER_IDENTITY';
  package IO::Compress::Adapter::Identity ;
  
  use strict;
  use warnings;
  use bytes;
  
  use IO::Compress::Base::Common  2.068 qw(:Status);
  our ($VERSION);
  
  $VERSION = '2.068';
  
  sub mkCompObject
  {
      my $level    = shift ;
      my $strategy = shift ;
  
      return bless {
                    'CompSize'   => 0,
                    'UnCompSize' => 0,
                    'Error'      => '',
                    'ErrorNo'    => 0,
                   } ;     
  }
  
  sub compr
  {
      my $self = shift ;
  
      if (defined ${ $_[0] } && length ${ $_[0] }) {
          $self->{CompSize} += length ${ $_[0] } ;
          $self->{UnCompSize} = $self->{CompSize} ;
  
          if ( ref $_[1] ) 
            { ${ $_[1] } .= ${ $_[0] } }
          else
            { $_[1] .= ${ $_[0] } }
      }
  
      return STATUS_OK ;
  }
  
  sub flush
  {
      my $self = shift ;
  
      return STATUS_OK;    
  }
  
  sub close
  {
      my $self = shift ;
  
      return STATUS_OK;    
  }
  
  sub reset
  {
      my $self = shift ;
  
      $self->{CompSize}   = 0;
      $self->{UnCompSize} = 0;
  
      return STATUS_OK;    
  }
  
  sub deflateParams 
  {
      my $self = shift ;
  
      return STATUS_OK;   
  }
  
  
  sub compressedBytes
  {
      my $self = shift ;
      return $self->{UnCompSize} ;
  }
  
  sub uncompressedBytes
  {
      my $self = shift ;
      return $self->{UnCompSize} ;
  }
  
  1;
  
  
  __END__
  
IO_COMPRESS_ADAPTER_IDENTITY

$fatpacked{"IO/Compress/Base.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'IO_COMPRESS_BASE';
  
  package IO::Compress::Base ;
  
  require 5.006 ;
  
  use strict ;
  use warnings;
  
  use IO::Compress::Base::Common 2.068 ;
  
  use IO::File (); ;
  use Scalar::Util ();
  
  use Carp() ;
  use Symbol();
  
  our (@ISA, $VERSION);
  @ISA    = qw(Exporter IO::File);
  
  $VERSION = '2.068';
  
  
  sub saveStatus
  {
      my $self   = shift ;
      ${ *$self->{ErrorNo} } = shift() + 0 ;
      ${ *$self->{Error} } = '' ;
  
      return ${ *$self->{ErrorNo} } ;
  }
  
  
  sub saveErrorString
  {
      my $self   = shift ;
      my $retval = shift ;
      ${ *$self->{Error} } = shift ;
      ${ *$self->{ErrorNo} } = shift() + 0 if @_ ;
  
      return $retval;
  }
  
  sub croakError
  {
      my $self   = shift ;
      $self->saveErrorString(0, $_[0]);
      Carp::croak $_[0];
  }
  
  sub closeError
  {
      my $self = shift ;
      my $retval = shift ;
  
      my $errno = *$self->{ErrorNo};
      my $error = ${ *$self->{Error} };
  
      $self->close();
  
      *$self->{ErrorNo} = $errno ;
      ${ *$self->{Error} } = $error ;
  
      return $retval;
  }
  
  
  
  sub error
  {
      my $self   = shift ;
      return ${ *$self->{Error} } ;
  }
  
  sub errorNo
  {
      my $self   = shift ;
      return ${ *$self->{ErrorNo} } ;
  }
  
  
  sub writeAt
  {
      my $self = shift ;
      my $offset = shift;
      my $data = shift;
  
      if (defined *$self->{FH}) {
          my $here = tell(*$self->{FH});
          return $self->saveErrorString(undef, "Cannot seek to end of output filehandle: $!", $!) 
              if $here < 0 ;
          seek(*$self->{FH}, $offset, IO::Handle::SEEK_SET)
              or return $self->saveErrorString(undef, "Cannot seek to end of output filehandle: $!", $!) ;
          defined *$self->{FH}->write($data, length $data)
              or return $self->saveErrorString(undef, $!, $!) ;
          seek(*$self->{FH}, $here, IO::Handle::SEEK_SET)
              or return $self->saveErrorString(undef, "Cannot seek to end of output filehandle: $!", $!) ;
      }
      else {
          substr(${ *$self->{Buffer} }, $offset, length($data)) = $data ;
      }
  
      return 1;
  }
  
  sub outputPayload
  {
  
      my $self = shift ;
      return $self->output(@_);
  }
  
  
  sub output
  {
      my $self = shift ;
      my $data = shift ;
      my $last = shift ;
  
      return 1 
          if length $data == 0 && ! $last ;
  
      if ( *$self->{FilterContainer} ) {
          *_ = \$data;
          &{ *$self->{FilterContainer} }();
      }
  
      if (length $data) {
          if ( defined *$self->{FH} ) {
                  defined *$self->{FH}->write( $data, length $data )
                  or return $self->saveErrorString(0, $!, $!); 
          }
          else {
                  ${ *$self->{Buffer} } .= $data ;
          }
      }
  
      return 1;
  }
  
  sub getOneShotParams
  {
      return ( 'multistream' => [IO::Compress::Base::Common::Parse_boolean,   1],
             );
  }
  
  our %PARAMS = (
              'autoclose' => [IO::Compress::Base::Common::Parse_boolean,   0],
              'encode'    => [IO::Compress::Base::Common::Parse_any,       undef],
              'strict'    => [IO::Compress::Base::Common::Parse_boolean,   1],
              'append'    => [IO::Compress::Base::Common::Parse_boolean,   0],
              'binmodein' => [IO::Compress::Base::Common::Parse_boolean,   0],
  
              'filtercontainer' => [IO::Compress::Base::Common::Parse_code,  undef],
          );
          
  sub checkParams
  {
      my $self = shift ;
      my $class = shift ;
  
      my $got = shift || IO::Compress::Base::Parameters::new();
  
      $got->parse(
          {
              %PARAMS,
  
  
              $self->getExtraParams(),
              *$self->{OneShot} ? $self->getOneShotParams() 
                                : (),
          }, 
          @_) or $self->croakError("${class}: " . $got->getError())  ;
  
      return $got ;
  }
  
  sub _create
  {
      my $obj = shift;
      my $got = shift;
  
      *$obj->{Closed} = 1 ;
  
      my $class = ref $obj;
      $obj->croakError("$class: Missing Output parameter")
          if ! @_ && ! $got ;
  
      my $outValue = shift ;
      my $oneShot = 1 ;
  
      if (! $got)
      {
          $oneShot = 0 ;
          $got = $obj->checkParams($class, undef, @_)
              or return undef ;
      }
  
      my $lax = ! $got->getValue('strict') ;
  
      my $outType = IO::Compress::Base::Common::whatIsOutput($outValue);
  
      $obj->ckOutputParam($class, $outValue)
          or return undef ;
  
      if ($outType eq 'buffer') {
          *$obj->{Buffer} = $outValue;
      }
      else {
          my $buff = "" ;
          *$obj->{Buffer} = \$buff ;
      }
  
      my $merge = $got->getValue('merge') ;
      my $appendOutput = $got->getValue('append') || $merge ;
      *$obj->{Append} = $appendOutput;
      *$obj->{FilterContainer} = $got->getValue('filtercontainer') ;
  
      if ($merge)
      {
          if (($outType eq 'buffer' && length $$outValue == 0 ) ||
              ($outType ne 'buffer' && (! -e $outValue || (-w _ && -z _))) )
            { $merge = 0 }
      }
  
  
      $obj->ckParams($got)
          or $obj->croakError("${class}: " . $obj->error());
  
      if ($got->getValue('encode')) { 
          my $want_encoding = $got->getValue('encode');
          *$obj->{Encoding} = IO::Compress::Base::Common::getEncoding($obj, $class, $want_encoding);
          my $x = *$obj->{Encoding}; 
      }
      else {
          *$obj->{Encoding} = undef; 
      }
      
      $obj->saveStatus(STATUS_OK) ;
  
      my $status ;
      if (! $merge)
      {
          *$obj->{Compress} = $obj->mkComp($got)
              or return undef;
          
          *$obj->{UnCompSize} = new U64 ;
          *$obj->{CompSize} = new U64 ;
  
          if ( $outType eq 'buffer') {
              ${ *$obj->{Buffer} }  = ''
                  unless $appendOutput ;
          }
          else {
              if ($outType eq 'handle') {
                  *$obj->{FH} = $outValue ;
                  setBinModeOutput(*$obj->{FH}) ;
                  *$obj->{Handle} = 1 ;
                  if ($appendOutput)
                  {
                      seek(*$obj->{FH}, 0, IO::Handle::SEEK_END)
                          or return $obj->saveErrorString(undef, "Cannot seek to end of output filehandle: $!", $!) ;
  
                  }
              }
              elsif ($outType eq 'filename') {    
                  no warnings;
                  my $mode = '>' ;
                  $mode = '>>'
                      if $appendOutput;
                  *$obj->{FH} = new IO::File "$mode $outValue" 
                      or return $obj->saveErrorString(undef, "cannot open file '$outValue': $!", $!) ;
                  *$obj->{StdIO} = ($outValue eq '-'); 
                  setBinModeOutput(*$obj->{FH}) ;
              }
          }
  
          *$obj->{Header} = $obj->mkHeader($got) ;
          $obj->output( *$obj->{Header} )
              or return undef;
          $obj->beforePayload();
      }
      else
      {
          *$obj->{Compress} = $obj->createMerge($outValue, $outType)
              or return undef;
      }
  
      *$obj->{Closed} = 0 ;
      *$obj->{AutoClose} = $got->getValue('autoclose') ;
      *$obj->{Output} = $outValue;
      *$obj->{ClassName} = $class;
      *$obj->{Got} = $got;
      *$obj->{OneShot} = 0 ;
  
      return $obj ;
  }
  
  sub ckOutputParam 
  {
      my $self = shift ;
      my $from = shift ;
      my $outType = IO::Compress::Base::Common::whatIsOutput($_[0]);
  
      $self->croakError("$from: output parameter not a filename, filehandle or scalar ref")
          if ! $outType ;
  
  
      $self->croakError("$from: output buffer is read-only")
          if $outType eq 'buffer' && Scalar::Util::readonly(${ $_[0] });
      
      return 1;    
  }
  
  
  sub _def
  {
      my $obj = shift ;
      
      my $class= (caller)[0] ;
      my $name = (caller(1))[3] ;
  
      $obj->croakError("$name: expected at least 1 parameters\n")
          unless @_ >= 1 ;
  
      my $input = shift ;
      my $haveOut = @_ ;
      my $output = shift ;
  
      my $x = new IO::Compress::Base::Validator($class, *$obj->{Error}, $name, $input, $output)
          or return undef ;
  
      push @_, $output if $haveOut && $x->{Hash};
  
      *$obj->{OneShot} = 1 ;
  
      my $got = $obj->checkParams($name, undef, @_)
          or return undef ;
  
      $x->{Got} = $got ;
  
  
      if ($x->{GlobMap})
      {
          $x->{oneInput} = 1 ;
          foreach my $pair (@{ $x->{Pairs} })
          {
              my ($from, $to) = @$pair ;
              $obj->_singleTarget($x, 1, $from, $to, @_)
                  or return undef ;
          }
  
          return scalar @{ $x->{Pairs} } ;
      }
  
      if (! $x->{oneOutput} )
      {
          my $inFile = ($x->{inType} eq 'filenames' 
                          || $x->{inType} eq 'filename');
  
          $x->{inType} = $inFile ? 'filename' : 'buffer';
          
          foreach my $in ($x->{oneInput} ? $input : @$input)
          {
              my $out ;
              $x->{oneInput} = 1 ;
  
              $obj->_singleTarget($x, $inFile, $in, \$out, @_)
                  or return undef ;
  
              push @$output, \$out ;
          }
  
          return 1 ;
      }
  
      return $obj->_singleTarget($x, 1, $input, $output, @_);
  
      Carp::croak "should not be here" ;
  }
  
  sub _singleTarget
  {
      my $obj             = shift ;
      my $x               = shift ;
      my $inputIsFilename = shift;
      my $input           = shift;
      
      if ($x->{oneInput})
      {
          $obj->getFileInfo($x->{Got}, $input)
              if isaScalar($input) || (isaFilename($input) and $inputIsFilename) ;
  
          my $z = $obj->_create($x->{Got}, @_)
              or return undef ;
  
  
          defined $z->_wr2($input, $inputIsFilename) 
              or return $z->closeError(undef) ;
  
          return $z->close() ;
      }
      else
      {
          my $afterFirst = 0 ;
          my $inputIsFilename = ($x->{inType} ne 'array');
          my $keep = $x->{Got}->clone();
  
          for my $element ( @$input)
          {
              my $isFilename = isaFilename($element);
  
              if ( $afterFirst ++ )
              {
                  defined addInterStream($obj, $element, $isFilename)
                      or return $obj->closeError(undef) ;
              }
              else
              {
                  $obj->getFileInfo($x->{Got}, $element)
                      if isaScalar($element) || $isFilename;
  
                  $obj->_create($x->{Got}, @_)
                      or return undef ;
              }
  
              defined $obj->_wr2($element, $isFilename) 
                  or return $obj->closeError(undef) ;
  
              *$obj->{Got} = $keep->clone();
          }
          return $obj->close() ;
      }
  
  }
  
  sub _wr2
  {
      my $self = shift ;
  
      my $source = shift ;
      my $inputIsFilename = shift;
  
      my $input = $source ;
      if (! $inputIsFilename)
      {
          $input = \$source 
              if ! ref $source;
      }
  
      if ( ref $input && ref $input eq 'SCALAR' )
      {
          return $self->syswrite($input, @_) ;
      }
  
      if ( ! ref $input  || isaFilehandle($input))
      {
          my $isFilehandle = isaFilehandle($input) ;
  
          my $fh = $input ;
  
          if ( ! $isFilehandle )
          {
              $fh = new IO::File "<$input"
                  or return $self->saveErrorString(undef, "cannot open file '$input': $!", $!) ;
          }
          binmode $fh if *$self->{Got}->valueOrDefault('binmodein') ;
  
          my $status ;
          my $buff ;
          my $count = 0 ;
          while ($status = read($fh, $buff, 16 * 1024)) {
              $count += length $buff;
              defined $self->syswrite($buff, @_) 
                  or return undef ;
          }
  
          return $self->saveErrorString(undef, $!, $!) 
              if ! defined $status ;
  
          if ( (!$isFilehandle || *$self->{AutoClose}) && $input ne '-')
          {    
              $fh->close() 
                  or return undef ;
          }
  
          return $count ;
      }
  
      Carp::croak "Should not be here";
      return undef;
  }
  
  sub addInterStream
  {
      my $self = shift ;
      my $input = shift ;
      my $inputIsFilename = shift ;
  
      if (*$self->{Got}->getValue('multistream'))
      {
          $self->getFileInfo(*$self->{Got}, $input)
              if isaScalar($input) || isaFilename($input) ;
  
          return $self->newStream();
      }
      elsif (*$self->{Got}->getValue('autoflush'))
      {
      }
  
      return 1 ;
  }
  
  sub getFileInfo
  {
  }
  
  sub TIEHANDLE
  {
      return $_[0] if ref($_[0]);
      die "OOPS\n" ;
  }
    
  sub UNTIE
  {
      my $self = shift ;
  }
  
  sub DESTROY
  {
      my $self = shift ;
      local ($., $@, $!, $^E, $?);
      
      $self->close() ;
  
      %{ *$self } = () ;
      undef $self ;
  }
  
  
  
  sub filterUncompressed
  {
  }
  
  sub syswrite
  {
      my $self = shift ;
  
      my $buffer ;
      if (ref $_[0] ) {
          $self->croakError( *$self->{ClassName} . "::write: not a scalar reference" )
              unless ref $_[0] eq 'SCALAR' ;
          $buffer = $_[0] ;
      }
      else {
          $buffer = \$_[0] ;
      }
  
      if (@_ > 1) {
          my $slen = defined $$buffer ? length($$buffer) : 0;
          my $len = $slen;
          my $offset = 0;
          $len = $_[1] if $_[1] < $len;
  
          if (@_ > 2) {
              $offset = $_[2] || 0;
              $self->croakError(*$self->{ClassName} . "::write: offset outside string") 
                  if $offset > $slen;
              if ($offset < 0) {
                  $offset += $slen;
                  $self->croakError( *$self->{ClassName} . "::write: offset outside string") if $offset < 0;
              }
              my $rem = $slen - $offset;
              $len = $rem if $rem < $len;
          }
  
          $buffer = \substr($$buffer, $offset, $len) ;
      }
  
      return 0 if (! defined $$buffer || length $$buffer == 0) && ! *$self->{FlushPending};
      
      
      if (*$self->{Encoding}) {      
          $$buffer = *$self->{Encoding}->encode($$buffer);
      }
      else {
          $] >= 5.008 and ( utf8::downgrade($$buffer, 1) 
              or Carp::croak "Wide character in " .  *$self->{ClassName} . "::write:");
      }
  
      $self->filterUncompressed($buffer);
  
      my $buffer_length = defined $$buffer ? length($$buffer) : 0 ;
      *$self->{UnCompSize}->add($buffer_length) ;
  
      my $outBuffer='';
      my $status = *$self->{Compress}->compr($buffer, $outBuffer) ;
  
      return $self->saveErrorString(undef, *$self->{Compress}{Error}, 
                                           *$self->{Compress}{ErrorNo})
          if $status == STATUS_ERROR;
  
      *$self->{CompSize}->add(length $outBuffer) ;
  
      $self->outputPayload($outBuffer)
          or return undef;
  
      return $buffer_length;
  }
  
  sub print
  {
      my $self = shift;
  
  
      if (defined $\) {
          if (defined $,) {
              defined $self->syswrite(join($,, @_) . $\);
          } else {
              defined $self->syswrite(join("", @_) . $\);
          }
      } else {
          if (defined $,) {
              defined $self->syswrite(join($,, @_));
          } else {
              defined $self->syswrite(join("", @_));
          }
      }
  }
  
  sub printf
  {
      my $self = shift;
      my $fmt = shift;
      defined $self->syswrite(sprintf($fmt, @_));
  }
  
  sub _flushCompressed
  {
      my $self = shift ;
  
      my $outBuffer='';
      my $status = *$self->{Compress}->flush($outBuffer, @_) ;
      return $self->saveErrorString(0, *$self->{Compress}{Error}, 
                                      *$self->{Compress}{ErrorNo})
          if $status == STATUS_ERROR;
  
      if ( defined *$self->{FH} ) {
          *$self->{FH}->clearerr();
      }
  
      *$self->{CompSize}->add(length $outBuffer) ;
  
      $self->outputPayload($outBuffer)
          or return 0;
      return 1;        
  }
  
  sub flush
  {   
      my $self = shift ;
  
      $self->_flushCompressed(@_)
          or return 0;        
  
      if ( defined *$self->{FH} ) {
          defined *$self->{FH}->flush()
              or return $self->saveErrorString(0, $!, $!); 
      }
  
      return 1;
  }
  
  sub beforePayload
  {
  }
  
  sub _newStream
  {
      my $self = shift ;
      my $got  = shift;
  
      my $class = ref $self;
  
      $self->_writeTrailer()
          or return 0 ;
  
      $self->ckParams($got)
          or $self->croakError("newStream: $self->{Error}");
  
      if ($got->getValue('encode')) { 
          my $want_encoding = $got->getValue('encode');
          *$self->{Encoding} = IO::Compress::Base::Common::getEncoding($self, $class, $want_encoding);
      }
      else {
          *$self->{Encoding} = undef;
      }
      
      *$self->{Compress} = $self->mkComp($got)
          or return 0;
  
      *$self->{Header} = $self->mkHeader($got) ;
      $self->output(*$self->{Header} )
          or return 0;
      
      *$self->{UnCompSize}->reset();
      *$self->{CompSize}->reset();
  
      $self->beforePayload();
  
      return 1 ;
  }
  
  sub newStream
  {
      my $self = shift ;
    
      my $got = $self->checkParams('newStream', *$self->{Got}, @_)
          or return 0 ;    
  
      $self->_newStream($got);
  
  }
  
  sub reset
  {
      my $self = shift ;
      return *$self->{Compress}->reset() ;
  }
  
  sub _writeTrailer
  {
      my $self = shift ;
  
      my $trailer = '';
  
      my $status = *$self->{Compress}->close($trailer) ;
      return $self->saveErrorString(0, *$self->{Compress}{Error}, *$self->{Compress}{ErrorNo})
          if $status == STATUS_ERROR;
  
      *$self->{CompSize}->add(length $trailer) ;
  
      $trailer .= $self->mkTrailer();
      defined $trailer
        or return 0;
  
      return $self->output($trailer);
  }
  
  sub _writeFinalTrailer
  {
      my $self = shift ;
  
      return $self->output($self->mkFinalTrailer());
  }
  
  sub close
  {
      my $self = shift ;
      return 1 if *$self->{Closed} || ! *$self->{Compress} ;
      *$self->{Closed} = 1 ;
  
      untie *$self 
          if $] >= 5.008 ;
  
      *$self->{FlushPending} = 1 ;
      $self->_writeTrailer()
          or return 0 ;
  
      $self->_writeFinalTrailer()
          or return 0 ;
  
      $self->output( "", 1 )
          or return 0;
  
      if (defined *$self->{FH}) {
  
          if ((! *$self->{Handle} || *$self->{AutoClose}) && ! *$self->{StdIO}) {
              $! = 0 ;
              *$self->{FH}->close()
                  or return $self->saveErrorString(0, $!, $!); 
          }
          delete *$self->{FH} ;
          $! = 0 ;
      }
  
      return 1;
  }
  
  
  
  
  sub tell
  {
      my $self = shift ;
  
      return *$self->{UnCompSize}->get32bit() ;
  }
  
  sub eof
  {
      my $self = shift ;
  
      return *$self->{Closed} ;
  }
  
  
  sub seek
  {
      my $self     = shift ;
      my $position = shift;
      my $whence   = shift ;
  
      my $here = $self->tell() ;
      my $target = 0 ;
  
      use IO::Handle ;
  
      if ($whence == IO::Handle::SEEK_SET) {
          $target = $position ;
      }
      elsif ($whence == IO::Handle::SEEK_CUR || $whence == IO::Handle::SEEK_END) {
          $target = $here + $position ;
      }
      else {
          $self->croakError(*$self->{ClassName} . "::seek: unknown value, $whence, for whence parameter");
      }
  
      return 1 if $target == $here ;    
  
      $self->croakError(*$self->{ClassName} . "::seek: cannot seek backwards")
          if $target < $here ;
  
      my $offset = $target - $here ;
  
      my $buffer ;
      defined $self->syswrite("\x00" x $offset)
          or return 0;
  
      return 1 ;
  }
  
  sub binmode
  {
      1;
  }
  
  sub fileno
  {
      my $self     = shift ;
      return defined *$self->{FH} 
              ? *$self->{FH}->fileno() 
              : undef ;
  }
  
  sub opened
  {
      my $self     = shift ;
      return ! *$self->{Closed} ;
  }
  
  sub autoflush
  {
      my $self     = shift ;
      return defined *$self->{FH} 
              ? *$self->{FH}->autoflush(@_) 
              : undef ;
  }
  
  sub input_line_number
  {
      return undef ;
  }
  
  
  sub _notAvailable
  {
      my $name = shift ;
      return sub { Carp::croak "$name Not Available: File opened only for output" ; } ;
  }
  
  *read     = _notAvailable('read');
  *READ     = _notAvailable('read');
  *readline = _notAvailable('readline');
  *READLINE = _notAvailable('readline');
  *getc     = _notAvailable('getc');
  *GETC     = _notAvailable('getc');
  
  *FILENO   = \&fileno;
  *PRINT    = \&print;
  *PRINTF   = \&printf;
  *WRITE    = \&syswrite;
  *write    = \&syswrite;
  *SEEK     = \&seek; 
  *TELL     = \&tell;
  *EOF      = \&eof;
  *CLOSE    = \&close;
  *BINMODE  = \&binmode;
  
  
  1; 
  
  __END__
  
IO_COMPRESS_BASE

$fatpacked{"IO/Compress/Base/Common.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'IO_COMPRESS_BASE_COMMON';
  package IO::Compress::Base::Common;
  
  use strict ;
  use warnings;
  use bytes;
  
  use Carp;
  use Scalar::Util qw(blessed readonly);
  use File::GlobMapper;
  
  require Exporter;
  our ($VERSION, @ISA, @EXPORT, %EXPORT_TAGS, $HAS_ENCODE);
  @ISA = qw(Exporter);
  $VERSION = '2.068';
  
  @EXPORT = qw( isaFilehandle isaFilename isaScalar
                whatIsInput whatIsOutput 
                isaFileGlobString cleanFileGlobString oneTarget
                setBinModeInput setBinModeOutput
                ckInOutParams 
                createSelfTiedObject
                
                isGeMax32
  
                MAX32
  
                WANT_CODE
                WANT_EXT
                WANT_UNDEF
                WANT_HASH
  
                STATUS_OK
                STATUS_ENDSTREAM
                STATUS_EOF
                STATUS_ERROR
            );  
  
  %EXPORT_TAGS = ( Status => [qw( STATUS_OK
                                   STATUS_ENDSTREAM
                                   STATUS_EOF
                                   STATUS_ERROR
                             )]);
  
                         
  use constant STATUS_OK        => 0;
  use constant STATUS_ENDSTREAM => 1;
  use constant STATUS_EOF       => 2;
  use constant STATUS_ERROR     => -1;
  use constant MAX16            => 0xFFFF ;  
  use constant MAX32            => 0xFFFFFFFF ;  
  use constant MAX32cmp         => 0xFFFFFFFF + 1 - 1; 
            
  
  sub isGeMax32
  {
      return $_[0] >= MAX32cmp ;
  }
  
  sub hasEncode()
  {
      if (! defined $HAS_ENCODE) {
          eval
          {
              require Encode;
              Encode->import();
          };
  
          $HAS_ENCODE = $@ ? 0 : 1 ;
      }
  
      return $HAS_ENCODE;
  }
  
  sub getEncoding($$$)
  {
      my $obj = shift;
      my $class = shift ;
      my $want_encoding = shift ;
  
      $obj->croakError("$class: Encode module needed to use -Encode")
          if ! hasEncode();
  
      my $encoding = Encode::find_encoding($want_encoding);
  
      $obj->croakError("$class: Encoding '$want_encoding' is not available")
         if ! $encoding;
  
      return $encoding;
  }
  
  our ($needBinmode);
  $needBinmode = ($^O eq 'MSWin32' || 
                      ($] >= 5.006 && eval ' ${^UNICODE} || ${^UTF8LOCALE} '))
                      ? 1 : 1 ;
  
  sub setBinModeInput($)
  {
      my $handle = shift ;
  
      binmode $handle 
          if  $needBinmode;
  }
  
  sub setBinModeOutput($)
  {
      my $handle = shift ;
  
      binmode $handle
          if  $needBinmode;
  }
  
  sub isaFilehandle($)
  {
      use utf8; 
      return (defined $_[0] and 
               (UNIVERSAL::isa($_[0],'GLOB') or 
                UNIVERSAL::isa($_[0],'IO::Handle') or
                UNIVERSAL::isa(\$_[0],'GLOB')) 
            )
  }
  
  sub isaScalar
  {
      return ( defined($_[0]) and ref($_[0]) eq 'SCALAR' and defined ${ $_[0] } ) ;
  }
  
  sub isaFilename($)
  {
      return (defined $_[0] and 
             ! ref $_[0]    and 
             UNIVERSAL::isa(\$_[0], 'SCALAR'));
  }
  
  sub isaFileGlobString
  {
      return defined $_[0] && $_[0] =~ /^<.*>$/;
  }
  
  sub cleanFileGlobString
  {
      my $string = shift ;
  
      $string =~ s/^\s*<\s*(.*)\s*>\s*$/$1/;
  
      return $string;
  }
  
  use constant WANT_CODE  => 1 ;
  use constant WANT_EXT   => 2 ;
  use constant WANT_UNDEF => 4 ;
  use constant WANT_HASH  => 0 ;
  
  sub whatIsInput($;$)
  {
      my $got = whatIs(@_);
      
      if (defined $got && $got eq 'filename' && defined $_[0] && $_[0] eq '-')
      {
          $got = 'handle';
          $_[0] = *STDIN;
      }
  
      return $got;
  }
  
  sub whatIsOutput($;$)
  {
      my $got = whatIs(@_);
      
      if (defined $got && $got eq 'filename' && defined $_[0] && $_[0] eq '-')
      {
          $got = 'handle';
          $_[0] = *STDOUT;
      }
      
      return $got;
  }
  
  sub whatIs ($;$)
  {
      return 'handle' if isaFilehandle($_[0]);
  
      my $wantCode = defined $_[1] && $_[1] & WANT_CODE ;
      my $extended = defined $_[1] && $_[1] & WANT_EXT ;
      my $undef    = defined $_[1] && $_[1] & WANT_UNDEF ;
      my $hash     = defined $_[1] && $_[1] & WANT_HASH ;
  
      return 'undef'  if ! defined $_[0] && $undef ;
  
      if (ref $_[0]) {
          return ''       if blessed($_[0]); 
          return 'buffer' if UNIVERSAL::isa($_[0], 'SCALAR');
          return 'array'  if UNIVERSAL::isa($_[0], 'ARRAY')  && $extended ;
          return 'hash'   if UNIVERSAL::isa($_[0], 'HASH')   && $hash ;
          return 'code'   if UNIVERSAL::isa($_[0], 'CODE')   && $wantCode ;
          return '';
      }
  
      return 'fileglob' if $extended && isaFileGlobString($_[0]);
      return 'filename';
  }
  
  sub oneTarget
  {
      return $_[0] =~ /^(code|handle|buffer|filename)$/;
  }
  
  sub IO::Compress::Base::Validator::new
  {
      my $class = shift ;
  
      my $Class = shift ;
      my $error_ref = shift ;
      my $reportClass = shift ;
  
      my %data = (Class       => $Class, 
                  Error       => $error_ref,
                  reportClass => $reportClass, 
                 ) ;
  
      my $obj = bless \%data, $class ;
  
      local $Carp::CarpLevel = 1;
  
      my $inType    = $data{inType}    = whatIsInput($_[0], WANT_EXT|WANT_HASH);
      my $outType   = $data{outType}   = whatIsOutput($_[1], WANT_EXT|WANT_HASH);
  
      my $oneInput  = $data{oneInput}  = oneTarget($inType);
      my $oneOutput = $data{oneOutput} = oneTarget($outType);
  
      if (! $inType)
      {
          $obj->croakError("$reportClass: illegal input parameter") ;
      }    
  
  
      if (! $outType)
      {
          $obj->croakError("$reportClass: illegal output parameter") ;
      }    
  
  
      if ($inType ne 'fileglob' && $outType eq 'fileglob')
      {
          $obj->croakError("Need input fileglob for outout fileglob");
      }    
  
  
      if ($inType eq 'fileglob' && $outType eq 'fileglob')
      {
          $data{GlobMap} = 1 ;
          $data{inType} = $data{outType} = 'filename';
          my $mapper = new File::GlobMapper($_[0], $_[1]);
          if ( ! $mapper )
          {
              return $obj->saveErrorString($File::GlobMapper::Error) ;
          }
          $data{Pairs} = $mapper->getFileMap();
  
          return $obj;
      }
      
      $obj->croakError("$reportClass: input and output $inType are identical")
          if $inType eq $outType && $_[0] eq $_[1] && $_[0] ne '-' ;
  
      if ($inType eq 'fileglob') 
      {
          my $glob = cleanFileGlobString($_[0]);
          my @inputs = glob($glob);
  
          if (@inputs == 0)
          {
              die "globmap matched zero file -- legal or die???" ;
          }
          elsif (@inputs == 1)
          {
              $obj->validateInputFilenames($inputs[0])
                  or return undef;
              $_[0] = $inputs[0]  ;
              $data{inType} = 'filename' ;
              $data{oneInput} = 1;
          }
          else
          {
              $obj->validateInputFilenames(@inputs)
                  or return undef;
              $_[0] = [ @inputs ] ;
              $data{inType} = 'filenames' ;
          }
      }
      elsif ($inType eq 'filename')
      {
          $obj->validateInputFilenames($_[0])
              or return undef;
      }
      elsif ($inType eq 'array')
      {
          $data{inType} = 'filenames' ;
          $obj->validateInputArray($_[0])
              or return undef ;
      }
  
      return $obj->saveErrorString("$reportClass: output buffer is read-only")
          if $outType eq 'buffer' && readonly(${ $_[1] });
  
      if ($outType eq 'filename' )
      {
          $obj->croakError("$reportClass: output filename is undef or null string")
              if ! defined $_[1] || $_[1] eq ''  ;
  
          if (-e $_[1])
          {
              if (-d _ )
              {
                  return $obj->saveErrorString("output file '$_[1]' is a directory");
              }
          }
      }
      
      return $obj ;
  }
  
  sub IO::Compress::Base::Validator::saveErrorString
  {
      my $self   = shift ;
      ${ $self->{Error} } = shift ;
      return undef;
      
  }
  
  sub IO::Compress::Base::Validator::croakError
  {
      my $self   = shift ;
      $self->saveErrorString($_[0]);
      croak $_[0];
  }
  
  
  
  sub IO::Compress::Base::Validator::validateInputFilenames
  {
      my $self = shift ;
  
      foreach my $filename (@_)
      {
          $self->croakError("$self->{reportClass}: input filename is undef or null string")
              if ! defined $filename || $filename eq ''  ;
  
          next if $filename eq '-';
  
          if (! -e $filename )
          {
              return $self->saveErrorString("input file '$filename' does not exist");
          }
  
          if (-d _ )
          {
              return $self->saveErrorString("input file '$filename' is a directory");
          }
  
      }
  
      return 1 ;
  }
  
  sub IO::Compress::Base::Validator::validateInputArray
  {
      my $self = shift ;
  
      if ( @{ $_[0] } == 0 )
      {
          return $self->saveErrorString("empty array reference") ;
      }    
  
      foreach my $element ( @{ $_[0] } )
      {
          my $inType  = whatIsInput($element);
      
          if (! $inType)
          {
              $self->croakError("unknown input parameter") ;
          }    
          elsif($inType eq 'filename')
          {
              $self->validateInputFilenames($element)
                  or return undef ;
          }
          else
          {
              $self->croakError("not a filename") ;
          }
      }
  
      return 1 ;
  }
  
  
  sub createSelfTiedObject
  {
      my $class = shift || (caller)[0] ;
      my $error_ref = shift ;
  
      my $obj = bless Symbol::gensym(), ref($class) || $class;
      tie *$obj, $obj if $] >= 5.005;
      *$obj->{Closed} = 1 ;
      $$error_ref = '';
      *$obj->{Error} = $error_ref ;
      my $errno = 0 ;
      *$obj->{ErrorNo} = \$errno ;
  
      return $obj;
  }
  
  
  
  
  $EXPORT_TAGS{Parse} = [qw( ParseParameters 
                             Parse_any Parse_unsigned Parse_signed 
                             Parse_boolean Parse_string
                             Parse_code
                             Parse_writable_scalar
                           )
                        ];              
  
  push @EXPORT, @{ $EXPORT_TAGS{Parse} } ;
  
  use constant Parse_any      => 0x01;
  use constant Parse_unsigned => 0x02;
  use constant Parse_signed   => 0x04;
  use constant Parse_boolean  => 0x08;
  use constant Parse_string   => 0x10;
  use constant Parse_code     => 0x20;
  
  use constant Parse_writable         => 0x200 ;
  use constant Parse_writable_scalar  => 0x400 | Parse_writable ;
  
  use constant OFF_PARSED     => 0 ;
  use constant OFF_TYPE       => 1 ;
  use constant OFF_DEFAULT    => 2 ;
  use constant OFF_FIXED      => 3 ;
  
  use constant IxError => 0;
  use constant IxGot   => 1 ;
  
  sub ParseParameters
  {
      my $level = shift || 0 ; 
  
      my $sub = (caller($level + 1))[3] ;
      local $Carp::CarpLevel = 1 ;
      
      return $_[1]
          if @_ == 2 && defined $_[1] && UNIVERSAL::isa($_[1], "IO::Compress::Base::Parameters");
      
      my $p = new IO::Compress::Base::Parameters() ;            
      $p->parse(@_)
          or croak "$sub: $p->[IxError]" ;
  
      return $p;
  }
  
  
  use strict;
  
  use warnings;
  use Carp;
  
  
  sub Init
  {
      my $default = shift ;
      my %got ;
      
      my $obj = IO::Compress::Base::Parameters::new();
      while (my ($key, $v) = each %$default)
      {
          croak "need 2 params [@$v]"
              if @$v != 2 ;
  
          my ($type, $value) = @$v ;
          my $sticky = 0;
          my $x ;
          $obj->_checkType($key, \$value, $type, 0, \$x) 
              or return undef ;
  
          $key = lc $key;
  
  
              $got{$key} = [0, $type, $value, $x] ;            
      }
      
      return bless \%got, "IO::Compress::Base::Parameters::Defaults" ;
  }
  
  sub IO::Compress::Base::Parameters::new
  {
  
      my $obj;
      $obj->[IxError] = '';
      $obj->[IxGot] = {} ;          
  
      return bless $obj, 'IO::Compress::Base::Parameters' ;
  }
  
  sub IO::Compress::Base::Parameters::setError
  {
      my $self = shift ;
      my $error = shift ;
      my $retval = @_ ? shift : undef ;
  
  
      $self->[IxError] = $error ;
      return $retval;
  }
            
  sub IO::Compress::Base::Parameters::getError
  {
      my $self = shift ;
      return $self->[IxError] ;
  }
            
  sub IO::Compress::Base::Parameters::parse
  {
      my $self = shift ;
      my $default = shift ;
  
      my $got = $self->[IxGot] ;
      my $firstTime = keys %{ $got } == 0 ;
  
      my (@Bad) ;
      my @entered = () ;
  
      if (@_ == 0) {
          @entered = () ;
      }
      elsif (@_ == 1) {
          my $href = $_[0] ;
      
          return $self->setError("Expected even number of parameters, got 1")
              if ! defined $href or ! ref $href or ref $href ne "HASH" ;
   
          foreach my $key (keys %$href) {
              push @entered, $key ;
              push @entered, \$href->{$key} ;
          }
      }
      else {
         
          my $count = @_;
          return $self->setError("Expected even number of parameters, got $count")
              if $count % 2 != 0 ;
          
          for my $i (0.. $count / 2 - 1) {
              push @entered, $_[2 * $i] ;
              push @entered, \$_[2 * $i + 1] ;
          }
      }
  
          foreach my $key (keys %$default)
          {
      
              my ($type, $value) = @{ $default->{$key} } ;
    
              if ($firstTime) {   
                  $got->{$key} = [0, $type, $value, $value] ;               
              }
              else
              {
                  $got->{$key}[OFF_PARSED] = 0 ;      
              }               
          }
  
  
      my %parsed = ();
      
     
      for my $i (0.. @entered / 2 - 1) {
          my $key = $entered[2* $i] ;
          my $value = $entered[2* $i+1] ;
  
  
          $key =~ s/^-// ;
          my $canonkey = lc $key;
   
          if ($got->{$canonkey})                                  
          {
              my $type = $got->{$canonkey}[OFF_TYPE] ;
              my $parsed = $parsed{$canonkey};
              ++ $parsed{$canonkey};
  
              return $self->setError("Muliple instances of '$key' found") 
                  if $parsed ; 
  
              my $s ;
              $self->_checkType($key, $value, $type, 1, \$s)
                  or return undef ;
  
              $value = $$value ;
              $got->{$canonkey} = [1, $type, $value, $s] ;
  
          }
          else
            { push (@Bad, $key) }
      }
   
      if (@Bad) {
          my ($bad) = join(", ", @Bad) ;
          return $self->setError("unknown key value(s) $bad") ;
      }
  
      return 1;
  }
  
  sub IO::Compress::Base::Parameters::_checkType
  {
      my $self = shift ;
  
      my $key   = shift ;
      my $value = shift ;
      my $type  = shift ;
      my $validate  = shift ;
      my $output  = shift;
  
  
      if ($type & Parse_writable_scalar)
      {
          return $self->setError("Parameter '$key' not writable")
              if  readonly $$value ;
  
          if (ref $$value) 
          {
              return $self->setError("Parameter '$key' not a scalar reference")
                  if ref $$value ne 'SCALAR' ;
  
              $$output = $$value ;
          }
          else  
          {
              return $self->setError("Parameter '$key' not a scalar")
                  if ref $value ne 'SCALAR' ;
  
              $$output = $value ;
          }
  
          return 1;
      }
  
  
      $value = $$value ;
  
      if ($type & Parse_any)
      {
          $$output = $value ;
          return 1;
      }
      elsif ($type & Parse_unsigned)
      {
       
          return $self->setError("Parameter '$key' must be an unsigned int, got 'undef'")
              if ! defined $value ;
          return $self->setError("Parameter '$key' must be an unsigned int, got '$value'")
              if $value !~ /^\d+$/;
      
          $$output = defined $value ? $value : 0 ;    
          return 1;
      }
      elsif ($type & Parse_signed)
      {
          return $self->setError("Parameter '$key' must be a signed int, got 'undef'")
              if ! defined $value ;
          return $self->setError("Parameter '$key' must be a signed int, got '$value'")
              if $value !~ /^-?\d+$/;
  
          $$output = defined $value ? $value : 0 ;    
          return 1 ;
      }
      elsif ($type & Parse_boolean)
      {
          return $self->setError("Parameter '$key' must be an int, got '$value'")
              if defined $value && $value !~ /^\d*$/;
  
          $$output =  defined $value && $value != 0 ? 1 : 0 ;    
          return 1;
      }
  
      elsif ($type & Parse_string)
      {
          $$output = defined $value ? $value : "" ;    
          return 1;
      }
      elsif ($type & Parse_code)
      {
          return $self->setError("Parameter '$key' must be a code reference, got '$value'")
              if (! defined $value || ref $value ne 'CODE') ;
  
          $$output = defined $value ? $value : "" ;    
          return 1;
      }
      
      $$output = $value ;
      return 1;
  }
  
  sub IO::Compress::Base::Parameters::parsed
  {
      return $_[0]->[IxGot]{$_[1]}[OFF_PARSED] ;
  }
  
  
  sub IO::Compress::Base::Parameters::getValue
  {
      return  $_[0]->[IxGot]{$_[1]}[OFF_FIXED] ;
  }
  sub IO::Compress::Base::Parameters::setValue
  {
      $_[0]->[IxGot]{$_[1]}[OFF_PARSED]  = 1;
      $_[0]->[IxGot]{$_[1]}[OFF_DEFAULT] = $_[2] ;
      $_[0]->[IxGot]{$_[1]}[OFF_FIXED]   = $_[2] ;            
  }
  
  sub IO::Compress::Base::Parameters::valueRef
  {
      return  $_[0]->[IxGot]{$_[1]}[OFF_FIXED]  ;
  }
  
  sub IO::Compress::Base::Parameters::valueOrDefault
  {
      my $self = shift ;
      my $name = shift ;
      my $default = shift ;
  
      my $value = $self->[IxGot]{$name}[OFF_DEFAULT] ;
      
      return $value if defined $value ;
      return $default ;
  }
  
  sub IO::Compress::Base::Parameters::wantValue
  {
      return defined $_[0]->[IxGot]{$_[1]}[OFF_DEFAULT] ;
  }
  
  sub IO::Compress::Base::Parameters::clone
  {
      my $self = shift ;
      my $obj = [] ;
      my %got ;
  
      my $hash = $self->[IxGot] ;
      for my $k (keys %{ $hash })
      {
          $got{$k} = [ @{ $hash->{$k} } ];
      }
  
      $obj->[IxError] = $self->[IxError];
      $obj->[IxGot] = \%got ;
  
      return bless $obj, 'IO::Compress::Base::Parameters' ;
  }
  
  package U64;
  
  use constant MAX32 => 0xFFFFFFFF ;
  use constant HI_1 => MAX32 + 1 ;
  use constant LOW   => 0 ;
  use constant HIGH  => 1;
  
  sub new
  {
      return bless [ 0, 0 ], $_[0]
          if @_ == 1 ;
          
      return bless [ $_[1], 0 ], $_[0]
          if @_ == 2 ;
          
      return bless [ $_[2], $_[1] ], $_[0]      
          if @_ == 3 ;  
  }
  
  sub newUnpack_V64
  {
      my ($low, $hi) = unpack "V V", $_[0] ;
      bless [ $low, $hi ], "U64";
  }
  
  sub newUnpack_V32
  {
      my $string = shift;
  
      my $low = unpack "V", $string ;
      bless [ $low, 0 ], "U64";
  }
  
  sub reset
  {
      $_[0]->[HIGH] = $_[0]->[LOW] = 0;
  }
  
  sub clone
  {
      bless [ @{$_[0]}  ], ref $_[0] ;    
  }
  
  sub getHigh
  {
      return $_[0]->[HIGH];
  }
  
  sub getLow
  {
      return $_[0]->[LOW];
  }
  
  sub get32bit
  {
      return $_[0]->[LOW];
  }
  
  sub get64bit
  {
      return $_[0]->[HIGH] * HI_1 + $_[0]->[LOW];
  }
  
  sub add
  {
      my $value = $_[1];
  
      if (ref $value eq 'U64') {
          $_[0]->[HIGH] += $value->[HIGH] ;
          $value = $value->[LOW];
      }
      elsif ($value > MAX32) {      
          $_[0]->[HIGH] += int($value / HI_1) ;
          $value = $value % HI_1;
      }
       
      my $available = MAX32 - $_[0]->[LOW] ;
   
      if ($value > $available) {
         ++ $_[0]->[HIGH] ;
         $_[0]->[LOW] = $value - $available - 1;
      }
      else {
         $_[0]->[LOW] += $value ;
      }
  }
  
  sub add32
  {
      my $value = $_[1];
  
      if ($value > MAX32) {      
          $_[0]->[HIGH] += int($value / HI_1) ;
          $value = $value % HI_1;
      }
       
      my $available = MAX32 - $_[0]->[LOW] ;
   
      if ($value > $available) {
         ++ $_[0]->[HIGH] ;
         $_[0]->[LOW] = $value - $available - 1;
      }
      else {
         $_[0]->[LOW] += $value ;
      }
  }
  
  sub subtract
  {
      my $self = shift;
      my $value = shift;
  
      if (ref $value eq 'U64') {
  
          if ($value->[HIGH]) {
              die "bad"
                  if $self->[HIGH] == 0 ||
                     $value->[HIGH] > $self->[HIGH] ;
  
             $self->[HIGH] -= $value->[HIGH] ;
          }
  
          $value = $value->[LOW] ;
      }
  
      if ($value > $self->[LOW]) {
         -- $self->[HIGH] ;
         $self->[LOW] = MAX32 - $value + $self->[LOW] + 1 ;
      }
      else {
         $self->[LOW] -= $value;
      }
  }
  
  sub equal
  {
      my $self = shift;
      my $other = shift;
  
      return $self->[LOW]  == $other->[LOW] &&
             $self->[HIGH] == $other->[HIGH] ;
  }
  
  sub gt
  {
      my $self = shift;
      my $other = shift;
  
      return $self->cmp($other) > 0 ;
  }
  
  sub cmp
  {
      my $self = shift;
      my $other = shift ;
  
      if ($self->[LOW] == $other->[LOW]) {
          return $self->[HIGH] - $other->[HIGH] ;
      }
      else {
          return $self->[LOW] - $other->[LOW] ;
      }
  }
      
  
  sub is64bit
  {
      return $_[0]->[HIGH] > 0 ;
  }
  
  sub isAlmost64bit
  {
      return $_[0]->[HIGH] > 0 ||  $_[0]->[LOW] == MAX32 ;
  }
  
  sub getPacked_V64
  {
      return pack "V V", @{ $_[0] } ;
  }
  
  sub getPacked_V32
  {
      return pack "V", $_[0]->[LOW] ;
  }
  
  sub pack_V64
  {
      return pack "V V", $_[0], 0;
  }
  
  
  sub full32 
  {
      return $_[0] == MAX32 ;
  }
  
  sub Value_VV64
  {
      my $buffer = shift;
  
      my ($lo, $hi) = unpack ("V V" , $buffer);
      no warnings 'uninitialized';
      return $hi * HI_1 + $lo;
  }
  
  
  package IO::Compress::Base::Common;
  
  1;
IO_COMPRESS_BASE_COMMON

$fatpacked{"IO/Compress/Bzip2.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'IO_COMPRESS_BZIP2';
  package IO::Compress::Bzip2 ;
  
  use strict ;
  use warnings;
  use bytes;
  require Exporter ;
  
  use IO::Compress::Base 2.068 ;
  
  use IO::Compress::Base::Common  2.068 qw();
  use IO::Compress::Adapter::Bzip2 2.068 ;
  
  
  
  our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, $Bzip2Error);
  
  $VERSION = '2.068';
  $Bzip2Error = '';
  
  @ISA    = qw(Exporter IO::Compress::Base);
  @EXPORT_OK = qw( $Bzip2Error bzip2 ) ;
  %EXPORT_TAGS = %IO::Compress::Base::EXPORT_TAGS ;
  push @{ $EXPORT_TAGS{all} }, @EXPORT_OK ;
  Exporter::export_ok_tags('all');
  
  
  
  sub new
  {
      my $class = shift ;
  
      my $obj = IO::Compress::Base::Common::createSelfTiedObject($class, \$Bzip2Error);
      return $obj->_create(undef, @_);
  }
  
  sub bzip2
  {
      my $obj = IO::Compress::Base::Common::createSelfTiedObject(undef, \$Bzip2Error);
      $obj->_def(@_);
  }
  
  
  sub mkHeader 
  {
      my $self = shift ;
      return '';
  
  }
  
  sub getExtraParams
  {
      my $self = shift ;
  
      use IO::Compress::Base::Common  2.068 qw(:Parse);
      
      return (  
              'blocksize100k' => [IO::Compress::Base::Common::Parse_unsigned,  1],
              'workfactor'    => [IO::Compress::Base::Common::Parse_unsigned,  0],
              'verbosity'     => [IO::Compress::Base::Common::Parse_boolean,   0],
          );
  }
  
  
  
  sub ckParams
  {
      my $self = shift ;
      my $got = shift;
      
      if ($got->parsed('blocksize100k')) {
          my $value = $got->getValue('blocksize100k');
          return $self->saveErrorString(undef, "Parameter 'BlockSize100K' not between 1 and 9, got $value")
              unless defined $value && $value >= 1 && $value <= 9;
  
      }
  
      if ($got->parsed('workfactor')) {
          my $value = $got->getValue('workfactor');
          return $self->saveErrorString(undef, "Parameter 'WorkFactor' not between 0 and 250, got $value")
              unless $value >= 0 && $value <= 250;
      }
  
      return 1 ;
  }
  
  
  sub mkComp
  {
      my $self = shift ;
      my $got = shift ;
  
      my $BlockSize100K = $got->getValue('blocksize100k');
      my $WorkFactor    = $got->getValue('workfactor');
      my $Verbosity     = $got->getValue('verbosity');
  
      my ($obj, $errstr, $errno) = IO::Compress::Adapter::Bzip2::mkCompObject(
                                                 $BlockSize100K, $WorkFactor,
                                                 $Verbosity);
  
      return $self->saveErrorString(undef, $errstr, $errno)
          if ! defined $obj;
      
      return $obj;
  }
  
  
  sub mkTrailer
  {
      my $self = shift ;
      return '';
  }
  
  sub mkFinalTrailer
  {
      return '';
  }
  
  
  sub getInverseClass
  {
      return ('IO::Uncompress::Bunzip2');
  }
  
  sub getFileInfo
  {
      my $self = shift ;
      my $params = shift;
      my $file = shift ;
      
  }
  
  1;
  
  __END__
  
IO_COMPRESS_BZIP2

$fatpacked{"IO/Compress/Deflate.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'IO_COMPRESS_DEFLATE';
  package IO::Compress::Deflate ;
  
  require 5.006 ;
  
  use strict ;
  use warnings;
  use bytes;
  
  require Exporter ;
  
  use IO::Compress::RawDeflate 2.068 ();
  use IO::Compress::Adapter::Deflate 2.068 ;
  
  use IO::Compress::Zlib::Constants 2.068 ;
  use IO::Compress::Base::Common  2.068 qw();
  
  
  our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, %DEFLATE_CONSTANTS, $DeflateError);
  
  $VERSION = '2.068';
  $DeflateError = '';
  
  @ISA    = qw(Exporter IO::Compress::RawDeflate);
  @EXPORT_OK = qw( $DeflateError deflate ) ;
  %EXPORT_TAGS = %IO::Compress::RawDeflate::DEFLATE_CONSTANTS ;
  
  push @{ $EXPORT_TAGS{all} }, @EXPORT_OK ;
  Exporter::export_ok_tags('all');
  
  
  sub new
  {
      my $class = shift ;
  
      my $obj = IO::Compress::Base::Common::createSelfTiedObject($class, \$DeflateError);
      return $obj->_create(undef, @_);
  }
  
  sub deflate
  {
      my $obj = IO::Compress::Base::Common::createSelfTiedObject(undef, \$DeflateError);
      return $obj->_def(@_);
  }
  
  
  sub bitmask($$$$)
  {
      my $into  = shift ;
      my $value  = shift ;
      my $offset = shift ;
      my $mask   = shift ;
  
      return $into | (($value & $mask) << $offset ) ;
  }
  
  sub mkDeflateHdr($$$;$)
  {
      my $method = shift ;
      my $cinfo  = shift;
      my $level  = shift;
      my $fdict_adler = shift  ;
  
      my $cmf = 0;
      my $flg = 0;
      my $fdict = 0;
      $fdict = 1 if defined $fdict_adler;
  
      $cmf = bitmask($cmf, $method, ZLIB_CMF_CM_OFFSET,    ZLIB_CMF_CM_BITS);
      $cmf = bitmask($cmf, $cinfo,  ZLIB_CMF_CINFO_OFFSET, ZLIB_CMF_CINFO_BITS);
  
      $flg = bitmask($flg, $fdict,  ZLIB_FLG_FDICT_OFFSET, ZLIB_FLG_FDICT_BITS);
      $flg = bitmask($flg, $level,  ZLIB_FLG_LEVEL_OFFSET, ZLIB_FLG_LEVEL_BITS);
  
      my $fcheck = 31 - ($cmf * 256 + $flg) % 31 ;
      $flg = bitmask($flg, $fcheck, ZLIB_FLG_FCHECK_OFFSET, ZLIB_FLG_FCHECK_BITS);
  
      my $hdr =  pack("CC", $cmf, $flg) ;
      $hdr .= pack("N", $fdict_adler) if $fdict ;
  
      return $hdr;
  }
  
  sub mkHeader 
  {
      my $self = shift ;
      my $param = shift ;
  
      my $level = $param->getValue('level');
      my $strategy = $param->getValue('strategy');
  
      my $lflag ;
      $level = 6 
          if $level == Z_DEFAULT_COMPRESSION ;
  
      if (ZLIB_VERNUM >= 0x1210)
      {
          if ($strategy >= Z_HUFFMAN_ONLY || $level < 2)
           {  $lflag = ZLIB_FLG_LEVEL_FASTEST }
          elsif ($level < 6)
           {  $lflag = ZLIB_FLG_LEVEL_FAST }
          elsif ($level == 6)
           {  $lflag = ZLIB_FLG_LEVEL_DEFAULT }
          else
           {  $lflag = ZLIB_FLG_LEVEL_SLOWEST }
      }
      else
      {
          $lflag = ($level - 1) >> 1 ;
          $lflag = 3 if $lflag > 3 ;
      }
  
      my $wbits = 7;
      mkDeflateHdr(ZLIB_CMF_CM_DEFLATED, $wbits, $lflag);
  }
  
  sub ckParams
  {
      my $self = shift ;
      my $got = shift;
      
      $got->setValue('adler32' => 1);
      return 1 ;
  }
  
  
  sub mkTrailer
  {
      my $self = shift ;
      return pack("N", *$self->{Compress}->adler32()) ;
  }
  
  sub mkFinalTrailer
  {
      return '';
  }
  
  
  sub getExtraParams
  {
      my $self = shift ;
      return $self->getZlibParams(),
  }
  
  sub getInverseClass
  {
      return ('IO::Uncompress::Inflate',
                  \$IO::Uncompress::Inflate::InflateError);
  }
  
  sub getFileInfo
  {
      my $self = shift ;
      my $params = shift;
      my $file = shift ;
      
  }
  
  
  
  1;
  
  __END__
  
IO_COMPRESS_DEFLATE

$fatpacked{"IO/Compress/Gzip.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'IO_COMPRESS_GZIP';
  package IO::Compress::Gzip ;
  
  require 5.006 ;
  
  use strict ;
  use warnings;
  use bytes;
  
  require Exporter ;
  
  use IO::Compress::RawDeflate 2.068 () ; 
  use IO::Compress::Adapter::Deflate 2.068 ;
  
  use IO::Compress::Base::Common  2.068 qw(:Status );
  use IO::Compress::Gzip::Constants 2.068 ;
  use IO::Compress::Zlib::Extra 2.068 ;
  
  BEGIN
  {
      if (defined &utf8::downgrade ) 
        { *noUTF8 = \&utf8::downgrade }
      else
        { *noUTF8 = sub {} }  
  }
  
  our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, %DEFLATE_CONSTANTS, $GzipError);
  
  $VERSION = '2.068';
  $GzipError = '' ;
  
  @ISA    = qw(Exporter IO::Compress::RawDeflate);
  @EXPORT_OK = qw( $GzipError gzip ) ;
  %EXPORT_TAGS = %IO::Compress::RawDeflate::DEFLATE_CONSTANTS ;
  
  push @{ $EXPORT_TAGS{all} }, @EXPORT_OK ;
  Exporter::export_ok_tags('all');
  
  sub new
  {
      my $class = shift ;
  
      my $obj = IO::Compress::Base::Common::createSelfTiedObject($class, \$GzipError);
  
      $obj->_create(undef, @_);
  }
  
  
  sub gzip
  {
      my $obj = IO::Compress::Base::Common::createSelfTiedObject(undef, \$GzipError);
      return $obj->_def(@_);
  }
  
  
  sub getExtraParams
  {
      my $self = shift ;
  
      return (
              $self->getZlibParams(),
             
              'minimal'   => [IO::Compress::Base::Common::Parse_boolean,   0],
              'comment'   => [IO::Compress::Base::Common::Parse_any,       undef],
              'name'      => [IO::Compress::Base::Common::Parse_any,       undef],
              'time'      => [IO::Compress::Base::Common::Parse_any,       undef],
              'textflag'  => [IO::Compress::Base::Common::Parse_boolean,   0],
              'headercrc' => [IO::Compress::Base::Common::Parse_boolean,   0],
              'os_code'   => [IO::Compress::Base::Common::Parse_unsigned,  $Compress::Raw::Zlib::gzip_os_code],
              'extrafield'=> [IO::Compress::Base::Common::Parse_any,       undef],
              'extraflags'=> [IO::Compress::Base::Common::Parse_any,       undef],
  
          );
  }
  
  
  sub ckParams
  {
      my $self = shift ;
      my $got = shift ;
  
      $got->setValue('crc32' => 1);
  
      return 1
          if $got->getValue('merge') ;
  
      my $strict = $got->getValue('strict') ;
  
  
      {
          if (! $got->parsed('time') ) {
              $got->setValue(time => time) ;
          }
  
          if ($got->parsed('name') && defined $got->getValue('name')) {
              my $name = $got->getValue('name');
                  
              return $self->saveErrorString(undef, "Null Character found in Name",
                                                  Z_DATA_ERROR)
                  if $strict && $name =~ /\x00/ ;
  
              return $self->saveErrorString(undef, "Non ISO 8859-1 Character found in Name",
                                                  Z_DATA_ERROR)
                  if $strict && $name =~ /$GZIP_FNAME_INVALID_CHAR_RE/o ;
          }
  
          if ($got->parsed('comment') && defined $got->getValue('comment')) {
              my $comment = $got->getValue('comment');
  
              return $self->saveErrorString(undef, "Null Character found in Comment",
                                                  Z_DATA_ERROR)
                  if $strict && $comment =~ /\x00/ ;
  
              return $self->saveErrorString(undef, "Non ISO 8859-1 Character found in Comment",
                                                  Z_DATA_ERROR)
                  if $strict && $comment =~ /$GZIP_FCOMMENT_INVALID_CHAR_RE/o;
          }
  
          if ($got->parsed('os_code') ) {
              my $value = $got->getValue('os_code');
  
              return $self->saveErrorString(undef, "OS_Code must be between 0 and 255, got '$value'")
                  if $value < 0 || $value > 255 ;
              
          }
  
          $got->setValue('method' => Z_DEFLATED) ;
  
          if ( ! $got->parsed('extraflags')) {
              $got->setValue('extraflags' => 2) 
                  if $got->getValue('level') == Z_BEST_COMPRESSION ;
              $got->setValue('extraflags' => 4) 
                  if $got->getValue('level') == Z_BEST_SPEED ;
          }
  
          my $data = $got->getValue('extrafield') ;
          if (defined $data) {
              my $bad = IO::Compress::Zlib::Extra::parseExtraField($data, $strict, 1) ;
              return $self->saveErrorString(undef, "Error with ExtraField Parameter: $bad", Z_DATA_ERROR)
                  if $bad ;
  
              $got->setValue('extrafield' => $data) ;
          }
      }
  
      return 1;
  }
  
  sub mkTrailer
  {
      my $self = shift ;
      return pack("V V", *$self->{Compress}->crc32(), 
                         *$self->{UnCompSize}->get32bit());
  }
  
  sub getInverseClass
  {
      return ('IO::Uncompress::Gunzip',
                  \$IO::Uncompress::Gunzip::GunzipError);
  }
  
  sub getFileInfo
  {
      my $self = shift ;
      my $params = shift;
      my $filename = shift ;
  
      return if IO::Compress::Base::Common::isaScalar($filename);
  
      my $defaultTime = (stat($filename))[9] ;
  
      $params->setValue('name' => $filename)
          if ! $params->parsed('name') ;
  
      $params->setValue('time' => $defaultTime) 
          if ! $params->parsed('time') ;
  }
  
  
  sub mkHeader
  {
      my $self = shift ;
      my $param = shift ;
  
      return GZIP_MINIMUM_HEADER if $param->getValue('minimal') ;
  
      my $method = $param->valueOrDefault('method', GZIP_CM_DEFLATED) ;
  
      my $flags       = GZIP_FLG_DEFAULT ;
      $flags |= GZIP_FLG_FTEXT    if $param->getValue('textflag') ;
      $flags |= GZIP_FLG_FHCRC    if $param->getValue('headercrc') ;
      $flags |= GZIP_FLG_FEXTRA   if $param->wantValue('extrafield') ;
      $flags |= GZIP_FLG_FNAME    if $param->wantValue('name') ;
      $flags |= GZIP_FLG_FCOMMENT if $param->wantValue('comment') ;
      
      my $time = $param->valueOrDefault('time', GZIP_MTIME_DEFAULT) ;
  
      my $extra_flags = $param->valueOrDefault('extraflags', GZIP_XFL_DEFAULT);
  
      my $os_code = $param->valueOrDefault('os_code', GZIP_OS_DEFAULT) ;
  
  
      my $out = pack("C4 V C C", 
              GZIP_ID1,   
              GZIP_ID2,   
              $method,    
              $flags,     
              $time,      
              $extra_flags, 
              $os_code,   
              ) ;
  
      if ($flags & GZIP_FLG_FEXTRA) {
          my $extra = $param->getValue('extrafield') ;
          $out .= pack("v", length $extra) . $extra ;
      }
  
      if ($flags & GZIP_FLG_FNAME) {
          my $name .= $param->getValue('name') ;
          $name =~ s/\x00.*$//;
          $out .= $name ;
          $out .= GZIP_NULL_BYTE 
              if !length $name or
                 substr($name, 1, -1) ne GZIP_NULL_BYTE ;
      }
  
      if ($flags & GZIP_FLG_FCOMMENT) {
          my $comment .= $param->getValue('comment') ;
          $comment =~ s/\x00.*$//;
          $out .= $comment ;
          $out .= GZIP_NULL_BYTE
              if ! length $comment or
                 substr($comment, 1, -1) ne GZIP_NULL_BYTE;
      }
  
      $out .= pack("v", Compress::Raw::Zlib::crc32($out) & 0x00FF ) 
          if $param->getValue('headercrc') ;
  
      noUTF8($out);
  
      return $out ;
  }
  
  sub mkFinalTrailer
  {
      return '';
  }
  
  1; 
  
  __END__
  
IO_COMPRESS_GZIP

$fatpacked{"IO/Compress/Gzip/Constants.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'IO_COMPRESS_GZIP_CONSTANTS';
  package IO::Compress::Gzip::Constants;
  
  use strict ;
  use warnings;
  use bytes;
  
  require Exporter;
  
  our ($VERSION, @ISA, @EXPORT, %GZIP_OS_Names);
  our ($GZIP_FNAME_INVALID_CHAR_RE, $GZIP_FCOMMENT_INVALID_CHAR_RE);
  
  $VERSION = '2.068';
  
  @ISA = qw(Exporter);
  
  @EXPORT= qw(
  
      GZIP_ID_SIZE
      GZIP_ID1
      GZIP_ID2
  
      GZIP_FLG_DEFAULT
      GZIP_FLG_FTEXT
      GZIP_FLG_FHCRC
      GZIP_FLG_FEXTRA
      GZIP_FLG_FNAME
      GZIP_FLG_FCOMMENT
      GZIP_FLG_RESERVED
  
      GZIP_CM_DEFLATED
  
      GZIP_MIN_HEADER_SIZE
      GZIP_TRAILER_SIZE
  
      GZIP_MTIME_DEFAULT
      GZIP_XFL_DEFAULT
      GZIP_FEXTRA_HEADER_SIZE
      GZIP_FEXTRA_MAX_SIZE
      GZIP_FEXTRA_SUBFIELD_HEADER_SIZE
      GZIP_FEXTRA_SUBFIELD_ID_SIZE
      GZIP_FEXTRA_SUBFIELD_LEN_SIZE
      GZIP_FEXTRA_SUBFIELD_MAX_SIZE
  
      $GZIP_FNAME_INVALID_CHAR_RE
      $GZIP_FCOMMENT_INVALID_CHAR_RE
  
      GZIP_FHCRC_SIZE
  
      GZIP_ISIZE_MAX
      GZIP_ISIZE_MOD_VALUE
  
  
      GZIP_NULL_BYTE
  
      GZIP_OS_DEFAULT
  
      %GZIP_OS_Names
  
      GZIP_MINIMUM_HEADER
  
      );
  
  
  use constant GZIP_ID_SIZE                     => 2 ;
  use constant GZIP_ID1                         => 0x1F;
  use constant GZIP_ID2                         => 0x8B;
  
  use constant GZIP_MIN_HEADER_SIZE             => 10 ;
  use constant GZIP_TRAILER_SIZE                => 8 ;
  
  
  use constant GZIP_FLG_DEFAULT                 => 0x00 ;
  use constant GZIP_FLG_FTEXT                   => 0x01 ;
  use constant GZIP_FLG_FHCRC                   => 0x02 ; 
  use constant GZIP_FLG_FEXTRA                  => 0x04 ;
  use constant GZIP_FLG_FNAME                   => 0x08 ;
  use constant GZIP_FLG_FCOMMENT                => 0x10 ;
  use constant GZIP_FLG_RESERVED                => (0x20 | 0x40 | 0x80) ;
  
  use constant GZIP_XFL_DEFAULT                 => 0x00 ;
  
  use constant GZIP_MTIME_DEFAULT               => 0x00 ;
  
  use constant GZIP_FEXTRA_HEADER_SIZE          => 2 ;
  use constant GZIP_FEXTRA_MAX_SIZE             => 0xFFFF ;
  use constant GZIP_FEXTRA_SUBFIELD_ID_SIZE     => 2 ;
  use constant GZIP_FEXTRA_SUBFIELD_LEN_SIZE    => 2 ;
  use constant GZIP_FEXTRA_SUBFIELD_HEADER_SIZE => GZIP_FEXTRA_SUBFIELD_ID_SIZE +
                                                   GZIP_FEXTRA_SUBFIELD_LEN_SIZE;
  use constant GZIP_FEXTRA_SUBFIELD_MAX_SIZE    => GZIP_FEXTRA_MAX_SIZE - 
                                                   GZIP_FEXTRA_SUBFIELD_HEADER_SIZE ;
  
  
  if (ord('A') == 193)
  {
      $GZIP_FNAME_INVALID_CHAR_RE = '[\x00-\x3f\xff]';
      $GZIP_FCOMMENT_INVALID_CHAR_RE = '[\x00-\x0a\x11-\x14\x16-\x3f\xff]';
      
  }
  else
  {
      $GZIP_FNAME_INVALID_CHAR_RE       =  '[\x00-\x1F\x7F-\x9F]';
      $GZIP_FCOMMENT_INVALID_CHAR_RE    =  '[\x00-\x09\x11-\x1F\x7F-\x9F]';
  }            
  
  use constant GZIP_FHCRC_SIZE        => 2 ; 
  
  use constant GZIP_CM_DEFLATED       => 8 ;
  
  use constant GZIP_NULL_BYTE         => "\x00";
  use constant GZIP_ISIZE_MAX         => 0xFFFFFFFF ;
  use constant GZIP_ISIZE_MOD_VALUE   => GZIP_ISIZE_MAX + 1 ;
  
  
  use constant GZIP_OS_DEFAULT=> 0xFF ;
  %GZIP_OS_Names = (
      0   => 'MS-DOS',
      1   => 'Amiga',
      2   => 'VMS',
      3   => 'Unix',
      4   => 'VM/CMS',
      5   => 'Atari TOS',
      6   => 'HPFS (OS/2, NT)',
      7   => 'Macintosh',
      8   => 'Z-System',
      9   => 'CP/M',
      10  => 'TOPS-20',
      11  => 'NTFS (NT)',
      12  => 'SMS QDOS',
      13  => 'Acorn RISCOS',
      14  => 'VFAT file system (Win95, NT)',
      15  => 'MVS',
      16  => 'BeOS',
      17  => 'Tandem/NSK',
      18  => 'THEOS',
      GZIP_OS_DEFAULT()   => 'Unknown',
      ) ;
  
  use constant GZIP_MINIMUM_HEADER =>   pack("C4 V C C",  
          GZIP_ID1, GZIP_ID2, GZIP_CM_DEFLATED, GZIP_FLG_DEFAULT,
          GZIP_MTIME_DEFAULT, GZIP_XFL_DEFAULT, GZIP_OS_DEFAULT) ;
  
  
  1;
IO_COMPRESS_GZIP_CONSTANTS

$fatpacked{"IO/Compress/RawDeflate.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'IO_COMPRESS_RAWDEFLATE';
  package IO::Compress::RawDeflate ;
  
  use strict ;
  use warnings;
  use bytes;
  
  use IO::Compress::Base 2.068 ;
  use IO::Compress::Base::Common  2.068 qw(:Status );
  use IO::Compress::Adapter::Deflate 2.068 ;
  
  require Exporter ;
  
  our ($VERSION, @ISA, @EXPORT_OK, %DEFLATE_CONSTANTS, %EXPORT_TAGS, $RawDeflateError);
  
  $VERSION = '2.068';
  $RawDeflateError = '';
  
  @ISA = qw(Exporter IO::Compress::Base);
  @EXPORT_OK = qw( $RawDeflateError rawdeflate ) ;
  push @EXPORT_OK, @IO::Compress::Adapter::Deflate::EXPORT_OK ;
  
  %EXPORT_TAGS = %IO::Compress::Adapter::Deflate::DEFLATE_CONSTANTS;
  
  
  {
      my %seen;
      foreach (keys %EXPORT_TAGS )
      {
          push @{$EXPORT_TAGS{constants}}, 
                   grep { !$seen{$_}++ } 
                   @{ $EXPORT_TAGS{$_} }
      }
      $EXPORT_TAGS{all} = $EXPORT_TAGS{constants} ;
  }
  
  
  %DEFLATE_CONSTANTS = %EXPORT_TAGS;
  
  
  Exporter::export_ok_tags('all');
                
  
  
  sub new
  {
      my $class = shift ;
  
      my $obj = IO::Compress::Base::Common::createSelfTiedObject($class, \$RawDeflateError);
  
      return $obj->_create(undef, @_);
  }
  
  sub rawdeflate
  {
      my $obj = IO::Compress::Base::Common::createSelfTiedObject(undef, \$RawDeflateError);
      return $obj->_def(@_);
  }
  
  sub ckParams
  {
      my $self = shift ;
      my $got = shift;
  
      return 1 ;
  }
  
  sub mkComp
  {
      my $self = shift ;
      my $got = shift ;
  
      my ($obj, $errstr, $errno) = IO::Compress::Adapter::Deflate::mkCompObject(
                                                   $got->getValue('crc32'),
                                                   $got->getValue('adler32'),
                                                   $got->getValue('level'),
                                                   $got->getValue('strategy')
                                                   );
  
     return $self->saveErrorString(undef, $errstr, $errno)
         if ! defined $obj;
  
     return $obj;    
  }
  
  
  sub mkHeader
  {
      my $self = shift ;
      return '';
  }
  
  sub mkTrailer
  {
      my $self = shift ;
      return '';
  }
  
  sub mkFinalTrailer
  {
      return '';
  }
  
  
  
  sub getExtraParams
  {
      my $self = shift ;
      return getZlibParams();
  }
  
  use IO::Compress::Base::Common  2.068 qw(:Parse);
  use Compress::Raw::Zlib  2.068 qw(Z_DEFLATED Z_DEFAULT_COMPRESSION Z_DEFAULT_STRATEGY);
  our %PARAMS = (
              'level'     => [IO::Compress::Base::Common::Parse_signed,    Z_DEFAULT_COMPRESSION],
              'strategy'  => [IO::Compress::Base::Common::Parse_signed,    Z_DEFAULT_STRATEGY],
  
              'crc32'     => [IO::Compress::Base::Common::Parse_boolean,   0],
              'adler32'   => [IO::Compress::Base::Common::Parse_boolean,   0],
              'merge'     => [IO::Compress::Base::Common::Parse_boolean,   0], 
          );
          
  sub getZlibParams
  {
      return %PARAMS;    
  }
  
  sub getInverseClass
  {
      return ('IO::Uncompress::RawInflate', 
                  \$IO::Uncompress::RawInflate::RawInflateError);
  }
  
  sub getFileInfo
  {
      my $self = shift ;
      my $params = shift;
      my $file = shift ;
      
  }
  
  use Fcntl qw(SEEK_SET);
  
  sub createMerge
  {
      my $self = shift ;
      my $outValue = shift ;
      my $outType = shift ;
  
      my ($invClass, $error_ref) = $self->getInverseClass();
      eval "require $invClass" 
          or die "aaaahhhh" ;
  
      my $inf = $invClass->new( $outValue, 
                               Transparent => 0, 
                               AutoClose   => 0,
                               Scan        => 1)
         or return $self->saveErrorString(undef, "Cannot create InflateScan object: $$error_ref" ) ;
  
      my $end_offset = 0;
      $inf->scan() 
          or return $self->saveErrorString(undef, "Error Scanning: $$error_ref", $inf->errorNo) ;
      $inf->zap($end_offset) 
          or return $self->saveErrorString(undef, "Error Zapping: $$error_ref", $inf->errorNo) ;
  
      my $def = *$self->{Compress} = $inf->createDeflate();
  
      *$self->{Header} = *$inf->{Info}{Header};
      *$self->{UnCompSize} = *$inf->{UnCompSize}->clone();
      *$self->{CompSize} = *$inf->{CompSize}->clone();
  
  
      if ( $outType eq 'buffer') 
        { substr( ${ *$self->{Buffer} }, $end_offset) = '' }
      elsif ($outType eq 'handle' || $outType eq 'filename') {
          *$self->{FH} = *$inf->{FH} ;
          delete *$inf->{FH};
          *$self->{FH}->flush() ;
          *$self->{Handle} = 1 if $outType eq 'handle';
  
          *$self->{FH}->seek($end_offset, SEEK_SET) 
              or return $self->saveErrorString(undef, $!, $!) ;
      }
  
      return $def ;
  }
  
  
  sub deflateParams 
  {
      my $self = shift ;
  
      my $level = shift ;
      my $strategy = shift ;
  
      my $status = *$self->{Compress}->deflateParams(Level => $level, Strategy => $strategy) ;
      return $self->saveErrorString(0, *$self->{Compress}{Error}, *$self->{Compress}{ErrorNo})
          if $status == STATUS_ERROR;
  
      return 1;    
  }
  
  
  
  
  1;
  
  __END__
  
IO_COMPRESS_RAWDEFLATE

$fatpacked{"IO/Compress/Zip.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'IO_COMPRESS_ZIP';
  package IO::Compress::Zip ;
  
  use strict ;
  use warnings;
  use bytes;
  
  use IO::Compress::Base::Common  2.068 qw(:Status );
  use IO::Compress::RawDeflate 2.068 ();
  use IO::Compress::Adapter::Deflate 2.068 ;
  use IO::Compress::Adapter::Identity 2.068 ;
  use IO::Compress::Zlib::Extra 2.068 ;
  use IO::Compress::Zip::Constants 2.068 ;
  
  use File::Spec();
  use Config;
  
  use Compress::Raw::Zlib  2.068 (); 
  
  BEGIN
  {
      eval { require IO::Compress::Adapter::Bzip2 ; 
             import  IO::Compress::Adapter::Bzip2 2.068 ; 
             require IO::Compress::Bzip2 ; 
             import  IO::Compress::Bzip2 2.068 ; 
           } ;
           
      eval { require IO::Compress::Adapter::Lzma ; 
             import  IO::Compress::Adapter::Lzma 2.068 ; 
             require IO::Compress::Lzma ; 
             import  IO::Compress::Lzma 2.068 ; 
           } ;
  }
  
  
  require Exporter ;
  
  our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, %DEFLATE_CONSTANTS, $ZipError);
  
  $VERSION = '2.068';
  $ZipError = '';
  
  @ISA = qw(Exporter IO::Compress::RawDeflate);
  @EXPORT_OK = qw( $ZipError zip ) ;
  %EXPORT_TAGS = %IO::Compress::RawDeflate::DEFLATE_CONSTANTS ;
  
  push @{ $EXPORT_TAGS{all} }, @EXPORT_OK ;
  
  $EXPORT_TAGS{zip_method} = [qw( ZIP_CM_STORE ZIP_CM_DEFLATE ZIP_CM_BZIP2 ZIP_CM_LZMA)];
  push @{ $EXPORT_TAGS{all} }, @{ $EXPORT_TAGS{zip_method} };
  
  Exporter::export_ok_tags('all');
  
  sub new
  {
      my $class = shift ;
  
      my $obj = IO::Compress::Base::Common::createSelfTiedObject($class, \$ZipError);    
      $obj->_create(undef, @_);
  
  }
  
  sub zip
  {
      my $obj = IO::Compress::Base::Common::createSelfTiedObject(undef, \$ZipError);    
      return $obj->_def(@_);
  }
  
  sub isMethodAvailable
  {
      my $method = shift;
      
      return 1
          if $method == ZIP_CM_STORE || $method == ZIP_CM_DEFLATE ;
          
      return 1 
          if $method == ZIP_CM_BZIP2 and 
             defined $IO::Compress::Adapter::Bzip2::VERSION;
             
      return 1
          if $method == ZIP_CM_LZMA and
             defined $IO::Compress::Adapter::Lzma::VERSION;
             
      return 0;       
  }
  
  sub beforePayload
  {
      my $self = shift ;
  
      if (*$self->{ZipData}{Sparse} ) {
          my $inc = 1024 * 100 ;
          my $NULLS = ("\x00" x $inc) ;
          my $sparse = *$self->{ZipData}{Sparse} ;
          *$self->{CompSize}->add( $sparse );
          *$self->{UnCompSize}->add( $sparse );
          
          *$self->{FH}->seek($sparse, IO::Handle::SEEK_CUR);
          
          *$self->{ZipData}{CRC32} = Compress::Raw::Zlib::crc32($NULLS, *$self->{ZipData}{CRC32})
              for 1 .. int $sparse / $inc;
          *$self->{ZipData}{CRC32} = Compress::Raw::Zlib::crc32(substr($NULLS, 0,  $sparse % $inc), 
                                           *$self->{ZipData}{CRC32})
              if $sparse % $inc;
      }
  }
  
  sub mkComp
  {
      my $self = shift ;
      my $got = shift ;
  
      my ($obj, $errstr, $errno) ;
  
      if (*$self->{ZipData}{Method} == ZIP_CM_STORE) {
          ($obj, $errstr, $errno) = IO::Compress::Adapter::Identity::mkCompObject(
                                                   $got->getValue('level'),
                                                   $got->getValue('strategy')
                                                   );
          *$self->{ZipData}{CRC32} = Compress::Raw::Zlib::crc32(undef);
      }
      elsif (*$self->{ZipData}{Method} == ZIP_CM_DEFLATE) {
          ($obj, $errstr, $errno) = IO::Compress::Adapter::Deflate::mkCompObject(
                                                   $got->getValue('crc32'),
                                                   $got->getValue('adler32'),
                                                   $got->getValue('level'),
                                                   $got->getValue('strategy')
                                                   );
      }
      elsif (*$self->{ZipData}{Method} == ZIP_CM_BZIP2) {
          ($obj, $errstr, $errno) = IO::Compress::Adapter::Bzip2::mkCompObject(
                                                  $got->getValue('blocksize100k'),
                                                  $got->getValue('workfactor'),
                                                  $got->getValue('verbosity')
                                                 );
          *$self->{ZipData}{CRC32} = Compress::Raw::Zlib::crc32(undef);
      }
      elsif (*$self->{ZipData}{Method} == ZIP_CM_LZMA) {
          ($obj, $errstr, $errno) = IO::Compress::Adapter::Lzma::mkRawZipCompObject($got->getValue('preset'),
                                                                                   $got->getValue('extreme'),
                                                                                   );
          *$self->{ZipData}{CRC32} = Compress::Raw::Zlib::crc32(undef);
      }
  
      return $self->saveErrorString(undef, $errstr, $errno)
         if ! defined $obj;
  
      if (! defined *$self->{ZipData}{SizesOffset}) {
          *$self->{ZipData}{SizesOffset} = 0;
          *$self->{ZipData}{Offset} = new U64 ;
      }
  
      *$self->{ZipData}{AnyZip64} = 0
          if ! defined  *$self->{ZipData}{AnyZip64} ;
  
      return $obj;    
  }
  
  sub reset
  {
      my $self = shift ;
  
      *$self->{Compress}->reset();
      *$self->{ZipData}{CRC32} = Compress::Raw::Zlib::crc32('');
  
      return STATUS_OK;    
  }
  
  sub filterUncompressed
  {
      my $self = shift ;
  
      if (*$self->{ZipData}{Method} == ZIP_CM_DEFLATE) {
          *$self->{ZipData}{CRC32} = *$self->{Compress}->crc32();
      }
      else {
          *$self->{ZipData}{CRC32} = Compress::Raw::Zlib::crc32(${$_[0]}, *$self->{ZipData}{CRC32});
  
      }
  }
  
  sub canonicalName
  {
  
  
      my $name      = shift;
      my $forceDir  = shift ;
  
      my ( $volume, $directories, $file ) =
        File::Spec->splitpath( File::Spec->canonpath($name), $forceDir );
        
      my @dirs = map { $_ =~ s{/}{_}g; $_ } 
                 File::Spec->splitdir($directories);
  
      if ( @dirs > 0 ) { pop (@dirs) if $dirs[-1] eq '' }   
      push @dirs, defined($file) ? $file : '' ;
  
      my $normalised_path = join '/', @dirs;
  
      $normalised_path =~ s{^/}{};  
  
      return $normalised_path;
  }
  
  
  sub mkHeader
  {
      my $self  = shift;
      my $param = shift ;
      
      *$self->{ZipData}{LocalHdrOffset} = U64::clone(*$self->{ZipData}{Offset});
          
      my $comment = '';
      $comment = $param->valueOrDefault('comment') ;
  
      my $filename = '';
      $filename = $param->valueOrDefault('name') ;
  
      $filename = canonicalName($filename)
          if length $filename && $param->getValue('canonicalname') ;
  
      if (defined *$self->{ZipData}{FilterName} ) {
          local *_ = \$filename ;
          &{ *$self->{ZipData}{FilterName} }() ;
      }
  
  
      my $hdr = '';
  
      my $time = _unixToDosTime($param->getValue('time'));
  
      my $extra = '';
      my $ctlExtra = '';
      my $empty = 0;
      my $osCode = $param->getValue('os_code') ;
      my $extFileAttr = 0 ;
      
      $extFileAttr = 0100644 << 16 
          if $osCode == ZIP_OS_CODE_UNIX ;
  
      if (*$self->{ZipData}{Zip64}) {
          $empty = IO::Compress::Base::Common::MAX32;
  
          my $x = '';
          $x .= pack "V V", 0, 0 ; 
          $x .= pack "V V", 0, 0 ; 
          $extra .= IO::Compress::Zlib::Extra::mkSubField(ZIP_EXTRA_ID_ZIP64, $x);
      }
  
      if (! $param->getValue('minimal')) {
          if ($param->parsed('mtime'))
          {
              $extra .= mkExtendedTime($param->getValue('mtime'), 
                                      $param->getValue('atime'), 
                                      $param->getValue('ctime'));
  
              $ctlExtra .= mkExtendedTime($param->getValue('mtime'));
          }
  
          if ( $osCode == ZIP_OS_CODE_UNIX )
          {
              if ( $param->getValue('want_exunixn') )
              {
                      my $ux3 = mkUnixNExtra( @{ $param->getValue('want_exunixn') }); 
                      $extra    .= $ux3;
                      $ctlExtra .= $ux3;
              }
  
              if ( $param->getValue('exunix2') )
              {
                      $extra    .= mkUnix2Extra( @{ $param->getValue('exunix2') }); 
                      $ctlExtra .= mkUnix2Extra();
              }
          }
  
          $extFileAttr = $param->getValue('extattr') 
              if defined $param->getValue('extattr') ;
  
          $extra .= $param->getValue('extrafieldlocal') 
              if defined $param->getValue('extrafieldlocal');
  
          $ctlExtra .= $param->getValue('extrafieldcentral') 
              if defined $param->getValue('extrafieldcentral');
      }
  
      my $method = *$self->{ZipData}{Method} ;
      my $gpFlag = 0 ;    
      $gpFlag |= ZIP_GP_FLAG_STREAMING_MASK
          if *$self->{ZipData}{Stream} ;
  
      $gpFlag |= ZIP_GP_FLAG_LZMA_EOS_PRESENT
          if $method == ZIP_CM_LZMA ;
  
  
      my $version = $ZIP_CM_MIN_VERSIONS{$method};
      $version = ZIP64_MIN_VERSION
          if ZIP64_MIN_VERSION > $version && *$self->{ZipData}{Zip64};
  
      my $madeBy = ($param->getValue('os_code') << 8) + $version;
      my $extract = $version;
  
      *$self->{ZipData}{Version} = $version;
      *$self->{ZipData}{MadeBy} = $madeBy;
  
      my $ifa = 0;
      $ifa |= ZIP_IFA_TEXT_MASK
          if $param->getValue('textflag');
  
      $hdr .= pack "V", ZIP_LOCAL_HDR_SIG ; 
      $hdr .= pack 'v', $extract   ; 
      $hdr .= pack 'v', $gpFlag    ; 
      $hdr .= pack 'v', $method    ; 
      $hdr .= pack 'V', $time      ; 
      $hdr .= pack 'V', 0          ; 
      $hdr .= pack 'V', $empty     ; 
      $hdr .= pack 'V', $empty     ; 
      $hdr .= pack 'v', length $filename ; 
      $hdr .= pack 'v', length $extra ; 
      
      $hdr .= $filename ;
  
      if (*$self->{ZipData}{Zip64}) {
          *$self->{ZipData}{SizesOffset} = *$self->{ZipData}{Offset}->get64bit()
              + length($hdr) + 4 ;
      }
      else {
          *$self->{ZipData}{SizesOffset} = *$self->{ZipData}{Offset}->get64bit()
                                              + 18;
      }
  
      $hdr .= $extra ;
  
  
      my $ctl = '';
  
      $ctl .= pack "V", ZIP_CENTRAL_HDR_SIG ; 
      $ctl .= pack 'v', $madeBy    ; 
      $ctl .= pack 'v', $extract   ; 
      $ctl .= pack 'v', $gpFlag    ; 
      $ctl .= pack 'v', $method    ; 
      $ctl .= pack 'V', $time      ; 
      $ctl .= pack 'V', 0          ; 
      $ctl .= pack 'V', $empty     ; 
      $ctl .= pack 'V', $empty     ; 
      $ctl .= pack 'v', length $filename ; 
  
      *$self->{ZipData}{ExtraOffset} = length $ctl;
      *$self->{ZipData}{ExtraSize} = length $ctlExtra ;
  
      $ctl .= pack 'v', length $ctlExtra ; 
      $ctl .= pack 'v', length $comment ;  
      $ctl .= pack 'v', 0          ; 
      $ctl .= pack 'v', $ifa       ; 
      $ctl .= pack 'V', $extFileAttr   ; 
  
      if (*$self->{ZipData}{LocalHdrOffset}->is64bit() ) { 
          $ctl .= pack 'V', IO::Compress::Base::Common::MAX32 ;
      }
      else {
          $ctl .= *$self->{ZipData}{LocalHdrOffset}->getPacked_V32() ; 
      }
      
      $ctl .= $filename ;
      $ctl .= $ctlExtra ;
      $ctl .= $comment ;
  
      *$self->{ZipData}{Offset}->add32(length $hdr) ;
  
      *$self->{ZipData}{CentralHeader} = $ctl;
  
  
      return $hdr;
  }
  
  sub mkTrailer
  {
      my $self = shift ;
  
      my $crc32 ;
      if (*$self->{ZipData}{Method} == ZIP_CM_DEFLATE) {
          $crc32 = pack "V", *$self->{Compress}->crc32();
      }
      else {
          $crc32 = pack "V", *$self->{ZipData}{CRC32};
      }
  
      my $ctl = *$self->{ZipData}{CentralHeader} ;
  
      my $sizes ;
      if (! *$self->{ZipData}{Zip64}) {
          $sizes .= *$self->{CompSize}->getPacked_V32() ;   
          $sizes .= *$self->{UnCompSize}->getPacked_V32() ; 
      }
      else {
          $sizes .= *$self->{CompSize}->getPacked_V64() ;   
          $sizes .= *$self->{UnCompSize}->getPacked_V64() ; 
      }
  
      my $data = $crc32 . $sizes ;
  
  
      my $xtrasize  = *$self->{UnCompSize}->getPacked_V64() ; 
         $xtrasize .= *$self->{CompSize}->getPacked_V64() ;   
  
      my $hdr = '';
  
      if (*$self->{ZipData}{Stream}) {
          $hdr  = pack "V", ZIP_DATA_HDR_SIG ;                       
          $hdr .= $data ;
      }
      else {
          $self->writeAt(*$self->{ZipData}{LocalHdrOffset}->get64bit() + 14,  $crc32)
              or return undef;
          $self->writeAt(*$self->{ZipData}{SizesOffset}, 
                  *$self->{ZipData}{Zip64} ? $xtrasize : $sizes)
              or return undef;
      }
  
  
      substr($ctl, 16, length $crc32) = $crc32 ;
  
      my $x = '';
  
      if (*$self->{UnCompSize}->isAlmost64bit() || *$self->{ZipData}{Zip64} > 1) {
          $x .= *$self->{UnCompSize}->getPacked_V64() ; 
      } else {
          substr($ctl, 24, 4) = *$self->{UnCompSize}->getPacked_V32() ;
      }
  
      if (*$self->{CompSize}->isAlmost64bit() || *$self->{ZipData}{Zip64} > 1) {
          $x .= *$self->{CompSize}->getPacked_V64() ; 
      } else {
          substr($ctl, 20, 4) = *$self->{CompSize}->getPacked_V32() ;
      }
  
      $x .= *$self->{ZipData}{LocalHdrOffset}->getPacked_V64()
          if *$self->{ZipData}{LocalHdrOffset}->is64bit() ; 
  
  
      if (length $x) {
          my $xtra = IO::Compress::Zlib::Extra::mkSubField(ZIP_EXTRA_ID_ZIP64, $x);
          $ctl .= $xtra ;
          substr($ctl, *$self->{ZipData}{ExtraOffset}, 2) = 
               pack 'v', *$self->{ZipData}{ExtraSize} + length $xtra;
  
          *$self->{ZipData}{AnyZip64} = 1;
      }
  
      *$self->{ZipData}{Offset}->add32(length($hdr));
      *$self->{ZipData}{Offset}->add( *$self->{CompSize} );
      push @{ *$self->{ZipData}{CentralDir} }, $ctl ;
  
      return $hdr;
  }
  
  sub mkFinalTrailer
  {
      my $self = shift ;
          
      my $comment = '';
      $comment = *$self->{ZipData}{ZipComment} ;
  
      my $cd_offset = *$self->{ZipData}{Offset}->get32bit() ; 
  
      my $entries = @{ *$self->{ZipData}{CentralDir} };
      
      *$self->{ZipData}{AnyZip64} = 1 
          if *$self->{ZipData}{Offset}->is64bit || $entries >= 0xFFFF ;      
             
      my $cd = join '', @{ *$self->{ZipData}{CentralDir} };
      my $cd_len = length $cd ;
  
      my $z64e = '';
  
      if ( *$self->{ZipData}{AnyZip64} ) {
  
          my $v  = *$self->{ZipData}{Version} ;
          my $mb = *$self->{ZipData}{MadeBy} ;
          $z64e .= pack 'v', $mb            ; 
          $z64e .= pack 'v', $v             ; 
          $z64e .= pack 'V', 0              ; 
          $z64e .= pack 'V', 0              ; 
          $z64e .= U64::pack_V64 $entries   ; 
          $z64e .= U64::pack_V64 $entries   ; 
          $z64e .= U64::pack_V64 $cd_len    ; 
          $z64e .= *$self->{ZipData}{Offset}->getPacked_V64() ; 
  
          $z64e  = pack("V", ZIP64_END_CENTRAL_REC_HDR_SIG) 
                .  U64::pack_V64(length $z64e)
                .  $z64e ;
  
          *$self->{ZipData}{Offset}->add32(length $cd) ; 
  
          $z64e .= pack "V", ZIP64_END_CENTRAL_LOC_HDR_SIG; 
          $z64e .= pack 'V', 0              ; 
          $z64e .= *$self->{ZipData}{Offset}->getPacked_V64() ; 
          $z64e .= pack 'V', 1              ; 
  
          $cd_offset = IO::Compress::Base::Common::MAX32 ;
          $cd_len = IO::Compress::Base::Common::MAX32 if IO::Compress::Base::Common::isGeMax32 $cd_len ;
          $entries = 0xFFFF if $entries >= 0xFFFF ;
      }
  
      my $ecd = '';
      $ecd .= pack "V", ZIP_END_CENTRAL_HDR_SIG ; 
      $ecd .= pack 'v', 0          ; 
      $ecd .= pack 'v', 0          ; 
      $ecd .= pack 'v', $entries   ; 
      $ecd .= pack 'v', $entries   ; 
      $ecd .= pack 'V', $cd_len    ; 
      $ecd .= pack 'V', $cd_offset ; 
      $ecd .= pack 'v', length $comment ; 
      $ecd .= $comment;
  
      return $cd . $z64e . $ecd ;
  }
  
  sub ckParams
  {
      my $self = shift ;
      my $got = shift;
      
      $got->setValue('crc32' => 1);
  
      if (! $got->parsed('time') ) {
          $got->setValue('time' => time) ;
      }
  
      if ($got->parsed('extime') ) {
          my $timeRef = $got->getValue('extime');
          if ( defined $timeRef) {
              return $self->saveErrorString(undef, "exTime not a 3-element array ref")   
                  if ref $timeRef ne 'ARRAY' || @$timeRef != 3;
          }
  
          $got->setValue("mtime", $timeRef->[1]);
          $got->setValue("atime", $timeRef->[0]);
          $got->setValue("ctime", $timeRef->[2]);
      }
      
      for my $name (qw(exunix2 exunixn))
      {
          if ($got->parsed($name) ) {
              my $idRef = $got->getValue($name);
              if ( defined $idRef) {
                  return $self->saveErrorString(undef, "$name not a 2-element array ref")   
                      if ref $idRef ne 'ARRAY' || @$idRef != 2;
              }
  
              $got->setValue("uid", $idRef->[0]);
              $got->setValue("gid", $idRef->[1]);
              $got->setValue("want_$name", $idRef);
          }
      }
  
      *$self->{ZipData}{AnyZip64} = 1
          if $got->getValue('zip64');
      *$self->{ZipData}{Zip64} = $got->getValue('zip64');
      *$self->{ZipData}{Stream} = $got->getValue('stream');
  
      my $method = $got->getValue('method');
      return $self->saveErrorString(undef, "Unknown Method '$method'")   
          if ! defined $ZIP_CM_MIN_VERSIONS{$method};
  
      return $self->saveErrorString(undef, "Bzip2 not available")
          if $method == ZIP_CM_BZIP2 and 
             ! defined $IO::Compress::Adapter::Bzip2::VERSION;
  
      return $self->saveErrorString(undef, "Lzma not available")
          if $method == ZIP_CM_LZMA 
          and ! defined $IO::Compress::Adapter::Lzma::VERSION;
  
      *$self->{ZipData}{Method} = $method;
  
      *$self->{ZipData}{ZipComment} = $got->getValue('zipcomment') ;
  
      for my $name (qw( extrafieldlocal extrafieldcentral ))
      {
          my $data = $got->getValue($name) ;
          if (defined $data) {
              my $bad = IO::Compress::Zlib::Extra::parseExtraField($data, 1, 0) ;
              return $self->saveErrorString(undef, "Error with $name Parameter: $bad")
                  if $bad ;
  
              $got->setValue($name, $data) ;
          }
      }
  
      return undef
          if defined $IO::Compress::Bzip2::VERSION
              and ! IO::Compress::Bzip2::ckParams($self, $got);
  
      if ($got->parsed('sparse') ) {
          *$self->{ZipData}{Sparse} = $got->getValue('sparse') ;
          *$self->{ZipData}{Method} = ZIP_CM_STORE;
      }
  
      if ($got->parsed('filtername')) {
          my $v = $got->getValue('filtername') ;
          *$self->{ZipData}{FilterName} = $v
              if ref $v eq 'CODE' ;
      }
  
      return 1 ;
  }
  
  sub outputPayload
  {
      my $self = shift ;
      return 1 if *$self->{ZipData}{Sparse} ;
      return $self->output(@_);
  }
  
  
  
  
  our %PARAMS = (            
              'stream'    => [IO::Compress::Base::Common::Parse_boolean,   1],
              'method'    => [IO::Compress::Base::Common::Parse_unsigned,  ZIP_CM_DEFLATE],
              
              'minimal'   => [IO::Compress::Base::Common::Parse_boolean,   0],
              'zip64'     => [IO::Compress::Base::Common::Parse_boolean,   0],
              'comment'   => [IO::Compress::Base::Common::Parse_any,       ''],
              'zipcomment'=> [IO::Compress::Base::Common::Parse_any,       ''],
              'name'      => [IO::Compress::Base::Common::Parse_any,       ''],
              'filtername'=> [IO::Compress::Base::Common::Parse_code,      undef],
              'canonicalname'=> [IO::Compress::Base::Common::Parse_boolean,   0],
              'time'      => [IO::Compress::Base::Common::Parse_any,       undef],
              'extime'    => [IO::Compress::Base::Common::Parse_any,       undef],
              'exunix2'   => [IO::Compress::Base::Common::Parse_any,       undef], 
              'exunixn'   => [IO::Compress::Base::Common::Parse_any,       undef], 
              'extattr'   => [IO::Compress::Base::Common::Parse_any, 
                      $Compress::Raw::Zlib::gzip_os_code == 3 
                          ? 0100644 << 16 
                          : 0],
              'os_code'   => [IO::Compress::Base::Common::Parse_unsigned,  $Compress::Raw::Zlib::gzip_os_code],
              
              'textflag'  => [IO::Compress::Base::Common::Parse_boolean,   0],
              'extrafieldlocal'  => [IO::Compress::Base::Common::Parse_any,    undef],
              'extrafieldcentral'=> [IO::Compress::Base::Common::Parse_any,    undef],
  
              'preset'   => [IO::Compress::Base::Common::Parse_unsigned, 6],
              'extreme'  => [IO::Compress::Base::Common::Parse_boolean,  0],
  
              'sparse'    => [IO::Compress::Base::Common::Parse_unsigned,  0],
  
              IO::Compress::RawDeflate::getZlibParams(),
              defined $IO::Compress::Bzip2::VERSION
                  ? IO::Compress::Bzip2::getExtraParams()
                  : ()
                  
    
                  );
  
  sub getExtraParams
  {
      return %PARAMS ;
  }
  
  sub getInverseClass
  {
      return ('IO::Uncompress::Unzip',
                  \$IO::Uncompress::Unzip::UnzipError);
  }
  
  sub getFileInfo
  {
      my $self = shift ;
      my $params = shift;
      my $filename = shift ;
  
      if (IO::Compress::Base::Common::isaScalar($filename))
      {
          $params->setValue(zip64 => 1)
              if IO::Compress::Base::Common::isGeMax32 length (${ $filename }) ;
  
          return ;
      }
  
      my ($mode, $uid, $gid, $size, $atime, $mtime, $ctime) ;
      if ( $params->parsed('storelinks') )
      {
          ($mode, $uid, $gid, $size, $atime, $mtime, $ctime) 
                  = (lstat($filename))[2, 4,5,7, 8,9,10] ;
      }
      else
      {
          ($mode, $uid, $gid, $size, $atime, $mtime, $ctime) 
                  = (stat($filename))[2, 4,5,7, 8,9,10] ;
      }
  
      $params->setValue(textflag => -T $filename )
          if ! $params->parsed('textflag');
  
      $params->setValue(zip64 => 1)
          if IO::Compress::Base::Common::isGeMax32 $size ;
  
      $params->setValue('name' => $filename)
          if ! $params->parsed('name') ;
  
      $params->setValue('time' => $mtime) 
          if ! $params->parsed('time') ;
      
      if ( ! $params->parsed('extime'))
      {
          $params->setValue('mtime' => $mtime) ;
          $params->setValue('atime' => $atime) ;
          $params->setValue('ctime' => undef) ; 
      }
  
      if (! $params->parsed('extattr'))
      {
          use Fcntl qw(:mode) ;
          my $attr = $mode << 16;
          $attr |= ZIP_A_RONLY if ($mode & S_IWRITE) == 0 ;
          $attr |= ZIP_A_DIR   if ($mode & S_IFMT  ) == S_IFDIR ;
          
          $params->setValue('extattr' => $attr);
      }
  
      $params->setValue('want_exunixn', [$uid, $gid]);
      $params->setValue('uid' => $uid) ;
      $params->setValue('gid' => $gid) ;
      
  }
  
  sub mkExtendedTime
  {
  
      my $times = '';
      my $bit = 1 ;
      my $flags = 0;
  
      for my $time (@_)
      {
          if (defined $time)
          {
              $flags |= $bit;
              $times .= pack("V", $time);
          }
  
          $bit <<= 1 ;
      }
  
      return IO::Compress::Zlib::Extra::mkSubField(ZIP_EXTRA_ID_EXT_TIMESTAMP,
                                                   pack("C", $flags) .  $times);
  }
  
  sub mkUnix2Extra
  {
      my $ids = '';
      for my $id (@_)
      {
          $ids .= pack("v", $id);
      }
  
      return IO::Compress::Zlib::Extra::mkSubField(ZIP_EXTRA_ID_INFO_ZIP_UNIX2, 
                                                   $ids);
  }
  
  sub mkUnixNExtra
  {
      my $uid = shift;
      my $gid = shift;
  
      my $ids ;
      $ids .= pack "C", 1; 
      $ids .= pack "C", $Config{uidsize};
      $ids .= pack "V", $uid;
      $ids .= pack "C", $Config{gidsize};
      $ids .= pack "V", $gid;
  
      return IO::Compress::Zlib::Extra::mkSubField(ZIP_EXTRA_ID_INFO_ZIP_UNIXN, 
                                                   $ids);
  }
  
  
  sub _unixToDosTime    
  {
  	my $time_t = shift;
      
  	my ( $sec, $min, $hour, $mday, $mon, $year ) = localtime($time_t);
  	my $dt = 0;
  	$dt += ( $sec >> 1 );
  	$dt += ( $min << 5 );
  	$dt += ( $hour << 11 );
  	$dt += ( $mday << 16 );
  	$dt += ( ( $mon + 1 ) << 21 );
  	$dt += ( ( $year - 80 ) << 25 );
  	return $dt;
  }
  
  1;
  
  __END__
  
IO_COMPRESS_ZIP

$fatpacked{"IO/Compress/Zip/Constants.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'IO_COMPRESS_ZIP_CONSTANTS';
  package IO::Compress::Zip::Constants;
  
  use strict ;
  use warnings;
  
  require Exporter;
  
  our ($VERSION, @ISA, @EXPORT, %ZIP_CM_MIN_VERSIONS);
  
  $VERSION = '2.068';
  
  @ISA = qw(Exporter);
  
  @EXPORT= qw(
  
      ZIP_CM_STORE
      ZIP_CM_DEFLATE
      ZIP_CM_BZIP2
      ZIP_CM_LZMA
      ZIP_CM_PPMD
      
      ZIP_LOCAL_HDR_SIG
      ZIP_DATA_HDR_SIG
      ZIP_CENTRAL_HDR_SIG
      ZIP_END_CENTRAL_HDR_SIG
      ZIP64_END_CENTRAL_REC_HDR_SIG
      ZIP64_END_CENTRAL_LOC_HDR_SIG
      ZIP64_ARCHIVE_EXTRA_SIG
      ZIP64_DIGITAL_SIGNATURE_SIG
  
      ZIP_GP_FLAG_ENCRYPTED_MASK
      ZIP_GP_FLAG_STREAMING_MASK
      ZIP_GP_FLAG_PATCHED_MASK
      ZIP_GP_FLAG_STRONG_ENCRYPTED_MASK
      ZIP_GP_FLAG_LZMA_EOS_PRESENT
      ZIP_GP_FLAG_LANGUAGE_ENCODING
  
      ZIP_EXTRA_ID_ZIP64
      ZIP_EXTRA_ID_EXT_TIMESTAMP
      ZIP_EXTRA_ID_INFO_ZIP_UNIX2
      ZIP_EXTRA_ID_INFO_ZIP_UNIXN
      ZIP_EXTRA_ID_INFO_ZIP_Upath
      ZIP_EXTRA_ID_INFO_ZIP_Ucom        
      ZIP_EXTRA_ID_JAVA_EXE
  
      ZIP_OS_CODE_UNIX
      ZIP_OS_CODE_DEFAULT
  
      ZIP_IFA_TEXT_MASK
  
      %ZIP_CM_MIN_VERSIONS
      ZIP64_MIN_VERSION
  
      ZIP_A_RONLY
      ZIP_A_HIDDEN
      ZIP_A_SYSTEM
      ZIP_A_LABEL
      ZIP_A_DIR 
      ZIP_A_ARCHIVE
      );
  
  use constant ZIP_CM_STORE                      => 0 ;
  use constant ZIP_CM_DEFLATE                    => 8 ;
  use constant ZIP_CM_BZIP2                      => 12 ;
  use constant ZIP_CM_LZMA                       => 14 ; 
  use constant ZIP_CM_PPMD                       => 98 ; 
  
  use constant ZIP_GP_FLAG_ENCRYPTED_MASK        => (1 << 0) ;
  use constant ZIP_GP_FLAG_STREAMING_MASK        => (1 << 3) ;
  use constant ZIP_GP_FLAG_PATCHED_MASK          => (1 << 5) ;
  use constant ZIP_GP_FLAG_STRONG_ENCRYPTED_MASK => (1 << 6) ;
  use constant ZIP_GP_FLAG_LZMA_EOS_PRESENT      => (1 << 1) ;
  use constant ZIP_GP_FLAG_LANGUAGE_ENCODING     => (1 << 11) ;
  
  use constant ZIP_IFA_TEXT_MASK                 => 1;
  
  use constant ZIP_LOCAL_HDR_SIG                 => 0x04034b50;
  use constant ZIP_DATA_HDR_SIG                  => 0x08074b50;
  use constant packed_ZIP_DATA_HDR_SIG           => pack "V", ZIP_DATA_HDR_SIG;
  use constant ZIP_CENTRAL_HDR_SIG               => 0x02014b50;
  use constant ZIP_END_CENTRAL_HDR_SIG           => 0x06054b50;
  use constant ZIP64_END_CENTRAL_REC_HDR_SIG     => 0x06064b50;
  use constant ZIP64_END_CENTRAL_LOC_HDR_SIG     => 0x07064b50;
  use constant ZIP64_ARCHIVE_EXTRA_SIG           => 0x08064b50;
  use constant ZIP64_DIGITAL_SIGNATURE_SIG       => 0x05054b50;
  
  use constant ZIP_OS_CODE_UNIX                  => 3;
  use constant ZIP_OS_CODE_DEFAULT               => 3;
  
  use constant ZIP_EXTRA_ID_ZIP64                => pack "v", 1;
  use constant ZIP_EXTRA_ID_EXT_TIMESTAMP        => "UT";
  use constant ZIP_EXTRA_ID_INFO_ZIP_UNIX2       => "Ux";
  use constant ZIP_EXTRA_ID_INFO_ZIP_UNIXN       => "ux";
  use constant ZIP_EXTRA_ID_INFO_ZIP_Upath       => "up";
  use constant ZIP_EXTRA_ID_INFO_ZIP_Ucom        => "uc";
  use constant ZIP_EXTRA_ID_JAVA_EXE             => pack "v", 0xCAFE;
  
  use constant ZIP_A_RONLY                       => 0x01;
  use constant ZIP_A_HIDDEN                      => 0x02;
  use constant ZIP_A_SYSTEM                      => 0x04;
  use constant ZIP_A_LABEL                       => 0x08;
  use constant ZIP_A_DIR                         => 0x10;
  use constant ZIP_A_ARCHIVE                     => 0x20;
  
  use constant ZIP64_MIN_VERSION                 => 45;
  
  %ZIP_CM_MIN_VERSIONS = (
              ZIP_CM_STORE()                     => 20,
              ZIP_CM_DEFLATE()                   => 20,
              ZIP_CM_BZIP2()                     => 46,
              ZIP_CM_LZMA()                      => 63,
              ZIP_CM_PPMD()                      => 63,
              );
  
  
  1;
  
  __END__
  
IO_COMPRESS_ZIP_CONSTANTS

$fatpacked{"IO/Compress/Zlib/Constants.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'IO_COMPRESS_ZLIB_CONSTANTS';
  
  package IO::Compress::Zlib::Constants ;
  
  use strict ;
  use warnings;
  use bytes;
  
  require Exporter;
  
  our ($VERSION, @ISA, @EXPORT);
  
  $VERSION = '2.068';
  
  @ISA = qw(Exporter);
  
  @EXPORT= qw(
  
          ZLIB_HEADER_SIZE
          ZLIB_TRAILER_SIZE
  
          ZLIB_CMF_CM_OFFSET
          ZLIB_CMF_CM_BITS
          ZLIB_CMF_CM_DEFLATED
  
          ZLIB_CMF_CINFO_OFFSET
          ZLIB_CMF_CINFO_BITS 
          ZLIB_CMF_CINFO_MAX
  
          ZLIB_FLG_FCHECK_OFFSET
          ZLIB_FLG_FCHECK_BITS
  
          ZLIB_FLG_FDICT_OFFSET
          ZLIB_FLG_FDICT_BITS
  
          ZLIB_FLG_LEVEL_OFFSET
          ZLIB_FLG_LEVEL_BITS
  
          ZLIB_FLG_LEVEL_FASTEST
          ZLIB_FLG_LEVEL_FAST
          ZLIB_FLG_LEVEL_DEFAULT
          ZLIB_FLG_LEVEL_SLOWEST
  
          ZLIB_FDICT_SIZE
  
          );
  
  
  use constant ZLIB_HEADER_SIZE       => 2;
  use constant ZLIB_TRAILER_SIZE      => 4;
  
  use constant ZLIB_CMF_CM_OFFSET     => 0;
  use constant ZLIB_CMF_CM_BITS       => 0xF ; 
  use constant ZLIB_CMF_CM_DEFLATED   => 8;
  
  use constant ZLIB_CMF_CINFO_OFFSET  => 4;
  use constant ZLIB_CMF_CINFO_BITS    => 0xF ; 
  use constant ZLIB_CMF_CINFO_MAX     => 7;
  
  use constant ZLIB_FLG_FCHECK_OFFSET => 0;
  use constant ZLIB_FLG_FCHECK_BITS   => 0x1F ; 
  
  use constant ZLIB_FLG_FDICT_OFFSET  => 5;
  use constant ZLIB_FLG_FDICT_BITS    => 0x1 ; 
  
  use constant ZLIB_FLG_LEVEL_OFFSET  => 6;
  use constant ZLIB_FLG_LEVEL_BITS    => 0x3 ; 
  
  use constant ZLIB_FLG_LEVEL_FASTEST => 0;
  use constant ZLIB_FLG_LEVEL_FAST    => 1;
  use constant ZLIB_FLG_LEVEL_DEFAULT => 2;
  use constant ZLIB_FLG_LEVEL_SLOWEST => 3;
  
  use constant ZLIB_FDICT_SIZE        => 4;
  
  
  1;
IO_COMPRESS_ZLIB_CONSTANTS

$fatpacked{"IO/Compress/Zlib/Extra.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'IO_COMPRESS_ZLIB_EXTRA';
  package IO::Compress::Zlib::Extra;
  
  require 5.006 ;
  
  use strict ;
  use warnings;
  use bytes;
  
  our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS);
  
  $VERSION = '2.068';
  
  use IO::Compress::Gzip::Constants 2.068 ;
  
  sub ExtraFieldError
  {
      return $_[0];
      return "Error with ExtraField Parameter: $_[0]" ;
  }
  
  sub validateExtraFieldPair
  {
      my $pair = shift ;
      my $strict = shift;
      my $gzipMode = shift ;
  
      return ExtraFieldError("Not an array ref")
          unless ref $pair &&  ref $pair eq 'ARRAY';
  
      return ExtraFieldError("SubField must have two parts")
          unless @$pair == 2 ;
  
      return ExtraFieldError("SubField ID is a reference")
          if ref $pair->[0] ;
  
      return ExtraFieldError("SubField Data is a reference")
          if ref $pair->[1] ;
  
      return ExtraFieldError("SubField ID not two chars long")
          unless length $pair->[0] == GZIP_FEXTRA_SUBFIELD_ID_SIZE ;
  
      return ExtraFieldError("SubField ID 2nd byte is 0x00")
          if $strict && $gzipMode && substr($pair->[0], 1, 1) eq "\x00" ;
  
      return ExtraFieldError("SubField Data too long")
          if length $pair->[1] > GZIP_FEXTRA_SUBFIELD_MAX_SIZE ;
  
  
      return undef ;
  }
  
  sub parseRawExtra
  {
      my $data     = shift ;
      my $extraRef = shift;
      my $strict   = shift;
      my $gzipMode = shift ;
  
  
  
      my $XLEN = length $data ;
  
      return ExtraFieldError("Too Large")
          if $XLEN > GZIP_FEXTRA_MAX_SIZE;
  
      my $offset = 0 ;
      while ($offset < $XLEN) {
  
          return ExtraFieldError("Truncated in FEXTRA Body Section")
              if $offset + GZIP_FEXTRA_SUBFIELD_HEADER_SIZE  > $XLEN ;
  
          my $id = substr($data, $offset, GZIP_FEXTRA_SUBFIELD_ID_SIZE);    
          $offset += GZIP_FEXTRA_SUBFIELD_ID_SIZE;
  
          my $subLen =  unpack("v", substr($data, $offset,
                                              GZIP_FEXTRA_SUBFIELD_LEN_SIZE));
          $offset += GZIP_FEXTRA_SUBFIELD_LEN_SIZE ;
  
          return ExtraFieldError("Truncated in FEXTRA Body Section")
              if $offset + $subLen > $XLEN ;
  
          my $bad = validateExtraFieldPair( [$id, 
                                             substr($data, $offset, $subLen)], 
                                             $strict, $gzipMode );
          return $bad if $bad ;
          push @$extraRef, [$id => substr($data, $offset, $subLen)]
              if defined $extraRef;;
  
          $offset += $subLen ;
      }
  
          
      return undef ;
  }
  
  sub findID
  {
      my $id_want = shift ;
      my $data    = shift;
  
      my $XLEN = length $data ;
  
      my $offset = 0 ;
      while ($offset < $XLEN) {
  
          return undef
              if $offset + GZIP_FEXTRA_SUBFIELD_HEADER_SIZE  > $XLEN ;
  
          my $id = substr($data, $offset, GZIP_FEXTRA_SUBFIELD_ID_SIZE);    
          $offset += GZIP_FEXTRA_SUBFIELD_ID_SIZE;
  
          my $subLen =  unpack("v", substr($data, $offset,
                                              GZIP_FEXTRA_SUBFIELD_LEN_SIZE));
          $offset += GZIP_FEXTRA_SUBFIELD_LEN_SIZE ;
  
          return undef
              if $offset + $subLen > $XLEN ;
  
          return substr($data, $offset, $subLen)
              if $id eq $id_want ;
  
          $offset += $subLen ;
      }
          
      return undef ;
  }
  
  
  sub mkSubField
  {
      my $id = shift ;
      my $data = shift ;
  
      return $id . pack("v", length $data) . $data ;
  }
  
  sub parseExtraField
  {
      my $dataRef  = $_[0];
      my $strict   = $_[1];
      my $gzipMode = $_[2];
  
  
      
      if ( ! ref $dataRef ) {
  
          return undef
              if ! $strict;
  
          return parseRawExtra($dataRef, undef, 1, $gzipMode);
      }
  
      my $data = $dataRef;
      my $out = '' ;
  
      if (ref $data eq 'ARRAY') {    
          if (ref $data->[0]) {
  
              foreach my $pair (@$data) {
                  return ExtraFieldError("Not list of lists")
                      unless ref $pair eq 'ARRAY' ;
  
                  my $bad = validateExtraFieldPair($pair, $strict, $gzipMode) ;
                  return $bad if $bad ;
  
                  $out .= mkSubField(@$pair);
              }   
          }   
          else {
              return ExtraFieldError("Not even number of elements")
                  unless @$data % 2  == 0;
  
              for (my $ix = 0; $ix <= @$data -1 ; $ix += 2) {
                  my $bad = validateExtraFieldPair([$data->[$ix],
                                                    $data->[$ix+1]], 
                                                   $strict, $gzipMode) ;
                  return $bad if $bad ;
  
                  $out .= mkSubField($data->[$ix], $data->[$ix+1]);
              }   
          }
      }   
      elsif (ref $data eq 'HASH') {    
          while (my ($id, $info) = each %$data) {
              my $bad = validateExtraFieldPair([$id, $info], $strict, $gzipMode);
              return $bad if $bad ;
  
              $out .= mkSubField($id, $info);
          }   
      }   
      else {
          return ExtraFieldError("Not a scalar, array ref or hash ref") ;
      }
  
      return ExtraFieldError("Too Large")
          if length $out > GZIP_FEXTRA_MAX_SIZE;
  
      $_[0] = $out ;
  
      return undef;
  }
  
  1;
  
  __END__
IO_COMPRESS_ZLIB_EXTRA

$fatpacked{"IO/HTML.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'IO_HTML';
  package IO::HTML;
  
  use 5.008;
  use strict;
  use warnings;
  
  use Carp 'croak';
  use Encode 2.10 qw(decode find_encoding); 
  use Exporter 5.57 'import';
  
  our $VERSION = '1.001';
  
  our $default_encoding ||= 'cp1252';
  
  our @EXPORT    = qw(html_file);
  our @EXPORT_OK = qw(find_charset_in html_file_and_encoding html_outfile
                      sniff_encoding);
  
  our %EXPORT_TAGS = (
    rw  => [qw( html_file html_file_and_encoding html_outfile )],
    all => [ @EXPORT, @EXPORT_OK ],
  );
  
  
  
  sub html_file
  {
    (&html_file_and_encoding)[0]; 
  } 
  
  
  
  sub html_file_and_encoding
  {
    my ($filename, $options) = @_;
  
    $options ||= {};
  
    open(my $in, '<:raw', $filename) or croak "Failed to open $filename: $!";
  
  
    my ($encoding, $bom) = sniff_encoding($in, $filename, $options);
  
    if (not defined $encoding) {
      croak "No default encoding specified"
          unless defined($encoding = $default_encoding);
      $encoding = find_encoding($encoding) if $options->{encoding};
    } 
  
    binmode $in, sprintf(":encoding(%s):crlf",
                         $options->{encoding} ? $encoding->name : $encoding);
  
    return ($in, $encoding, $bom);
  } 
  
  
  sub html_outfile
  {
    my ($filename, $encoding, $bom) = @_;
  
    if (not defined $encoding) {
      croak "No default encoding specified"
          unless defined($encoding = $default_encoding);
    } 
    elsif (ref $encoding) {
      $encoding = $encoding->name;
    }
  
    open(my $out, ">:encoding($encoding)", $filename)
        or croak "Failed to open $filename: $!";
  
    print $out "\x{FeFF}" if $bom;
  
    return $out;
  } 
  
  
  sub sniff_encoding
  {
    my ($in, $filename, $options) = @_;
  
    $filename = 'file' unless defined $filename;
    $options ||= {};
  
    my $pos = tell $in;
    croak "Could not seek $filename: $!" if $pos < 0;
  
    croak "Could not read $filename: $!" unless defined read $in, my $buf, 1024;
  
    seek $in, $pos, 0 or croak "Could not seek $filename: $!";
  
  
    my $bom;
    my $encoding = do {
      if ($buf =~ /^\xFe\xFF/) {
        $bom = 2;
        'UTF-16BE';
      } elsif ($buf =~ /^\xFF\xFe/) {
        $bom = 2;
        'UTF-16LE';
      } elsif ($buf =~ /^\xEF\xBB\xBF/) {
        $bom = 3;
        'utf-8-strict';
      } else {
        find_charset_in($buf, $options); 
      }
    }; 
  
    if ($bom) {
      seek $in, $bom, 1 or croak "Could not seek $filename: $!";
      $bom = 1;
    }
    elsif (not defined $encoding) { 
      my $test = decode('utf-8-strict', $buf, Encode::FB_QUIET);
      if ($buf =~ /^(?:                   # nothing left over
           | [\xC2-\xDF]                  # incomplete 2-byte char
           | [\xE0-\xEF] [\x80-\xBF]?     # incomplete 3-byte char
           | [\xF0-\xF4] [\x80-\xBF]{0,2} # incomplete 4-byte char
          )\z/x and $test =~ /[^\x00-\x7F]/) {
        $encoding = 'utf-8-strict';
      } 
    } 
  
    if (defined $encoding and $options->{encoding} and not ref $encoding) {
      $encoding = find_encoding($encoding);
    } 
  
    return wantarray ? ($encoding, $bom) : $encoding;
  } 
  
  
  sub _get_attribute
  {
    m!\G[\x09\x0A\x0C\x0D /]+!gc; 
  
    return if /\G>/gc or not /\G(=?[^\x09\x0A\x0C\x0D =]*)/gc;
  
    my ($name, $value) = (lc $1, '');
  
    if (/\G[\x09\x0A\x0C\x0D ]*=[\x09\x0A\x0C\x0D ]*/gc
        and (/\G"([^"]*)"?/gc or
             /\G'([^']*)'?/gc or
             /\G([^\x09\x0A\x0C\x0D >]*)/gc)) {
      $value = lc $1;
    } 
  
    return wantarray ? ($name, $value) : 1;
  } 
  
  sub _get_charset_from_meta
  {
    for (shift) {
      while (/charset[\x09\x0A\x0C\x0D ]*=[\x09\x0A\x0C\x0D ]*/ig) {
        return $1 if (/\G"([^"]*)"/gc or
                      /\G'([^']*)'/gc or
                      /\G(?!['"])([^\x09\x0A\x0C\x0D ;]+)/gc);
      }
    } 
  
    return undef;
  } 
  
  
  sub find_charset_in
  {
    for (shift) {
      my $options = shift || {};
      my $stop = length > 1024 ? 1024 : length; 
  
      my $expect_pragma = (defined $options->{need_pragma}
                           ? $options->{need_pragma} : 1);
  
      pos() = 0;
      while (pos() < $stop) {
        if (/\G<!--.*?(?<=--)>/sgc) {
        } 
        elsif (m!\G<meta(?=[\x09\x0A\x0C\x0D /])!gic) {
          my ($got_pragma, $need_pragma, $charset);
  
          while (my ($name, $value) = &_get_attribute) {
            if ($name eq 'http-equiv' and $value eq 'content-type') {
              $got_pragma = 1;
            } elsif ($name eq 'content' and not defined $charset) {
              $need_pragma = $expect_pragma
                  if defined($charset = _get_charset_from_meta($value));
            } elsif ($name eq 'charset') {
              $charset = $value;
              $need_pragma = 0;
            }
          } 
  
          if (defined $need_pragma and (not $need_pragma or $got_pragma)) {
            $charset = 'UTF-8'  if $charset =~ /^utf-?16/;
            $charset = 'cp1252' if $charset eq 'iso-8859-1'; 
            if (my $encoding = find_encoding($charset)) {
              return $options->{encoding} ? $encoding : $encoding->name;
            } 
          } 
        } 
        elsif (m!\G</?[a-zA-Z][^\x09\x0A\x0C\x0D >]*!gc) {
          1 while &_get_attribute;
        } 
        elsif (m{\G<[!/?][^>]*}gc) {
        } 
        elsif (m/\G</gc) {
        } 
  
        m/\G[^<]+/gc;
      } 
    } 
  
    return undef;                 
  } 
  
  
  *file               = \&html_file;
  *file_and_encoding  = \&html_file_and_encoding;
  *outfile            = \&html_outfile;
  
  
  1;
  
  __END__
  
IO_HTML

$fatpacked{"IO/Uncompress/Adapter/Bunzip2.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'IO_UNCOMPRESS_ADAPTER_BUNZIP2';
  package IO::Uncompress::Adapter::Bunzip2;
  
  use strict;
  use warnings;
  use bytes;
  
  use IO::Compress::Base::Common 2.068 qw(:Status);
  
  use Compress::Raw::Bzip2 2.068 ;
  
  our ($VERSION, @ISA);
  $VERSION = '2.068';
  
  sub mkUncompObject
  {
      my $small     = shift || 0;
      my $verbosity = shift || 0;
  
      my ($inflate, $status) = new Compress::Raw::Bunzip2(1, 1, $small, $verbosity, 1);
  
      return (undef, "Could not create Inflation object: $status", $status)
          if $status != BZ_OK ;
  
      return bless {'Inf'           => $inflate,
                    'CompSize'      => 0,
                    'UnCompSize'    => 0,
                    'Error'         => '',
                    'ConsumesInput' => 1,
                   }  ;     
      
  }
  
  sub uncompr
  {
      my $self = shift ;
      my $from = shift ;
      my $to   = shift ;
      my $eof  = shift ;
  
      my $inf   = $self->{Inf};
  
      my $status = $inf->bzinflate($from, $to);
      $self->{ErrorNo} = $status;
  
      if ($status != BZ_OK && $status != BZ_STREAM_END )
      {
          $self->{Error} = "Inflation Error: $status";
          return STATUS_ERROR;
      }
  
      
      return STATUS_OK        if $status == BZ_OK ;
      return STATUS_ENDSTREAM if $status == BZ_STREAM_END ;
      return STATUS_ERROR ;
  }
  
  
  sub reset
  {
      my $self = shift ;
  
      my ($inf, $status) = new Compress::Raw::Bunzip2();
      $self->{ErrorNo} = ($status == BZ_OK) ? 0 : $status ;
  
      if ($status != BZ_OK)
      {
          $self->{Error} = "Cannot create Inflate object: $status"; 
          return STATUS_ERROR;
      }
  
      $self->{Inf} = $inf;
  
      return STATUS_OK ;
  }
  
  sub compressedBytes
  {
      my $self = shift ;
      $self->{Inf}->compressedBytes();
  }
  
  sub uncompressedBytes
  {
      my $self = shift ;
      $self->{Inf}->uncompressedBytes();
  }
  
  sub crc32
  {
      my $self = shift ;
  }
  
  sub adler32
  {
      my $self = shift ;
  }
  
  sub sync
  {
      my $self = shift ;
  }
  
  
  1;
  
  __END__
  
IO_UNCOMPRESS_ADAPTER_BUNZIP2

$fatpacked{"IO/Uncompress/Adapter/Identity.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'IO_UNCOMPRESS_ADAPTER_IDENTITY';
  package IO::Uncompress::Adapter::Identity;
  
  use warnings;
  use strict;
  use bytes;
  
  use IO::Compress::Base::Common  2.068 qw(:Status);
  use IO::Compress::Zip::Constants ;
  
  our ($VERSION);
  
  $VERSION = '2.068';
  
  use Compress::Raw::Zlib  2.068 ();
  
  sub mkUncompObject
  {
      my $streaming = shift;
      my $zip64 = shift;
  
      my $crc32 = 1; 
      my $adler32 = shift;
  
      bless { 'CompSize'   => new U64 , 
              'UnCompSize' => 0,
              'wantCRC32'  => $crc32,
              'CRC32'      => Compress::Raw::Zlib::crc32(''),
              'wantADLER32'=> $adler32,
              'ADLER32'    => Compress::Raw::Zlib::adler32(''),
              'ConsumesInput' => 1,
              'Streaming'  => $streaming,
              'Zip64'      => $zip64,
              'DataHdrSize'  => $zip64 ? 24 :  16,
              'Pending'   => '',
  
            } ;
  }
  
  
  sub uncompr
  {
      my $self = shift;
      my $in = $_[0];
      my $eof = $_[2];
  
      my $len = length $$in;
      my $remainder = '';
  
      if (defined $$in && $len) {
  
          if ($self->{Streaming}) {
  
              if (length $self->{Pending}) {
                  $$in = $self->{Pending} . $$in ;
                  $len = length $$in;
                  $self->{Pending} = '';
              }
  
              my $ind = index($$in, "\x50\x4b\x07\x08");
  
              if ($ind < 0) {
                  $len = length $$in;
                  if ($len >= 3 && substr($$in, -3) eq "\x50\x4b\x07") {
                      $ind = $len - 3 ;
                  }
                  elsif ($len >= 2 && substr($$in, -2) eq "\x50\x4b") {
                      $ind = $len - 2 ;
                  }
                  elsif ($len >= 1 && substr($$in, -1) eq "\x50") {
                      $ind = $len - 1 ;
                  }
              }
             
              if ($ind >= 0) {
                  $remainder = substr($$in, $ind) ;
                  substr($$in, $ind) = '' ;
              }
          }
  
          if (length $remainder && length $remainder < $self->{DataHdrSize}) {
              $self->{Pending} = $remainder ;
              $remainder = '';
          }
          elsif (length $remainder >= $self->{DataHdrSize}) {
              my $crc = unpack "V", substr($remainder, 4);
              if ($crc == Compress::Raw::Zlib::crc32($$in,  $self->{CRC32})) {
                  my ($l1, $l2) ;
  
                  if ($self->{Zip64}) {
                      $l1 = U64::newUnpack_V64(substr($remainder, 8));
                      $l2 = U64::newUnpack_V64(substr($remainder, 16));
                  }
                  else {
                      $l1 = U64::newUnpack_V32(substr($remainder, 8));
                      $l2 = U64::newUnpack_V32(substr($remainder, 12));
                  }
                      
                  my $newLen = $self->{CompSize}->clone();
                  $newLen->add(length $$in);
                  if ($l1->equal($l2) && $l1->equal($newLen) ) {
                      $eof = 1;
                  }
                  else {
                      $$in .= substr($remainder, 0, 4) ;
                      $remainder       = substr($remainder, 4);
                      $eof = 0;
                  }
              }
              else {
                  $$in .= substr($remainder, 0, 4) ;
                  $remainder       = substr($remainder, 4);
                  $eof = 0;
              }
          }
  
          if (length $$in) {
              $self->{CompSize}->add(length $$in) ;
  
              $self->{CRC32} = Compress::Raw::Zlib::crc32($$in,  $self->{CRC32})
                  if $self->{wantCRC32};
  
              $self->{ADLER32} = Compress::Zlib::adler32($$in,  $self->{ADLER32})
                  if $self->{wantADLER32};
          }
  
          ${ $_[1] } .= $$in;
          $$in  = $remainder;
      }
  
      return STATUS_ENDSTREAM if $eof;
      return STATUS_OK ;
  }
  
  sub reset
  {
      my $self = shift;
  
      $self->{CompSize}   = 0;
      $self->{UnCompSize} = 0;
      $self->{CRC32}      = Compress::Raw::Zlib::crc32('');
      $self->{ADLER32}    = Compress::Raw::Zlib::adler32('');      
  
      return STATUS_OK ;
  }
  
  
  sub compressedBytes
  {
      my $self = shift ;
      return $self->{CompSize} ;
  }
  
  sub uncompressedBytes
  {
      my $self = shift ;
      return $self->{CompSize} ;
  }
  
  sub sync
  {
      return STATUS_OK ;
  }
  
  sub crc32
  {
      my $self = shift ;
      return $self->{CRC32};
  }
  
  sub adler32
  {
      my $self = shift ;
      return $self->{ADLER32};
  }
  
  
  1;
  
  __END__
IO_UNCOMPRESS_ADAPTER_IDENTITY

$fatpacked{"IO/Uncompress/Adapter/Inflate.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'IO_UNCOMPRESS_ADAPTER_INFLATE';
  package IO::Uncompress::Adapter::Inflate;
  
  use strict;
  use warnings;
  
  use IO::Compress::Base::Common  2.068 qw(:Status);
  use Compress::Raw::Zlib  2.068 qw(Z_OK Z_BUF_ERROR Z_STREAM_END Z_FINISH MAX_WBITS);
  
  our ($VERSION);
  $VERSION = '2.068';
  
  
  
  sub mkUncompObject
  {
      my $crc32   = shift || 1;
      my $adler32 = shift || 1;
      my $scan    = shift || 0;
  
      my $inflate ;
      my $status ;
  
      if ($scan)
      {
          ($inflate, $status) = new Compress::Raw::Zlib::InflateScan
                                      CRC32        => $crc32,
                                      ADLER32      => $adler32,
                                      WindowBits   => - MAX_WBITS ;
      }
      else
      {
          ($inflate, $status) = new Compress::Raw::Zlib::Inflate
                                      AppendOutput => 1,
                                      LimitOutput  => 1,
                                      CRC32        => $crc32,
                                      ADLER32      => $adler32,
                                      WindowBits   => - MAX_WBITS ;
      }
  
      return (undef, "Could not create Inflation object: $status", $status) 
          if $status != Z_OK ;
  
      return bless {'Inf'        => $inflate,
                    'CompSize'   => 0,
                    'UnCompSize' => 0,
                    'Error'      => '',
                    'ConsumesInput' => 1,
                   } ;     
      
  }
  
  sub uncompr
  {
      my $self = shift ;
      my $from = shift ;
      my $to   = shift ;
      my $eof  = shift ;
  
      my $inf   = $self->{Inf};
  
      my $status = $inf->inflate($from, $to, $eof);
      $self->{ErrorNo} = $status;
  
      if ($status != Z_OK && $status != Z_STREAM_END && $status != Z_BUF_ERROR)
      {
          $self->{Error} = "Inflation Error: $status";
          return STATUS_ERROR;
      }
              
      return STATUS_OK        if $status == Z_BUF_ERROR ; 
      return STATUS_OK        if $status == Z_OK ;
      return STATUS_ENDSTREAM if $status == Z_STREAM_END ;
      return STATUS_ERROR ;
  }
  
  sub reset
  {
      my $self = shift ;
      $self->{Inf}->inflateReset();
  
      return STATUS_OK ;
  }
  
  
  sub crc32
  {
      my $self = shift ;
      $self->{Inf}->crc32();
  }
  
  sub compressedBytes
  {
      my $self = shift ;
      $self->{Inf}->compressedBytes();
  }
  
  sub uncompressedBytes
  {
      my $self = shift ;
      $self->{Inf}->uncompressedBytes();
  }
  
  sub adler32
  {
      my $self = shift ;
      $self->{Inf}->adler32();
  }
  
  sub sync
  {
      my $self = shift ;
      ( $self->{Inf}->inflateSync(@_) == Z_OK) 
              ? STATUS_OK 
              : STATUS_ERROR ;
  }
  
  
  sub getLastBlockOffset
  {
      my $self = shift ;
      $self->{Inf}->getLastBlockOffset();
  }
  
  sub getEndOffset
  {
      my $self = shift ;
      $self->{Inf}->getEndOffset();
  }
  
  sub resetLastBlockByte
  {
      my $self = shift ;
      $self->{Inf}->resetLastBlockByte(@_);
  }
  
  sub createDeflateStream
  {
      my $self = shift ;
      my $deflate = $self->{Inf}->createDeflateStream(@_);
      return bless {'Def'        => $deflate,
                    'CompSize'   => 0,
                    'UnCompSize' => 0,
                    'Error'      => '',
                   }, 'IO::Compress::Adapter::Deflate';
  }
  
  1;
  
  
  __END__
  
IO_UNCOMPRESS_ADAPTER_INFLATE

$fatpacked{"IO/Uncompress/AnyInflate.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'IO_UNCOMPRESS_ANYINFLATE';
  package IO::Uncompress::AnyInflate ;
  
  
  use strict;
  use warnings;
  use bytes;
  
  use IO::Compress::Base::Common  2.068 ();
  
  use IO::Uncompress::Adapter::Inflate  2.068 ();
  
  
  use IO::Uncompress::Base  2.068 ;
  use IO::Uncompress::Gunzip  2.068 ;
  use IO::Uncompress::Inflate  2.068 ;
  use IO::Uncompress::RawInflate  2.068 ;
  use IO::Uncompress::Unzip  2.068 ;
  
  require Exporter ;
  
  our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, $AnyInflateError);
  
  $VERSION = '2.068';
  $AnyInflateError = '';
  
  @ISA = qw( Exporter IO::Uncompress::Base );
  @EXPORT_OK = qw( $AnyInflateError anyinflate ) ;
  %EXPORT_TAGS = %IO::Uncompress::Base::DEFLATE_CONSTANTS ;
  push @{ $EXPORT_TAGS{all} }, @EXPORT_OK ;
  Exporter::export_ok_tags('all');
  
  
  sub new
  {
      my $class = shift ;
      my $obj = IO::Compress::Base::Common::createSelfTiedObject($class, \$AnyInflateError);
      $obj->_create(undef, 0, @_);
  }
  
  sub anyinflate
  {
      my $obj = IO::Compress::Base::Common::createSelfTiedObject(undef, \$AnyInflateError);
      return $obj->_inf(@_) ;
  }
  
  sub getExtraParams
  {
      use IO::Compress::Base::Common  2.068 qw(:Parse);
      return ( 'rawinflate' => [Parse_boolean,  0] ) ;
  }
  
  sub ckParams
  {
      my $self = shift ;
      my $got = shift ;
  
      $got->setValue('crc32' => 1);
      $got->setValue('adler32' => 1);
  
      return 1;
  }
  
  sub mkUncomp
  {
      my $self = shift ;
      my $got = shift ;
  
      my ($obj, $errstr, $errno) = IO::Uncompress::Adapter::Inflate::mkUncompObject();
  
      return $self->saveErrorString(undef, $errstr, $errno)
          if ! defined $obj;
  
      *$self->{Uncomp} = $obj;
      
       my @possible = qw( Inflate Gunzip Unzip );
       unshift @possible, 'RawInflate' 
          if 1 || $got->getValue('rawinflate');
  
       my $magic = $self->ckMagic( @possible );
  
       if ($magic) {
          *$self->{Info} = $self->readHeader($magic)
              or return undef ;
  
          return 1;
       }
  
       return 0 ;
  }
  
  
  
  sub ckMagic
  {
      my $self = shift;
      my @names = @_ ;
  
      my $keep = ref $self ;
      for my $class ( map { "IO::Uncompress::$_" } @names)
      {
          bless $self => $class;
          my $magic = $self->ckMagic();
  
          if ($magic)
          {
              return $magic ;
          }
  
          $self->pushBack(*$self->{HeaderPending})  ;
          *$self->{HeaderPending} = ''  ;
      }    
  
      bless $self => $keep;
      return undef;
  }
  
  1 ;
  
  __END__
  
  
IO_UNCOMPRESS_ANYINFLATE

$fatpacked{"IO/Uncompress/AnyUncompress.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'IO_UNCOMPRESS_ANYUNCOMPRESS';
  package IO::Uncompress::AnyUncompress ;
  
  use strict;
  use warnings;
  use bytes;
  
  use IO::Compress::Base::Common 2.068 ();
  
  use IO::Uncompress::Base 2.068 ;
  
  
  require Exporter ;
  
  our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, $AnyUncompressError);
  
  $VERSION = '2.068';
  $AnyUncompressError = '';
  
  @ISA = qw( Exporter IO::Uncompress::Base );
  @EXPORT_OK = qw( $AnyUncompressError anyuncompress ) ;
  %EXPORT_TAGS = %IO::Uncompress::Base::DEFLATE_CONSTANTS ;
  push @{ $EXPORT_TAGS{all} }, @EXPORT_OK ;
  Exporter::export_ok_tags('all');
  
  
  BEGIN
  {
     eval ' use IO::Uncompress::Adapter::Inflate 2.068 ;';
     eval ' use IO::Uncompress::Adapter::Bunzip2 2.068 ;';
     eval ' use IO::Uncompress::Adapter::LZO 2.068 ;';
     eval ' use IO::Uncompress::Adapter::Lzf 2.068 ;';
     eval ' use IO::Uncompress::Adapter::UnLzma 2.068 ;';
     eval ' use IO::Uncompress::Adapter::UnXz 2.068 ;';
  
     eval ' use IO::Uncompress::Bunzip2 2.068 ;';
     eval ' use IO::Uncompress::UnLzop 2.068 ;';
     eval ' use IO::Uncompress::Gunzip 2.068 ;';
     eval ' use IO::Uncompress::Inflate 2.068 ;';
     eval ' use IO::Uncompress::RawInflate 2.068 ;';
     eval ' use IO::Uncompress::Unzip 2.068 ;';
     eval ' use IO::Uncompress::UnLzf 2.068 ;';
     eval ' use IO::Uncompress::UnLzma 2.068 ;';
     eval ' use IO::Uncompress::UnXz 2.068 ;';
  }
  
  sub new
  {
      my $class = shift ;
      my $obj = IO::Compress::Base::Common::createSelfTiedObject($class, \$AnyUncompressError);
      $obj->_create(undef, 0, @_);
  }
  
  sub anyuncompress
  {
      my $obj = IO::Compress::Base::Common::createSelfTiedObject(undef, \$AnyUncompressError);
      return $obj->_inf(@_) ;
  }
  
  sub getExtraParams
  { 
      return ( 'rawinflate' => [IO::Compress::Base::Common::Parse_boolean,  0] ,
               'unlzma'     => [IO::Compress::Base::Common::Parse_boolean,  0] ) ;
  }
  
  sub ckParams
  {
      my $self = shift ;
      my $got = shift ;
  
      $got->setValue('crc32' => 1);
      $got->setValue('adler32' => 1);
  
      return 1;
  }
  
  sub mkUncomp
  {
      my $self = shift ;
      my $got = shift ;
  
      my $magic ;
  
      if (defined $IO::Uncompress::RawInflate::VERSION )
      {
          my ($obj, $errstr, $errno) = IO::Uncompress::Adapter::Inflate::mkUncompObject();
  
          return $self->saveErrorString(undef, $errstr, $errno)
              if ! defined $obj;
  
          *$self->{Uncomp} = $obj;
          
          my @possible = qw( Inflate Gunzip Unzip );
          unshift @possible, 'RawInflate' 
              if $got->getValue('rawinflate');
  
          $magic = $self->ckMagic( @possible );
          
          if ($magic) {
              *$self->{Info} = $self->readHeader($magic)
                  or return undef ;
  
              return 1;
          }
       }
  
      if (defined $IO::Uncompress::UnLzma::VERSION && $got->getValue('unlzma'))
      {
          my ($obj, $errstr, $errno) = IO::Uncompress::Adapter::UnLzma::mkUncompObject();
  
          return $self->saveErrorString(undef, $errstr, $errno)
              if ! defined $obj;
  
          *$self->{Uncomp} = $obj;
          
          my @possible = qw( UnLzma );
  
          if ( *$self->{Info} = $self->ckMagic( @possible ))
          {
              return 1;
          }
       }
  
       if (defined $IO::Uncompress::UnXz::VERSION and
           $magic = $self->ckMagic('UnXz')) {
          *$self->{Info} = $self->readHeader($magic)
              or return undef ;
  
          my ($obj, $errstr, $errno) =
              IO::Uncompress::Adapter::UnXz::mkUncompObject();
  
          return $self->saveErrorString(undef, $errstr, $errno)
              if ! defined $obj;
  
          *$self->{Uncomp} = $obj;
  
           return 1;
       }
  
       if (defined $IO::Uncompress::Bunzip2::VERSION and
           $magic = $self->ckMagic('Bunzip2')) {
          *$self->{Info} = $self->readHeader($magic)
              or return undef ;
  
          my ($obj, $errstr, $errno) = IO::Uncompress::Adapter::Bunzip2::mkUncompObject();
  
          return $self->saveErrorString(undef, $errstr, $errno)
              if ! defined $obj;
  
          *$self->{Uncomp} = $obj;
  
           return 1;
       }
  
       if (defined $IO::Uncompress::UnLzop::VERSION and
              $magic = $self->ckMagic('UnLzop')) {
  
          *$self->{Info} = $self->readHeader($magic)
              or return undef ;
  
          my ($obj, $errstr, $errno) = IO::Uncompress::Adapter::LZO::mkUncompObject();
  
          return $self->saveErrorString(undef, $errstr, $errno)
              if ! defined $obj;
  
          *$self->{Uncomp} = $obj;
  
           return 1;
       }
  
       if (defined $IO::Uncompress::UnLzf::VERSION and
              $magic = $self->ckMagic('UnLzf')) {
  
          *$self->{Info} = $self->readHeader($magic)
              or return undef ;
  
          my ($obj, $errstr, $errno) = IO::Uncompress::Adapter::Lzf::mkUncompObject();
  
          return $self->saveErrorString(undef, $errstr, $errno)
              if ! defined $obj;
  
          *$self->{Uncomp} = $obj;
  
           return 1;
       }
  
       return 0 ;
  }
  
  
  
  sub ckMagic
  {
      my $self = shift;
      my @names = @_ ;
  
      my $keep = ref $self ;
      for my $class ( map { "IO::Uncompress::$_" } @names)
      {
          bless $self => $class;
          my $magic = $self->ckMagic();
  
          if ($magic)
          {
              return $magic ;
          }
  
          $self->pushBack(*$self->{HeaderPending})  ;
          *$self->{HeaderPending} = ''  ;
      }    
  
      bless $self => $keep;
      return undef;
  }
  
  1 ;
  
  __END__
  
  
IO_UNCOMPRESS_ANYUNCOMPRESS

$fatpacked{"IO/Uncompress/Base.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'IO_UNCOMPRESS_BASE';
  
  package IO::Uncompress::Base ;
  
  use strict ;
  use warnings;
  
  our (@ISA, $VERSION, @EXPORT_OK, %EXPORT_TAGS);
  @ISA    = qw(Exporter IO::File);
  
  
  $VERSION = '2.068';
  
  use constant G_EOF => 0 ;
  use constant G_ERR => -1 ;
  
  use IO::Compress::Base::Common 2.068 ;
  
  use IO::File ;
  use Symbol;
  use Scalar::Util ();
  use List::Util ();
  use Carp ;
  
  %EXPORT_TAGS = ( );
  push @{ $EXPORT_TAGS{all} }, @EXPORT_OK ;
  
  sub smartRead
  {
      my $self = $_[0];
      my $out = $_[1];
      my $size = $_[2];
      $$out = "" ;
  
      my $offset = 0 ;
      my $status = 1;
  
  
      if (defined *$self->{InputLength}) {
          return 0
              if *$self->{InputLengthRemaining} <= 0 ;
          $size = List::Util::min($size, *$self->{InputLengthRemaining});
      }
  
      if ( length *$self->{Prime} ) {
          $$out = substr(*$self->{Prime}, 0, $size) ;
          substr(*$self->{Prime}, 0, $size) =  '' ;
          if (length $$out == $size) {
              *$self->{InputLengthRemaining} -= length $$out
                  if defined *$self->{InputLength};
  
              return length $$out ;
          }
          $offset = length $$out ;
      }
  
      my $get_size = $size - $offset ;
  
      if (defined *$self->{FH}) {
          if ($offset) {
              my $tmp = '';
              $status = *$self->{FH}->read($tmp, $get_size) ;
              substr($$out, $offset) = $tmp
                  if defined $status && $status > 0 ;
          }
          else
            { $status = *$self->{FH}->read($$out, $get_size) }
      }
      elsif (defined *$self->{InputEvent}) {
          my $got = 1 ;
          while (length $$out < $size) {
              last 
                  if ($got = *$self->{InputEvent}->($$out, $get_size)) <= 0;
          }
  
          if (length $$out > $size ) {
              *$self->{Prime} = substr($$out, $size, length($$out));
              substr($$out, $size, length($$out)) =  '';
          }
  
         *$self->{EventEof} = 1 if $got <= 0 ;
      }
      else {
         no warnings 'uninitialized';
         my $buf = *$self->{Buffer} ;
         $$buf = '' unless defined $$buf ;
         substr($$out, $offset) = substr($$buf, *$self->{BufferOffset}, $get_size);
         if (*$self->{ConsumeInput})
           { substr($$buf, 0, $get_size) = '' }
         else  
           { *$self->{BufferOffset} += length($$out) - $offset }
      }
  
      *$self->{InputLengthRemaining} -= length($$out) 
          if defined *$self->{InputLength};
          
      if (! defined $status) {
          $self->saveStatus($!) ;
          return STATUS_ERROR;
      }
  
      $self->saveStatus(length $$out < 0 ? STATUS_ERROR : STATUS_OK) ;
  
      return length $$out;
  }
  
  sub pushBack
  {
      my $self = shift ;
  
      return if ! defined $_[0] || length $_[0] == 0 ;
  
      if (defined *$self->{FH} || defined *$self->{InputEvent} ) {
          *$self->{Prime} = $_[0] . *$self->{Prime} ;
          *$self->{InputLengthRemaining} += length($_[0]);
      }
      else {
          my $len = length $_[0];
  
          if($len > *$self->{BufferOffset}) {
              *$self->{Prime} = substr($_[0], 0, $len - *$self->{BufferOffset}) . *$self->{Prime} ;
              *$self->{InputLengthRemaining} = *$self->{InputLength};
              *$self->{BufferOffset} = 0
          }
          else {
              *$self->{InputLengthRemaining} += length($_[0]);
              *$self->{BufferOffset} -= length($_[0]) ;
          }
      }
  }
  
  sub smartSeek
  {
      my $self   = shift ;
      my $offset = shift ;
      my $truncate = shift;
      my $position = shift || SEEK_SET;
  
      if (defined *$self->{FH})
        { *$self->{FH}->seek($offset, $position) }
      else {
          if ($position == SEEK_END) {
              *$self->{BufferOffset} = length ${ *$self->{Buffer} } + $offset ;
          }
          elsif ($position == SEEK_CUR) {
              *$self->{BufferOffset} += $offset ;
          }
          else {
              *$self->{BufferOffset} = $offset ;
          }
  
          substr(${ *$self->{Buffer} }, *$self->{BufferOffset}) = ''
              if $truncate;
          return 1;
      }
  }
  
  sub smartTell
  {
      my $self   = shift ;
  
      if (defined *$self->{FH})
        { return *$self->{FH}->tell() }
      else 
        { return *$self->{BufferOffset} }
  }
  
  sub smartWrite
  {
      my $self   = shift ;
      my $out_data = shift ;
  
      if (defined *$self->{FH}) {
          defined *$self->{FH}->write($out_data, length $out_data) &&
          defined *$self->{FH}->flush() ;
      }
      else {
         my $buf = *$self->{Buffer} ;
         substr($$buf, *$self->{BufferOffset}, length $out_data) = $out_data ;
         *$self->{BufferOffset} += length($out_data) ;
         return 1;
      }
  }
  
  sub smartReadExact
  {
      return $_[0]->smartRead($_[1], $_[2]) == $_[2];
  }
  
  sub smartEof
  {
      my ($self) = $_[0];
      local $.; 
  
      return 0 if length *$self->{Prime} || *$self->{PushMode};
  
      if (defined *$self->{FH})
      {
  
          my $info = $self->getErrInfo();
          
          my $buffer = '';
          my $status = $self->smartRead(\$buffer, 1);
          $self->pushBack($buffer) if length $buffer;
          $self->setErrInfo($info);
  
          return $status == 0 ;
      }
      elsif (defined *$self->{InputEvent})
       { *$self->{EventEof} }
      else 
       { *$self->{BufferOffset} >= length(${ *$self->{Buffer} }) }
  }
  
  sub clearError
  {
      my $self   = shift ;
  
      *$self->{ErrorNo}  =  0 ;
      ${ *$self->{Error} } = '' ;
  }
  
  sub getErrInfo
  {
      my $self   = shift ;
  
      return [ *$self->{ErrorNo}, ${ *$self->{Error} } ] ;
  }
  
  sub setErrInfo
  {
      my $self   = shift ;
      my $ref    = shift;
  
      *$self->{ErrorNo}  =  $ref->[0] ;
      ${ *$self->{Error} } = $ref->[1] ;
  }
  
  sub saveStatus
  {
      my $self   = shift ;
      my $errno = shift() + 0 ;
  
      *$self->{ErrorNo}  = $errno;
      ${ *$self->{Error} } = '' ;
  
      return *$self->{ErrorNo} ;
  }
  
  
  sub saveErrorString
  {
      my $self   = shift ;
      my $retval = shift ;
  
      ${ *$self->{Error} } = shift ;
      *$self->{ErrorNo} = @_ ? shift() + 0 : STATUS_ERROR ;
  
      return $retval;
  }
  
  sub croakError
  {
      my $self   = shift ;
      $self->saveErrorString(0, $_[0]);
      croak $_[0];
  }
  
  
  sub closeError
  {
      my $self = shift ;
      my $retval = shift ;
  
      my $errno = *$self->{ErrorNo};
      my $error = ${ *$self->{Error} };
  
      $self->close();
  
      *$self->{ErrorNo} = $errno ;
      ${ *$self->{Error} } = $error ;
  
      return $retval;
  }
  
  sub error
  {
      my $self   = shift ;
      return ${ *$self->{Error} } ;
  }
  
  sub errorNo
  {
      my $self   = shift ;
      return *$self->{ErrorNo};
  }
  
  sub HeaderError
  {
      my ($self) = shift;
      return $self->saveErrorString(undef, "Header Error: $_[0]", STATUS_ERROR);
  }
  
  sub TrailerError
  {
      my ($self) = shift;
      return $self->saveErrorString(G_ERR, "Trailer Error: $_[0]", STATUS_ERROR);
  }
  
  sub TruncatedHeader
  {
      my ($self) = shift;
      return $self->HeaderError("Truncated in $_[0] Section");
  }
  
  sub TruncatedTrailer
  {
      my ($self) = shift;
      return $self->TrailerError("Truncated in $_[0] Section");
  }
  
  sub postCheckParams
  {
      return 1;
  }
  
  sub checkParams
  {
      my $self = shift ;
      my $class = shift ;
  
      my $got = shift || IO::Compress::Base::Parameters::new();
      
      my $Valid = {
                      'blocksize'     => [IO::Compress::Base::Common::Parse_unsigned, 16 * 1024],
                      'autoclose'     => [IO::Compress::Base::Common::Parse_boolean,  0],
                      'strict'        => [IO::Compress::Base::Common::Parse_boolean,  0],
                      'append'        => [IO::Compress::Base::Common::Parse_boolean,  0],
                      'prime'         => [IO::Compress::Base::Common::Parse_any,      undef],
                      'multistream'   => [IO::Compress::Base::Common::Parse_boolean,  0],
                      'transparent'   => [IO::Compress::Base::Common::Parse_any,      1],
                      'scan'          => [IO::Compress::Base::Common::Parse_boolean,  0],
                      'inputlength'   => [IO::Compress::Base::Common::Parse_unsigned, undef],
                      'binmodeout'    => [IO::Compress::Base::Common::Parse_boolean,  0],
  
                     
                      $self->getExtraParams(),
  
                  } ;
  
      $Valid->{trailingdata} = [IO::Compress::Base::Common::Parse_writable_scalar, undef]
          if  *$self->{OneShot} ;
          
      $got->parse($Valid, @_ ) 
          or $self->croakError("${class}: " . $got->getError()) ;
  
      $self->postCheckParams($got) 
          or $self->croakError("${class}: " . $self->error()) ;
  
      return $got;
  }
  
  sub _create
  {
      my $obj = shift;
      my $got = shift;
      my $append_mode = shift ;
  
      my $class = ref $obj;
      $obj->croakError("$class: Missing Input parameter")
          if ! @_ && ! $got ;
  
      my $inValue = shift ;
  
      *$obj->{OneShot} = 0 ;
  
      if (! $got)
      {
          $got = $obj->checkParams($class, undef, @_)
              or return undef ;
      }
  
      my $inType  = whatIsInput($inValue, 1);
  
      $obj->ckInputParam($class, $inValue, 1) 
          or return undef ;
  
      *$obj->{InNew} = 1;
  
      $obj->ckParams($got)
          or $obj->croakError("${class}: " . *$obj->{Error});
  
      if ($inType eq 'buffer' || $inType eq 'code') {
          *$obj->{Buffer} = $inValue ;        
          *$obj->{InputEvent} = $inValue 
             if $inType eq 'code' ;
      }
      else {
          if ($inType eq 'handle') {
              *$obj->{FH} = $inValue ;
              *$obj->{Handle} = 1 ;
  
              *$obj->{FH}->seek(0, SEEK_SET) 
                  if $got->getValue('scan');
          }  
          else {    
              no warnings ;
              my $mode = '<';
              $mode = '+<' if $got->getValue('scan');
              *$obj->{StdIO} = ($inValue eq '-');
              *$obj->{FH} = new IO::File "$mode $inValue"
                  or return $obj->saveErrorString(undef, "cannot open file '$inValue': $!", $!) ;
          }
          
          *$obj->{LineNo} = $. = 0;
          setBinModeInput(*$obj->{FH}) ;
  
          my $buff = "" ;
          *$obj->{Buffer} = \$buff ;
      }
  
  
      *$obj->{InputLength}       = $got->parsed('inputlength') 
                                      ? $got->getValue('inputlength')
                                      : undef ;
      *$obj->{InputLengthRemaining} = $got->getValue('inputlength');
      *$obj->{BufferOffset}      = 0 ;
      *$obj->{AutoClose}         = $got->getValue('autoclose');
      *$obj->{Strict}            = $got->getValue('strict');
      *$obj->{BlockSize}         = $got->getValue('blocksize');
      *$obj->{Append}            = $got->getValue('append');
      *$obj->{AppendOutput}      = $append_mode || $got->getValue('append');
      *$obj->{ConsumeInput}      = $got->getValue('consumeinput');
      *$obj->{Transparent}       = $got->getValue('transparent');
      *$obj->{MultiStream}       = $got->getValue('multistream');
  
      *$obj->{Scan}              = $got->getValue('scan');
      *$obj->{ParseExtra}        = $got->getValue('parseextra') 
                                    || $got->getValue('strict')  ;
      *$obj->{Type}              = '';
      *$obj->{Prime}             = $got->getValue('prime') || '' ;
      *$obj->{Pending}           = '';
      *$obj->{Plain}             = 0;
      *$obj->{PlainBytesRead}    = 0;
      *$obj->{InflatedBytesRead} = 0;
      *$obj->{UnCompSize}        = new U64;
      *$obj->{CompSize}          = new U64;
      *$obj->{TotalInflatedBytesRead} = 0;
      *$obj->{NewStream}         = 0 ;
      *$obj->{EventEof}          = 0 ;
      *$obj->{ClassName}         = $class ;
      *$obj->{Params}            = $got ;
  
      if (*$obj->{ConsumeInput}) {
          *$obj->{InNew} = 0;
          *$obj->{Closed} = 0;
          return $obj
      }
  
      my $status = $obj->mkUncomp($got);
  
      return undef
          unless defined $status;
  
      *$obj->{InNew} = 0;
      *$obj->{Closed} = 0;
  
      if ($status) {
          
          my $out_buffer = '';
  
          $status = $obj->read(\$out_buffer);
      
          if ($status < 0) {
              *$obj->{ReadStatus} = [ $status, $obj->error(), $obj->errorNo() ];
          }
  
          $obj->ungetc($out_buffer)
              if length $out_buffer;
      }
      else {
          return undef 
              unless *$obj->{Transparent};
  
          $obj->clearError();
          *$obj->{Type} = 'plain';
          *$obj->{Plain} = 1;
          $obj->pushBack(*$obj->{HeaderPending})  ;
      }
  
      push @{ *$obj->{InfoList} }, *$obj->{Info} ;
  
      $obj->saveStatus(STATUS_OK) ;
      *$obj->{InNew} = 0;
      *$obj->{Closed} = 0;
  
      return $obj;
  }
  
  sub ckInputParam
  {
      my $self = shift ;
      my $from = shift ;
      my $inType = whatIsInput($_[0], $_[1]);
  
      $self->croakError("$from: input parameter not a filename, filehandle, array ref or scalar ref")
          if ! $inType ;
  
  
      return 1;
  }
  
  
  sub _inf
  {
      my $obj = shift ;
  
      my $class = (caller)[0] ;
      my $name = (caller(1))[3] ;
  
      $obj->croakError("$name: expected at least 1 parameters\n")
          unless @_ >= 1 ;
  
      my $input = shift ;
      my $haveOut = @_ ;
      my $output = shift ;
  
  
      my $x = new IO::Compress::Base::Validator($class, *$obj->{Error}, $name, $input, $output)
          or return undef ;
      
      push @_, $output if $haveOut && $x->{Hash};
  
      *$obj->{OneShot} = 1 ;
      
      my $got = $obj->checkParams($name, undef, @_)
          or return undef ;
  
      if ($got->parsed('trailingdata'))
      {
          
          *$obj->{TrailingData} = $got->getValue('trailingdata');
      }
  
      *$obj->{MultiStream} = $got->getValue('multistream');
      $got->setValue('multistream', 0);
  
      $x->{Got} = $got ;
  
      
      if ($x->{GlobMap})
      {
          $x->{oneInput} = 1 ;
          foreach my $pair (@{ $x->{Pairs} })
          {
              my ($from, $to) = @$pair ;
              $obj->_singleTarget($x, $from, $to, @_)
                  or return undef ;
          }
  
          return scalar @{ $x->{Pairs} } ;
      }
  
      if (! $x->{oneOutput} )
      {
          my $inFile = ($x->{inType} eq 'filenames' 
                          || $x->{inType} eq 'filename');
  
          $x->{inType} = $inFile ? 'filename' : 'buffer';
          
          foreach my $in ($x->{oneInput} ? $input : @$input)
          {
              my $out ;
              $x->{oneInput} = 1 ;
  
              $obj->_singleTarget($x, $in, $output, @_)
                  or return undef ;
          }
  
          return 1 ;
      }
  
      return $obj->_singleTarget($x, $input, $output, @_);
  
      croak "should not be here" ;
  }
  
  sub retErr
  {
      my $x = shift ;
      my $string = shift ;
  
      ${ $x->{Error} } = $string ;
  
      return undef ;
  }
  
  sub _singleTarget
  {
      my $self      = shift ;
      my $x         = shift ;
      my $input     = shift;
      my $output    = shift;
      
      my $buff = '';
      $x->{buff} = \$buff ;
  
      my $fh ;
      if ($x->{outType} eq 'filename') {
          my $mode = '>' ;
          $mode = '>>'
              if $x->{Got}->getValue('append') ;
          $x->{fh} = new IO::File "$mode $output" 
              or return retErr($x, "cannot open file '$output': $!") ;
          binmode $x->{fh} if $x->{Got}->valueOrDefault('binmodeout');
  
      }
  
      elsif ($x->{outType} eq 'handle') {
          $x->{fh} = $output;
          binmode $x->{fh} if $x->{Got}->valueOrDefault('binmodeout');
          if ($x->{Got}->getValue('append')) {
                  seek($x->{fh}, 0, SEEK_END)
                      or return retErr($x, "Cannot seek to end of output filehandle: $!") ;
              }
      }
  
      
      elsif ($x->{outType} eq 'buffer' )
      {
          $$output = '' 
              unless $x->{Got}->getValue('append');
          $x->{buff} = $output ;
      }
  
      if ($x->{oneInput})
      {
          defined $self->_rd2($x, $input, $output)
              or return undef; 
      }
      else
      {
          for my $element ( ($x->{inType} eq 'hash') ? keys %$input : @$input)
          {
              defined $self->_rd2($x, $element, $output) 
                  or return undef ;
          }
      }
  
  
      if ( ($x->{outType} eq 'filename' && $output ne '-') || 
           ($x->{outType} eq 'handle' && $x->{Got}->getValue('autoclose'))) {
          $x->{fh}->close() 
              or return retErr($x, $!); 
          delete $x->{fh};
      }
  
      return 1 ;
  }
  
  sub _rd2
  {
      my $self      = shift ;
      my $x         = shift ;
      my $input     = shift;
      my $output    = shift;
          
      my $z = IO::Compress::Base::Common::createSelfTiedObject($x->{Class}, *$self->{Error});
      
      $z->_create($x->{Got}, 1, $input, @_)
          or return undef ;
  
      my $status ;
      my $fh = $x->{fh};
      
      while (1) {
  
          while (($status = $z->read($x->{buff})) > 0) {
              if ($fh) {
                  local $\;
                  print $fh ${ $x->{buff} }
                      or return $z->saveErrorString(undef, "Error writing to output file: $!", $!);
                  ${ $x->{buff} } = '' ;
              }
          }
  
          if (! $x->{oneOutput} ) {
              my $ot = $x->{outType} ;
  
              if ($ot eq 'array') 
                { push @$output, $x->{buff} }
              elsif ($ot eq 'hash') 
                { $output->{$input} = $x->{buff} }
  
              my $buff = '';
              $x->{buff} = \$buff;
          }
  
          last if $status < 0 || $z->smartEof();
  
          last 
              unless *$self->{MultiStream};
  
          $status = $z->nextStream();
  
          last 
              unless $status == 1 ;
      }
  
      return $z->closeError(undef)
          if $status < 0 ;
  
      ${ *$self->{TrailingData} } = $z->trailingData()
          if defined *$self->{TrailingData} ;
  
      $z->close() 
          or return undef ;
  
      return 1 ;
  }
  
  sub TIEHANDLE
  {
      return $_[0] if ref($_[0]);
      die "OOPS\n" ;
  
  }
    
  sub UNTIE
  {
      my $self = shift ;
  }
  
  
  sub getHeaderInfo
  {
      my $self = shift ;
      wantarray ? @{ *$self->{InfoList} } : *$self->{Info};
  }
  
  sub readBlock
  {
      my $self = shift ;
      my $buff = shift ;
      my $size = shift ;
  
      if (defined *$self->{CompressedInputLength}) {
          if (*$self->{CompressedInputLengthRemaining} == 0) {
              delete *$self->{CompressedInputLength};
              *$self->{CompressedInputLengthDone} = 1;
              return STATUS_OK ;
          }
          $size = List::Util::min($size, *$self->{CompressedInputLengthRemaining} );
          *$self->{CompressedInputLengthRemaining} -= $size ;
      }
      
      my $status = $self->smartRead($buff, $size) ;
      return $self->saveErrorString(STATUS_ERROR, "Error Reading Data: $!", $!)
          if $status == STATUS_ERROR  ;
  
      if ($status == 0 ) {
          *$self->{Closed} = 1 ;
          *$self->{EndStream} = 1 ;
          return $self->saveErrorString(STATUS_ERROR, "unexpected end of file", STATUS_ERROR);
      }
  
      return STATUS_OK;
  }
  
  sub postBlockChk
  {
      return STATUS_OK;
  }
  
  sub _raw_read
  {
      
      my $self = shift ;
  
      return G_EOF if *$self->{Closed} ;
      return G_EOF if *$self->{EndStream} ;
  
      my $buffer = shift ;
      my $scan_mode = shift ;
  
      if (*$self->{Plain}) {
          my $tmp_buff ;
          my $len = $self->smartRead(\$tmp_buff, *$self->{BlockSize}) ;
          
          return $self->saveErrorString(G_ERR, "Error reading data: $!", $!) 
                  if $len == STATUS_ERROR ;
  
          if ($len == 0 ) {
              *$self->{EndStream} = 1 ;
          }
          else {
              *$self->{PlainBytesRead} += $len ;
              $$buffer .= $tmp_buff;
          }
  
          return $len ;
      }
  
      if (*$self->{NewStream}) {
  
          $self->gotoNextStream() > 0
              or return G_ERR;
  
          $$buffer .=  *$self->{Pending} ;
          my $len = length  *$self->{Pending} ;
          *$self->{Pending} = '';
          return $len; 
      }
  
      my $temp_buf = '';
      my $outSize = 0;
      my $status = $self->readBlock(\$temp_buf, *$self->{BlockSize}, $outSize) ;
      
      return G_ERR
          if $status == STATUS_ERROR  ;
  
      my $buf_len = 0;
      if ($status == STATUS_OK) {
          my $beforeC_len = length $temp_buf;
          my $before_len = defined $$buffer ? length $$buffer : 0 ;
          $status = *$self->{Uncomp}->uncompr(\$temp_buf, $buffer,
                                      defined *$self->{CompressedInputLengthDone} ||
                                                  $self->smartEof(), $outSize);
                                                  
          $self->pushBack($temp_buf) if *$self->{Uncomp}{ConsumesInput};
  
          return $self->saveErrorString(G_ERR, *$self->{Uncomp}{Error}, *$self->{Uncomp}{ErrorNo})
              if $self->saveStatus($status) == STATUS_ERROR;    
  
          $self->postBlockChk($buffer, $before_len) == STATUS_OK
              or return G_ERR;
  
          $buf_len = defined $$buffer ? length($$buffer) - $before_len : 0;
      
          *$self->{CompSize}->add($beforeC_len - length $temp_buf) ;
  
          *$self->{InflatedBytesRead} += $buf_len ;
          *$self->{TotalInflatedBytesRead} += $buf_len ;
          *$self->{UnCompSize}->add($buf_len) ;
  
          $self->filterUncompressed($buffer, $before_len);
  
      }
  
      if ($status == STATUS_ENDSTREAM) {
  
          *$self->{EndStream} = 1 ;
  
          my $trailer;
          my $trailer_size = *$self->{Info}{TrailerLength} ;
          my $got = 0;
          if (*$self->{Info}{TrailerLength})
          {
              $got = $self->smartRead(\$trailer, $trailer_size) ;
          }
  
          if ($got == $trailer_size) {
              $self->chkTrailer($trailer) == STATUS_OK
                  or return G_ERR;
          }
          else {
              return $self->TrailerError("trailer truncated. Expected " . 
                                        "$trailer_size bytes, got $got")
                  if *$self->{Strict};
              $self->pushBack($trailer)  ;
          }
  
  
          if (! $self->smartEof()) {
              *$self->{NewStream} = 1 ;
  
              if (*$self->{MultiStream}) {
                  *$self->{EndStream} = 0 ;
                  return $buf_len ;
              }
          }
  
      }
      
  
      return $buf_len ;
  }
  
  sub reset
  {
      my $self = shift ;
  
      return *$self->{Uncomp}->reset();
  }
  
  sub filterUncompressed
  {
  }
  
  
  sub nextStream
  {
      my $self = shift ;
  
      my $status = $self->gotoNextStream();
      $status == 1
          or return $status ;
  
      *$self->{TotalInflatedBytesRead} = 0 ;
      *$self->{LineNo} = $. = 0;
  
      return 1;
  }
  
  sub gotoNextStream
  {
      my $self = shift ;
  
      if (! *$self->{NewStream}) {
          my $status = 1;
          my $buffer ;
  
          $status = $self->read($buffer) 
              while $status > 0 ;
  
          return $status
              if $status < 0;
      }
  
      *$self->{NewStream} = 0 ;
      *$self->{EndStream} = 0 ;
      *$self->{CompressedInputLengthDone} = undef ;
      *$self->{CompressedInputLength} = undef ;
      $self->reset();
      *$self->{UnCompSize}->reset();
      *$self->{CompSize}->reset();
  
      my $magic = $self->ckMagic();
  
      if ( ! defined $magic) {
          if (! *$self->{Transparent} || $self->eof())
          {
              *$self->{EndStream} = 1 ;
              return 0;
          }
  
          $self->clearError();
          *$self->{Type} = 'plain';
          *$self->{Plain} = 1;
          $self->pushBack(*$self->{HeaderPending})  ;
      }
      else
      {
          *$self->{Info} = $self->readHeader($magic);
  
          if ( ! defined *$self->{Info} ) {
              *$self->{EndStream} = 1 ;
              return -1;
          }
      }
  
      push @{ *$self->{InfoList} }, *$self->{Info} ;
  
      return 1; 
  }
  
  sub streamCount
  {
      my $self = shift ;
      return 1 if ! defined *$self->{InfoList};
      return scalar @{ *$self->{InfoList} }  ;
  }
  
  
  sub read
  {
      
      my $self = shift ;
  
      if (defined *$self->{ReadStatus} ) {
          my $status = *$self->{ReadStatus}[0];
          $self->saveErrorString( @{ *$self->{ReadStatus} } );
          delete  *$self->{ReadStatus} ;
          return $status ;
      }
  
      return G_EOF if *$self->{Closed} ;
  
      my $buffer ;
  
      if (ref $_[0] ) {
          $self->croakError(*$self->{ClassName} . "::read: buffer parameter is read-only")
              if Scalar::Util::readonly(${ $_[0] });
  
          $self->croakError(*$self->{ClassName} . "::read: not a scalar reference $_[0]" )
              unless ref $_[0] eq 'SCALAR' ;
          $buffer = $_[0] ;
      }
      else {
          $self->croakError(*$self->{ClassName} . "::read: buffer parameter is read-only")
              if Scalar::Util::readonly($_[0]);
  
          $buffer = \$_[0] ;
      }
  
      my $length = $_[1] ;
      my $offset = $_[2] || 0;
  
      if (! *$self->{AppendOutput}) {
          if (! $offset) {    
              $$buffer = '' ;
          }
          else {
              if ($offset > length($$buffer)) {
                  $$buffer .= "\x00" x ($offset - length($$buffer));
              }
              else {
                  substr($$buffer, $offset) = '';
              }
          }
      }
      elsif (! defined $$buffer) {
          $$buffer = '' ;
      }
  
      return G_EOF if !length *$self->{Pending} && *$self->{EndStream} ;
  
      return 0 if defined $length && $length == 0 ;
  
      $length = $length || 0;
  
      $self->croakError(*$self->{ClassName} . "::read: length parameter is negative")
          if $length < 0 ;
  
      unless ( $length || $offset) {
          if (length *$self->{Pending}) {
              $$buffer .= *$self->{Pending} ;
              my $len = length *$self->{Pending};
              *$self->{Pending} = '' ;
              return $len ;
          }
          else {
              my $len = 0;
              $len = $self->_raw_read($buffer) 
                  while ! *$self->{EndStream} && $len == 0 ;
              return $len ;
          }
      }
  
      my $out_buffer = *$self->{Pending} ;
      *$self->{Pending} = '';
  
  
      while (! *$self->{EndStream} && length($out_buffer) < $length)
      {
          my $buf_len = $self->_raw_read(\$out_buffer);
          return $buf_len 
              if $buf_len < 0 ;
      }
  
      $length = length $out_buffer 
          if length($out_buffer) < $length ;
  
      return 0 
          if $length == 0 ;
  
      $$buffer = '' 
          if ! defined $$buffer;
  
      $offset = length $$buffer
          if *$self->{AppendOutput} ;
  
      *$self->{Pending} = $out_buffer;
      $out_buffer = \*$self->{Pending} ;
  
      substr($$buffer, $offset) = substr($$out_buffer, 0, $length) ;
      substr($$out_buffer, 0, $length) =  '' ;
  
      return $length ;
  }
  
  sub _getline
  {
      my $self = shift ;
      my $status = 0 ;
  
      if ( ! defined $/ ) {
          my $data ;
          1 while ($status = $self->read($data)) > 0 ;
          return ($status, \$data);
      }
  
      if ( ref $/ eq 'SCALAR' && ${$/} =~ /^\d+$/ && ${$/} > 0) {
          my $reclen = ${$/} ;
          my $data ;
          $status = $self->read($data, $reclen) ;
          return ($status, \$data);
      }
  
      if ( ! length $/ ) {
          my $paragraph ;    
          while (($status = $self->read($paragraph)) > 0 ) {
              if ($paragraph =~ s/^(.*?\n\n+)//s) {
                  *$self->{Pending}  = $paragraph ;
                  my $par = $1 ;
                  return (1, \$par);
              }
          }
          return ($status, \$paragraph);
      }
  
      {
          my $line ;    
          my $p = \*$self->{Pending}  ;
          while (($status = $self->read($line)) > 0 ) {
              my $offset = index($line, $/);
              if ($offset >= 0) {
                  my $l = substr($line, 0, $offset + length $/ );
                  substr($line, 0, $offset + length $/) = '';    
                  $$p = $line;
                  return (1, \$l);
              }
          }
  
          return ($status, \$line);
      }
  }
  
  sub getline
  {
      my $self = shift;
  
      if (defined *$self->{ReadStatus} ) {
          $self->saveErrorString( @{ *$self->{ReadStatus} } );
          delete  *$self->{ReadStatus} ;
          return undef;
      }
  
      return undef 
          if *$self->{Closed} || (!length *$self->{Pending} && *$self->{EndStream}) ;
  
      my $current_append = *$self->{AppendOutput} ;
      *$self->{AppendOutput} = 1;
  
      my ($status, $lineref) = $self->_getline();
      *$self->{AppendOutput} = $current_append;
  
      return undef 
          if $status < 0 || length $$lineref == 0 ;
  
      $. = ++ *$self->{LineNo} ;
  
      return $$lineref ;
  }
  
  sub getlines
  {
      my $self = shift;
      $self->croakError(*$self->{ClassName} . 
              "::getlines: called in scalar context\n") unless wantarray;
      my($line, @lines);
      push(@lines, $line) 
          while defined($line = $self->getline);
      return @lines;
  }
  
  sub READLINE
  {
      goto &getlines if wantarray;
      goto &getline;
  }
  
  sub getc
  {
      my $self = shift;
      my $buf;
      return $buf if $self->read($buf, 1);
      return undef;
  }
  
  sub ungetc
  {
      my $self = shift;
      *$self->{Pending} = ""  unless defined *$self->{Pending} ;    
      *$self->{Pending} = $_[0] . *$self->{Pending} ;    
  }
  
  
  sub trailingData
  {
      my $self = shift ;
  
      if (defined *$self->{FH} || defined *$self->{InputEvent} ) {
          return *$self->{Prime} ;
      }
      else {
          my $buf = *$self->{Buffer} ;
          my $offset = *$self->{BufferOffset} ;
          return substr($$buf, $offset) ;
      }
  }
  
  
  sub eof
  {
      my $self = shift ;
  
      return (*$self->{Closed} ||
                (!length *$self->{Pending} 
                  && ( $self->smartEof() || *$self->{EndStream}))) ;
  }
  
  sub tell
  {
      my $self = shift ;
  
      my $in ;
      if (*$self->{Plain}) {
          $in = *$self->{PlainBytesRead} ;
      }
      else {
          $in = *$self->{TotalInflatedBytesRead} ;
      }
  
      my $pending = length *$self->{Pending} ;
  
      return 0 if $pending > $in ;
      return $in - $pending ;
  }
  
  sub close
  {
      my $self = shift ;
  
      return 1 if *$self->{Closed} ;
  
      untie *$self 
          if $] >= 5.008 ;
  
      my $status = 1 ;
  
      if (defined *$self->{FH}) {
          if ((! *$self->{Handle} || *$self->{AutoClose}) && ! *$self->{StdIO}) {
              local $.; 
              $! = 0 ;
              $status = *$self->{FH}->close();
              return $self->saveErrorString(0, $!, $!)
                  if !*$self->{InNew} && $self->saveStatus($!) != 0 ;
          }
          delete *$self->{FH} ;
          $! = 0 ;
      }
      *$self->{Closed} = 1 ;
  
      return 1;
  }
  
  sub DESTROY
  {
      my $self = shift ;
      local ($., $@, $!, $^E, $?);
  
      $self->close() ;
  }
  
  sub seek
  {
      my $self     = shift ;
      my $position = shift;
      my $whence   = shift ;
  
      my $here = $self->tell() ;
      my $target = 0 ;
  
  
      if ($whence == SEEK_SET) {
          $target = $position ;
      }
      elsif ($whence == SEEK_CUR) {
          $target = $here + $position ;
      }
      elsif ($whence == SEEK_END) {
          $target = $position ;
          $self->croakError(*$self->{ClassName} . "::seek: SEEK_END not allowed") ;
      }
      else {
          $self->croakError(*$self->{ClassName} ."::seek: unknown value, $whence, for whence parameter");
      }
  
      if ($target == $here) {
          if (*$self->{Plain}) {
              *$self->{EndStream} = 0;
              seek(*$self->{FH},0,1) if *$self->{FH};
          }
          return 1;
      }
  
      $self->croakError( *$self->{ClassName} ."::seek: cannot seek backwards")
          if $target < $here ;
  
      my $offset = $target - $here ;
  
      my $got;
      while (($got = $self->read(my $buffer, List::Util::min($offset, *$self->{BlockSize})) ) > 0)
      {
          $offset -= $got;
          last if $offset == 0 ;
      }
  
      $here = $self->tell() ;
      return $offset == 0 ? 1 : 0 ;
  }
  
  sub fileno
  {
      my $self = shift ;
      return defined *$self->{FH} 
             ? fileno *$self->{FH} 
             : undef ;
  }
  
  sub binmode
  {
      1;
  }
  
  sub opened
  {
      my $self     = shift ;
      return ! *$self->{Closed} ;
  }
  
  sub autoflush
  {
      my $self     = shift ;
      return defined *$self->{FH} 
              ? *$self->{FH}->autoflush(@_) 
              : undef ;
  }
  
  sub input_line_number
  {
      my $self = shift ;
      my $last = *$self->{LineNo};
      $. = *$self->{LineNo} = $_[1] if @_ ;
      return $last;
  }
  
  
  *BINMODE  = \&binmode;
  *SEEK     = \&seek; 
  *READ     = \&read;
  *sysread  = \&read;
  *TELL     = \&tell;
  *EOF      = \&eof;
  
  *FILENO   = \&fileno;
  *CLOSE    = \&close;
  
  sub _notAvailable
  {
      my $name = shift ;
      return sub { croak "$name Not Available: File opened only for intput" ; } ;
  }
  
  
  *print    = _notAvailable('print');
  *PRINT    = _notAvailable('print');
  *printf   = _notAvailable('printf');
  *PRINTF   = _notAvailable('printf');
  *write    = _notAvailable('write');
  *WRITE    = _notAvailable('write');
  
  
  
  
  package IO::Uncompress::Base ;
  
  
  1 ;
  __END__
  
IO_UNCOMPRESS_BASE

$fatpacked{"IO/Uncompress/Bunzip2.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'IO_UNCOMPRESS_BUNZIP2';
  package IO::Uncompress::Bunzip2 ;
  
  use strict ;
  use warnings;
  use bytes;
  
  use IO::Compress::Base::Common 2.068 qw(:Status );
  
  use IO::Uncompress::Base 2.068 ;
  use IO::Uncompress::Adapter::Bunzip2 2.068 ;
  
  require Exporter ;
  our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, $Bunzip2Error);
  
  $VERSION = '2.068';
  $Bunzip2Error = '';
  
  @ISA    = qw( Exporter IO::Uncompress::Base );
  @EXPORT_OK = qw( $Bunzip2Error bunzip2 ) ;
  push @{ $EXPORT_TAGS{all} }, @EXPORT_OK ;
  
  
  sub new
  {
      my $class = shift ;
      my $obj = IO::Compress::Base::Common::createSelfTiedObject($class, \$Bunzip2Error);
  
      $obj->_create(undef, 0, @_);
  }
  
  sub bunzip2
  {
      my $obj = IO::Compress::Base::Common::createSelfTiedObject(undef, \$Bunzip2Error);
      return $obj->_inf(@_);
  }
  
  sub getExtraParams
  {
      return (
              'verbosity'     => [IO::Compress::Base::Common::Parse_boolean,   0],
              'small'         => [IO::Compress::Base::Common::Parse_boolean,   0],
          );
  }
  
  
  sub ckParams
  {
      my $self = shift ;
      my $got = shift ;
  
      return 1;
  }
  
  sub mkUncomp
  {
      my $self = shift ;
      my $got = shift ;
  
       my $magic = $self->ckMagic()
          or return 0;
  
      *$self->{Info} = $self->readHeader($magic)
          or return undef ;
  
      my $Small     = $got->getValue('small');
      my $Verbosity = $got->getValue('verbosity');
  
      my ($obj, $errstr, $errno) =  IO::Uncompress::Adapter::Bunzip2::mkUncompObject(
                                                      $Small, $Verbosity);
  
      return $self->saveErrorString(undef, $errstr, $errno)
          if ! defined $obj;
      
      *$self->{Uncomp} = $obj;
  
      return 1;
  
  }
  
  
  sub ckMagic
  {
      my $self = shift;
  
      my $magic ;
      $self->smartReadExact(\$magic, 4);
  
      *$self->{HeaderPending} = $magic ;
      
      return $self->HeaderError("Header size is " . 
                                          4 . " bytes") 
          if length $magic != 4;
  
      return $self->HeaderError("Bad Magic.")
          if ! isBzip2Magic($magic) ;
                        
          
      *$self->{Type} = 'bzip2';
      return $magic;
  }
  
  sub readHeader
  {
      my $self = shift;
      my $magic = shift ;
  
      $self->pushBack($magic);
      *$self->{HeaderPending} = '';
  
  
      return {
          'Type'              => 'bzip2',
          'FingerprintLength' => 4,
          'HeaderLength'      => 4,
          'TrailerLength'     => 0,
          'Header'            => '$magic'
          };
      
  }
  
  sub chkTrailer
  {
      return STATUS_OK;
  }
  
  
  
  sub isBzip2Magic
  {
      my $buffer = shift ;
      return $buffer =~ /^BZh\d$/;
  }
  
  1 ;
  
  __END__
  
  
IO_UNCOMPRESS_BUNZIP2

$fatpacked{"IO/Uncompress/Gunzip.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'IO_UNCOMPRESS_GUNZIP';
  
  package IO::Uncompress::Gunzip ;
  
  require 5.006 ;
  
  
  use strict ;
  use warnings;
  use bytes;
  
  use IO::Uncompress::RawInflate 2.068 ;
  
  use Compress::Raw::Zlib 2.068 () ;
  use IO::Compress::Base::Common 2.068 qw(:Status );
  use IO::Compress::Gzip::Constants 2.068 ;
  use IO::Compress::Zlib::Extra 2.068 ;
  
  require Exporter ;
  
  our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, $GunzipError);
  
  @ISA = qw( Exporter IO::Uncompress::RawInflate );
  @EXPORT_OK = qw( $GunzipError gunzip );
  %EXPORT_TAGS = %IO::Uncompress::RawInflate::DEFLATE_CONSTANTS ;
  push @{ $EXPORT_TAGS{all} }, @EXPORT_OK ;
  Exporter::export_ok_tags('all');
  
  $GunzipError = '';
  
  $VERSION = '2.068';
  
  sub new
  {
      my $class = shift ;
      $GunzipError = '';
      my $obj = IO::Compress::Base::Common::createSelfTiedObject($class, \$GunzipError);
  
      $obj->_create(undef, 0, @_);
  }
  
  sub gunzip
  {
      my $obj = IO::Compress::Base::Common::createSelfTiedObject(undef, \$GunzipError);
      return $obj->_inf(@_) ;
  }
  
  sub getExtraParams
  {
      return ( 'parseextra' => [IO::Compress::Base::Common::Parse_boolean,  0] ) ;
  }
  
  sub ckParams
  {
      my $self = shift ;
      my $got = shift ;
  
      $got->setValue('crc32' => 1);
  
      return 1;
  }
  
  sub ckMagic
  {
      my $self = shift;
  
      my $magic ;
      $self->smartReadExact(\$magic, GZIP_ID_SIZE);
  
      *$self->{HeaderPending} = $magic ;
  
      return $self->HeaderError("Minimum header size is " . 
                                GZIP_MIN_HEADER_SIZE . " bytes") 
          if length $magic != GZIP_ID_SIZE ;                                    
  
      return $self->HeaderError("Bad Magic")
          if ! isGzipMagic($magic) ;
  
      *$self->{Type} = 'rfc1952';
  
      return $magic ;
  }
  
  sub readHeader
  {
      my $self = shift;
      my $magic = shift;
  
      return $self->_readGzipHeader($magic);
  }
  
  sub chkTrailer
  {
      my $self = shift;
      my $trailer = shift;
  
      my ($CRC32, $ISIZE) = unpack("V V", $trailer) ;
      *$self->{Info}{CRC32} = $CRC32;    
      *$self->{Info}{ISIZE} = $ISIZE;    
  
      if (*$self->{Strict}) {
          return $self->TrailerError("CRC mismatch")
              if $CRC32 != *$self->{Uncomp}->crc32() ;
  
          my $exp_isize = *$self->{UnCompSize}->get32bit();
          return $self->TrailerError("ISIZE mismatch. Got $ISIZE"
                                    . ", expected $exp_isize")
              if $ISIZE != $exp_isize ;
      }
  
      return STATUS_OK;
  }
  
  sub isGzipMagic
  {
      my $buffer = shift ;
      return 0 if length $buffer < GZIP_ID_SIZE ;
      my ($id1, $id2) = unpack("C C", $buffer) ;
      return $id1 == GZIP_ID1 && $id2 == GZIP_ID2 ;
  }
  
  sub _readFullGzipHeader($)
  {
      my ($self) = @_ ;
      my $magic = '' ;
  
      $self->smartReadExact(\$magic, GZIP_ID_SIZE);
  
      *$self->{HeaderPending} = $magic ;
  
      return $self->HeaderError("Minimum header size is " . 
                                GZIP_MIN_HEADER_SIZE . " bytes") 
          if length $magic != GZIP_ID_SIZE ;                                    
  
  
      return $self->HeaderError("Bad Magic")
          if ! isGzipMagic($magic) ;
  
      my $status = $self->_readGzipHeader($magic);
      delete *$self->{Transparent} if ! defined $status ;
      return $status ;
  }
  
  sub _readGzipHeader($)
  {
      my ($self, $magic) = @_ ;
      my ($HeaderCRC) ;
      my ($buffer) = '' ;
  
      $self->smartReadExact(\$buffer, GZIP_MIN_HEADER_SIZE - GZIP_ID_SIZE)
          or return $self->HeaderError("Minimum header size is " . 
                                       GZIP_MIN_HEADER_SIZE . " bytes") ;
  
      my $keep = $magic . $buffer ;
      *$self->{HeaderPending} = $keep ;
  
      my ($cm, $flag, $mtime, $xfl, $os) = unpack("C C V C C", $buffer) ;
  
      $cm == GZIP_CM_DEFLATED 
          or return $self->HeaderError("Not Deflate (CM is $cm)") ;
  
      return $self->HeaderError("Use of Reserved Bits in FLG field.")
          if $flag & GZIP_FLG_RESERVED ; 
  
      my $EXTRA ;
      my @EXTRA = () ;
      if ($flag & GZIP_FLG_FEXTRA) {
          $EXTRA = "" ;
          $self->smartReadExact(\$buffer, GZIP_FEXTRA_HEADER_SIZE) 
              or return $self->TruncatedHeader("FEXTRA Length") ;
  
          my ($XLEN) = unpack("v", $buffer) ;
          $self->smartReadExact(\$EXTRA, $XLEN) 
              or return $self->TruncatedHeader("FEXTRA Body");
          $keep .= $buffer . $EXTRA ;
  
          if ($XLEN && *$self->{'ParseExtra'}) {
              my $bad = IO::Compress::Zlib::Extra::parseRawExtra($EXTRA,
                                                  \@EXTRA, 1, 1);
              return $self->HeaderError($bad)
                  if defined $bad;
          }
      }
  
      my $origname ;
      if ($flag & GZIP_FLG_FNAME) {
          $origname = "" ;
          while (1) {
              $self->smartReadExact(\$buffer, 1) 
                  or return $self->TruncatedHeader("FNAME");
              last if $buffer eq GZIP_NULL_BYTE ;
              $origname .= $buffer 
          }
          $keep .= $origname . GZIP_NULL_BYTE ;
  
          return $self->HeaderError("Non ISO 8859-1 Character found in Name")
              if *$self->{Strict} && $origname =~ /$GZIP_FNAME_INVALID_CHAR_RE/o ;
      }
  
      my $comment ;
      if ($flag & GZIP_FLG_FCOMMENT) {
          $comment = "";
          while (1) {
              $self->smartReadExact(\$buffer, 1) 
                  or return $self->TruncatedHeader("FCOMMENT");
              last if $buffer eq GZIP_NULL_BYTE ;
              $comment .= $buffer 
          }
          $keep .= $comment . GZIP_NULL_BYTE ;
  
          return $self->HeaderError("Non ISO 8859-1 Character found in Comment")
              if *$self->{Strict} && $comment =~ /$GZIP_FCOMMENT_INVALID_CHAR_RE/o ;
      }
  
      if ($flag & GZIP_FLG_FHCRC) {
          $self->smartReadExact(\$buffer, GZIP_FHCRC_SIZE) 
              or return $self->TruncatedHeader("FHCRC");
  
          $HeaderCRC = unpack("v", $buffer) ;
          my $crc16 = Compress::Raw::Zlib::crc32($keep) & 0xFF ;
  
          return $self->HeaderError("CRC16 mismatch.")
              if *$self->{Strict} && $crc16 != $HeaderCRC;
  
          $keep .= $buffer ;
      }
  
  
      *$self->{Type} = 'rfc1952';
  
      return {
          'Type'          => 'rfc1952',
          'FingerprintLength'  => 2,
          'HeaderLength'  => length $keep,
          'TrailerLength' => GZIP_TRAILER_SIZE,
          'Header'        => $keep,
          'isMinimalHeader' => $keep eq GZIP_MINIMUM_HEADER ? 1 : 0,
  
          'MethodID'      => $cm,
          'MethodName'    => $cm == GZIP_CM_DEFLATED ? "Deflated" : "Unknown" ,
          'TextFlag'      => $flag & GZIP_FLG_FTEXT ? 1 : 0,
          'HeaderCRCFlag' => $flag & GZIP_FLG_FHCRC ? 1 : 0,
          'NameFlag'      => $flag & GZIP_FLG_FNAME ? 1 : 0,
          'CommentFlag'   => $flag & GZIP_FLG_FCOMMENT ? 1 : 0,
          'ExtraFlag'     => $flag & GZIP_FLG_FEXTRA ? 1 : 0,
          'Name'          => $origname,
          'Comment'       => $comment,
          'Time'          => $mtime,
          'OsID'          => $os,
          'OsName'        => defined $GZIP_OS_Names{$os} 
                                   ? $GZIP_OS_Names{$os} : "Unknown",
          'HeaderCRC'     => $HeaderCRC,
          'Flags'         => $flag,
          'ExtraFlags'    => $xfl,
          'ExtraFieldRaw' => $EXTRA,
          'ExtraField'    => [ @EXTRA ],
  
  
        }
  }
  
  
  1;
  
  __END__
  
  
IO_UNCOMPRESS_GUNZIP

$fatpacked{"IO/Uncompress/Inflate.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'IO_UNCOMPRESS_INFLATE';
  package IO::Uncompress::Inflate ;
  
  use strict ;
  use warnings;
  use bytes;
  
  use IO::Compress::Base::Common  2.068 qw(:Status );
  use IO::Compress::Zlib::Constants 2.068 ;
  
  use IO::Uncompress::RawInflate  2.068 ;
  
  require Exporter ;
  our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, $InflateError);
  
  $VERSION = '2.068';
  $InflateError = '';
  
  @ISA    = qw( Exporter IO::Uncompress::RawInflate );
  @EXPORT_OK = qw( $InflateError inflate ) ;
  %EXPORT_TAGS = %IO::Uncompress::RawInflate::DEFLATE_CONSTANTS ;
  push @{ $EXPORT_TAGS{all} }, @EXPORT_OK ;
  Exporter::export_ok_tags('all');
  
  
  sub new
  {
      my $class = shift ;
      my $obj = IO::Compress::Base::Common::createSelfTiedObject($class, \$InflateError);
  
      $obj->_create(undef, 0, @_);
  }
  
  sub inflate
  {
      my $obj = IO::Compress::Base::Common::createSelfTiedObject(undef, \$InflateError);
      return $obj->_inf(@_);
  }
  
  sub getExtraParams
  {
      return ();
  }
  
  sub ckParams
  {
      my $self = shift ;
      my $got = shift ;
  
      $got->setValue('adler32' => 1);
  
      return 1;
  }
  
  sub ckMagic
  {
      my $self = shift;
  
      my $magic ;
      $self->smartReadExact(\$magic, ZLIB_HEADER_SIZE);
  
      *$self->{HeaderPending} = $magic ;
  
      return $self->HeaderError("Header size is " . 
                                          ZLIB_HEADER_SIZE . " bytes") 
          if length $magic != ZLIB_HEADER_SIZE;
  
      return undef
          if ! $self->isZlibMagic($magic) ;
                        
      *$self->{Type} = 'rfc1950';
      return $magic;
  }
  
  sub readHeader
  {
      my $self = shift;
      my $magic = shift ;
  
      return $self->_readDeflateHeader($magic) ;
  }
  
  sub chkTrailer
  {
      my $self = shift;
      my $trailer = shift;
  
      my $ADLER32 = unpack("N", $trailer) ;
      *$self->{Info}{ADLER32} = $ADLER32;    
      return $self->TrailerError("CRC mismatch")
          if *$self->{Strict} && $ADLER32 != *$self->{Uncomp}->adler32() ;
  
      return STATUS_OK;
  }
  
  
  
  sub isZlibMagic
  {
      my $self = shift;
      my $buffer = shift ;
  
      return 0 
          if length $buffer < ZLIB_HEADER_SIZE ;
  
      my $hdr = unpack("n", $buffer) ;
      return $self->HeaderError("CRC mismatch.")
          if $hdr % 31 != 0 ;
  
      my ($CMF, $FLG) = unpack "C C", $buffer;
      my $cm =    bits($CMF, ZLIB_CMF_CM_OFFSET,    ZLIB_CMF_CM_BITS) ;
  
      return $self->HeaderError("Not Deflate (CM is $cm)") 
          if $cm != ZLIB_CMF_CM_DEFLATED ;
  
      my $cinfo = bits($CMF, ZLIB_CMF_CINFO_OFFSET, ZLIB_CMF_CINFO_BITS) ;
      return $self->HeaderError("CINFO > " . ZLIB_CMF_CINFO_MAX . 
                                " (CINFO is $cinfo)") 
          if $cinfo > ZLIB_CMF_CINFO_MAX ;
  
      return 1;    
  }
  
  sub bits
  {
      my $data   = shift ;
      my $offset = shift ;
      my $mask  = shift ;
  
      ($data >> $offset ) & $mask & 0xFF ;
  }
  
  
  sub _readDeflateHeader
  {
      my ($self, $buffer) = @_ ;
  
                                          
      my ($CMF, $FLG) = unpack "C C", $buffer;
      my $FDICT = bits($FLG, ZLIB_FLG_FDICT_OFFSET,  ZLIB_FLG_FDICT_BITS ),
  
      my $cm = bits($CMF, ZLIB_CMF_CM_OFFSET, ZLIB_CMF_CM_BITS) ;
      $cm == ZLIB_CMF_CM_DEFLATED 
          or return $self->HeaderError("Not Deflate (CM is $cm)") ;
  
      my $DICTID;
      if ($FDICT) {
          $self->smartReadExact(\$buffer, ZLIB_FDICT_SIZE)
              or return $self->TruncatedHeader("FDICT");
  
          $DICTID = unpack("N", $buffer) ;
      }
  
      *$self->{Type} = 'rfc1950';
  
      return {
          'Type'          => 'rfc1950',
          'FingerprintLength'  => ZLIB_HEADER_SIZE,
          'HeaderLength'  => ZLIB_HEADER_SIZE,
          'TrailerLength' => ZLIB_TRAILER_SIZE,
          'Header'        => $buffer,
  
          CMF     =>      $CMF                                               ,
          CM      => bits($CMF, ZLIB_CMF_CM_OFFSET,     ZLIB_CMF_CM_BITS    ),
          CINFO   => bits($CMF, ZLIB_CMF_CINFO_OFFSET,  ZLIB_CMF_CINFO_BITS ),
          FLG     =>      $FLG                                               ,
          FCHECK  => bits($FLG, ZLIB_FLG_FCHECK_OFFSET, ZLIB_FLG_FCHECK_BITS),
          FDICT   => bits($FLG, ZLIB_FLG_FDICT_OFFSET,  ZLIB_FLG_FDICT_BITS ),
          FLEVEL  => bits($FLG, ZLIB_FLG_LEVEL_OFFSET,  ZLIB_FLG_LEVEL_BITS ),
          DICTID  =>      $DICTID                                            ,
  
      };
  }
  
  
  
  
  1 ;
  
  __END__
  
  
IO_UNCOMPRESS_INFLATE

$fatpacked{"IO/Uncompress/RawInflate.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'IO_UNCOMPRESS_RAWINFLATE';
  package IO::Uncompress::RawInflate ;
  
  use strict ;
  use warnings;
  
  use Compress::Raw::Zlib  2.068 ;
  use IO::Compress::Base::Common  2.068 qw(:Status );
  
  use IO::Uncompress::Base  2.068 ;
  use IO::Uncompress::Adapter::Inflate  2.068 ;
  
  require Exporter ;
  our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, %DEFLATE_CONSTANTS, $RawInflateError);
  
  $VERSION = '2.068';
  $RawInflateError = '';
  
  @ISA    = qw( Exporter IO::Uncompress::Base );
  @EXPORT_OK = qw( $RawInflateError rawinflate ) ;
  %DEFLATE_CONSTANTS = ();
  %EXPORT_TAGS = %IO::Uncompress::Base::EXPORT_TAGS ;
  push @{ $EXPORT_TAGS{all} }, @EXPORT_OK ;
  Exporter::export_ok_tags('all');
  
  
  sub new
  {
      my $class = shift ;
      my $obj = IO::Compress::Base::Common::createSelfTiedObject($class, \$RawInflateError);
      $obj->_create(undef, 0, @_);
  }
  
  sub rawinflate
  {
      my $obj = IO::Compress::Base::Common::createSelfTiedObject(undef, \$RawInflateError);
      return $obj->_inf(@_);
  }
  
  sub getExtraParams
  {
      return ();
  }
  
  sub ckParams
  {
      my $self = shift ;
      my $got = shift ;
  
      return 1;
  }
  
  sub mkUncomp
  {
      my $self = shift ;
      my $got = shift ;
  
      my ($obj, $errstr, $errno) = IO::Uncompress::Adapter::Inflate::mkUncompObject(
                                                                  $got->getValue('crc32'),
                                                                  $got->getValue('adler32'),
                                                                  $got->getValue('scan'),
                                                              );
  
      return $self->saveErrorString(undef, $errstr, $errno)
          if ! defined $obj;
  
      *$self->{Uncomp} = $obj;
  
       my $magic = $self->ckMagic()
          or return 0;
  
      *$self->{Info} = $self->readHeader($magic)
          or return undef ;
  
      return 1;
  
  }
  
  
  sub ckMagic
  {
      my $self = shift;
  
      return $self->_isRaw() ;
  }
  
  sub readHeader
  {
      my $self = shift;
      my $magic = shift ;
  
      return {
          'Type'          => 'rfc1951',
          'FingerprintLength'  => 0,
          'HeaderLength'  => 0,
          'TrailerLength' => 0,
          'Header'        => ''
          };
  }
  
  sub chkTrailer
  {
      return STATUS_OK ;
  }
  
  sub _isRaw
  {
      my $self   = shift ;
  
      my $got = $self->_isRawx(@_);
  
      if ($got) {
          *$self->{Pending} = *$self->{HeaderPending} ;
      }
      else {
          $self->pushBack(*$self->{HeaderPending});
          *$self->{Uncomp}->reset();
      }
      *$self->{HeaderPending} = '';
  
      return $got ;
  }
  
  sub _isRawx
  {
      my $self   = shift ;
      my $magic = shift ;
  
      $magic = '' unless defined $magic ;
  
      my $buffer = '';
  
      $self->smartRead(\$buffer, *$self->{BlockSize}) >= 0  
          or return $self->saveErrorString(undef, "No data to read");
  
      my $temp_buf = $magic . $buffer ;
      *$self->{HeaderPending} = $temp_buf ;    
      $buffer = '';
      my $status = *$self->{Uncomp}->uncompr(\$temp_buf, \$buffer, $self->smartEof()) ;
      
      return $self->saveErrorString(undef, *$self->{Uncomp}{Error}, STATUS_ERROR)
          if $status == STATUS_ERROR;
  
      $self->pushBack($temp_buf)  ;
  
      return $self->saveErrorString(undef, "unexpected end of file", STATUS_ERROR)
          if $self->smartEof() && $status != STATUS_ENDSTREAM;
              
      my $buf_len = length $buffer;
  
      if ($status == STATUS_ENDSTREAM) {
          if (*$self->{MultiStream} 
                      && (length $temp_buf || ! $self->smartEof())){
              *$self->{NewStream} = 1 ;
              *$self->{EndStream} = 0 ;
          }
          else {
              *$self->{EndStream} = 1 ;
          }
      }
      *$self->{HeaderPending} = $buffer ;    
      *$self->{InflatedBytesRead} = $buf_len ;    
      *$self->{TotalInflatedBytesRead} += $buf_len ;    
      *$self->{Type} = 'rfc1951';
  
      $self->saveStatus(STATUS_OK);
  
      return {
          'Type'          => 'rfc1951',
          'HeaderLength'  => 0,
          'TrailerLength' => 0,
          'Header'        => ''
          };
  }
  
  
  sub inflateSync
  {
      my $self = shift ;
  
      return 1
          if *$self->{Plain} ;
  
      return 0 if *$self->{Closed} ;
      return 0 if ! length *$self->{Pending} && *$self->{EndStream} ;
  
      *$self->{Strict} = 0 ;
  
      my $status ;
      while (1)
      {
          my $temp_buf ;
  
          if (length *$self->{Pending} )
          {
              $temp_buf = *$self->{Pending} ;
              *$self->{Pending} = '';
          }
          else
          {
              $status = $self->smartRead(\$temp_buf, *$self->{BlockSize}) ;
              return $self->saveErrorString(0, "Error Reading Data")
                  if $status < 0  ;
  
              if ($status == 0 ) {
                  *$self->{EndStream} = 1 ;
                  return $self->saveErrorString(0, "unexpected end of file", STATUS_ERROR);
              }
          }
          
          $status = *$self->{Uncomp}->sync($temp_buf) ;
  
          if ($status == STATUS_OK)
          {
              *$self->{Pending} .= $temp_buf ;
              return 1 ;
          }
  
          last unless $status == STATUS_ERROR ;
      }
  
      return 0;
  }
  
  
  sub scan
  {
      my $self = shift ;
  
      return 1 if *$self->{Closed} ;
      return 1 if !length *$self->{Pending} && *$self->{EndStream} ;
  
      my $buffer = '' ;
      my $len = 0;
  
      $len = $self->_raw_read(\$buffer, 1) 
          while ! *$self->{EndStream} && $len >= 0 ;
  
      return $len < 0 ? 0 : 1 ;
  }
  
  sub zap
  {
      my $self  = shift ;
  
      my $headerLength = *$self->{Info}{HeaderLength};
      my $block_offset =  $headerLength + *$self->{Uncomp}->getLastBlockOffset();
      $_[0] = $headerLength + *$self->{Uncomp}->getEndOffset();
      my $byte ;
      ( $self->smartSeek($block_offset) &&
        $self->smartRead(\$byte, 1) ) 
          or return $self->saveErrorString(0, $!, $!); 
  
      *$self->{Uncomp}->resetLastBlockByte($byte);
  
      ( $self->smartSeek($block_offset) && 
        $self->smartWrite($byte) )
          or return $self->saveErrorString(0, $!, $!); 
  
  
      return 1 ;
  }
  
  sub createDeflate
  {
      my $self  = shift ;
      my ($def, $status) = *$self->{Uncomp}->createDeflateStream(
                                      -AppendOutput   => 1,
                                      -WindowBits => - MAX_WBITS,
                                      -CRC32      => *$self->{Params}->getValue('crc32'),
                                      -ADLER32    => *$self->{Params}->getValue('adler32'),
                                  );
      
      return wantarray ? ($status, $def) : $def ;                                
  }
  
  
  1; 
  
  __END__
  
  
IO_UNCOMPRESS_RAWINFLATE

$fatpacked{"IO/Uncompress/Unzip.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'IO_UNCOMPRESS_UNZIP';
  package IO::Uncompress::Unzip;
  
  require 5.006 ;
  
  
  use strict ;
  use warnings;
  
  use IO::File;
  use IO::Uncompress::RawInflate  2.068 ;
  use IO::Compress::Base::Common  2.068 qw(:Status );
  use IO::Uncompress::Adapter::Inflate  2.068 ;
  use IO::Uncompress::Adapter::Identity 2.068 ;
  use IO::Compress::Zlib::Extra 2.068 ;
  use IO::Compress::Zip::Constants 2.068 ;
  
  use Compress::Raw::Zlib  2.068 () ;
  
  BEGIN
  {
      eval{ require IO::Uncompress::Adapter::Bunzip2 ;
             import  IO::Uncompress::Adapter::Bunzip2 } ;
      eval{ require IO::Uncompress::Adapter::UnLzma ;
            import  IO::Uncompress::Adapter::UnLzma } ;
  }
  
  
  require Exporter ;
  
  our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, $UnzipError, %headerLookup);
  
  $VERSION = '2.068';
  $UnzipError = '';
  
  @ISA    = qw(Exporter IO::Uncompress::RawInflate);
  @EXPORT_OK = qw( $UnzipError unzip );
  %EXPORT_TAGS = %IO::Uncompress::RawInflate::EXPORT_TAGS ;
  push @{ $EXPORT_TAGS{all} }, @EXPORT_OK ;
  Exporter::export_ok_tags('all');
  
  %headerLookup = (
          ZIP_CENTRAL_HDR_SIG,            \&skipCentralDirectory,
          ZIP_END_CENTRAL_HDR_SIG,        \&skipEndCentralDirectory,
          ZIP64_END_CENTRAL_REC_HDR_SIG,  \&skipCentralDirectory64Rec,
          ZIP64_END_CENTRAL_LOC_HDR_SIG,  \&skipCentralDirectory64Loc,
          ZIP64_ARCHIVE_EXTRA_SIG,        \&skipArchiveExtra,
          ZIP64_DIGITAL_SIGNATURE_SIG,    \&skipDigitalSignature,
          );
  
  sub new
  {
      my $class = shift ;
      my $obj = IO::Compress::Base::Common::createSelfTiedObject($class, \$UnzipError);
      $obj->_create(undef, 0, @_);
  }
  
  sub unzip
  {
      my $obj = IO::Compress::Base::Common::createSelfTiedObject(undef, \$UnzipError);
      return $obj->_inf(@_) ;
  }
  
  sub getExtraParams
  {
     
      return (
              'name'    => [IO::Compress::Base::Common::Parse_any,       undef],
  
              'stream'  => [IO::Compress::Base::Common::Parse_boolean,   0],
              
          );    
  }
  
  sub ckParams
  {
      my $self = shift ;
      my $got = shift ;
  
      $got->setValue('crc32' => 1);
  
      *$self->{UnzipData}{Name} = $got->getValue('name');
  
      return 1;
  }
  
  sub mkUncomp
  {
      my $self = shift ;
      my $got = shift ;
  
       my $magic = $self->ckMagic()
          or return 0;
  
      *$self->{Info} = $self->readHeader($magic)
          or return undef ;
  
      return 1;
  
  }
  
  sub ckMagic
  {
      my $self = shift;
  
      my $magic ;
      $self->smartReadExact(\$magic, 4);
  
      *$self->{HeaderPending} = $magic ;
  
      return $self->HeaderError("Minimum header size is " . 
                                4 . " bytes") 
          if length $magic != 4 ;                                    
  
      return $self->HeaderError("Bad Magic")
          if ! _isZipMagic($magic) ;
  
      *$self->{Type} = 'zip';
  
      return $magic ;
  }
  
  
  sub fastForward
  {
      my $self = shift;
      my $offset = shift;
  
  
      my $buffer = '';
      my $c = 1024 * 16;
  
      while ($offset > 0)
      {
          $c = length $offset
              if length $offset < $c ;
  
          $offset -= $c;
  
          $self->smartReadExact(\$buffer, $c)
              or return 0;
      }
  
      return 1;
  }
  
  
  sub readHeader
  {
      my $self = shift;
      my $magic = shift ;
  
      my $name =  *$self->{UnzipData}{Name} ;
      my $hdr = $self->_readZipHeader($magic) ;
  
      while (defined $hdr)
      {
          if (! defined $name || $hdr->{Name} eq $name)
          {
              return $hdr ;
          }
  
          my $buffer;
          if (*$self->{ZipData}{Streaming}) {
  
              while (1) {
  
                  my $b;
                  my $status = $self->smartRead(\$b, 1024 * 16);
                  return undef
                      if $status <= 0 ;
  
                  my $temp_buf;
                  my $out;
                  $status = *$self->{Uncomp}->uncompr(\$b, \$temp_buf, 0, $out);
  
                  return $self->saveErrorString(undef, *$self->{Uncomp}{Error}, 
                                                       *$self->{Uncomp}{ErrorNo})
                      if $self->saveStatus($status) == STATUS_ERROR;                
  
                  if ($status == STATUS_ENDSTREAM) {
                      *$self->{Uncomp}->reset();
                      $self->pushBack($b)  ;
                      last;
                  }
              }
  
              $self->smartReadExact(\$buffer, $hdr->{TrailerLength})
                  or return $self->saveErrorString(undef, "Truncated file");
          }
          else {
              my $c = $hdr->{CompressedLength}->get64bit();
              $self->fastForward($c)
                  or return $self->saveErrorString(undef, "Truncated file");
              $buffer = '';
          }
  
          $self->chkTrailer($buffer) == STATUS_OK
              or return $self->saveErrorString(undef, "Truncated file");
  
          $hdr = $self->_readFullZipHeader();
  
          return $self->saveErrorString(undef, "Cannot find '$name'")
              if $self->smartEof();
      }
  
      return undef;
  }
  
  sub chkTrailer
  {
      my $self = shift;
      my $trailer = shift;
  
      my ($sig, $CRC32, $cSize, $uSize) ;
      my ($cSizeHi, $uSizeHi) = (0, 0);
      if (*$self->{ZipData}{Streaming}) {
          $sig   = unpack ("V", substr($trailer, 0, 4));
          $CRC32 = unpack ("V", substr($trailer, 4, 4));
  
          if (*$self->{ZipData}{Zip64} ) {
              $cSize = U64::newUnpack_V64 substr($trailer,  8, 8);
              $uSize = U64::newUnpack_V64 substr($trailer, 16, 8);
          }
          else {
              $cSize = U64::newUnpack_V32 substr($trailer,  8, 4);
              $uSize = U64::newUnpack_V32 substr($trailer, 12, 4);
          }
  
          return $self->TrailerError("Data Descriptor signature, got $sig")
              if $sig != ZIP_DATA_HDR_SIG;
      }
      else {
          ($CRC32, $cSize, $uSize) = 
              (*$self->{ZipData}{Crc32},
               *$self->{ZipData}{CompressedLen},
               *$self->{ZipData}{UnCompressedLen});
      }
  
      *$self->{Info}{CRC32} = *$self->{ZipData}{CRC32} ;
      *$self->{Info}{CompressedLength} = $cSize->get64bit();
      *$self->{Info}{UncompressedLength} = $uSize->get64bit();
  
      if (*$self->{Strict}) {
          return $self->TrailerError("CRC mismatch")
              if $CRC32  != *$self->{ZipData}{CRC32} ;
  
          return $self->TrailerError("CSIZE mismatch.")
              if ! $cSize->equal(*$self->{CompSize});
  
          return $self->TrailerError("USIZE mismatch.")
              if ! $uSize->equal(*$self->{UnCompSize});
      }
  
      my $reachedEnd = STATUS_ERROR ;
      while (1)
      {
          my $magic ;
          my $got = $self->smartRead(\$magic, 4);
  
          return $self->saveErrorString(STATUS_ERROR, "Truncated file")
              if $got != 4 && *$self->{Strict};
  
          if ($got == 0) {
              return STATUS_EOF ;
          }
          elsif ($got < 0) {
              return STATUS_ERROR ;
          }
          elsif ($got < 4) {
              $self->pushBack($magic)  ;
              return STATUS_OK ;
          }
  
          my $sig = unpack("V", $magic) ;
  
          my $hdr;
          if ($hdr = $headerLookup{$sig})
          {
              if (&$hdr($self, $magic) != STATUS_OK ) {
                  if (*$self->{Strict}) {
                      return STATUS_ERROR ;
                  }
                  else {
                      $self->clearError();
                      return STATUS_OK ;
                  }
              }
  
              if ($sig == ZIP_END_CENTRAL_HDR_SIG)
              {
                  return STATUS_OK ;
                  last;
              }
          }
          elsif ($sig == ZIP_LOCAL_HDR_SIG)
          {
              $self->pushBack($magic)  ;
              return STATUS_OK ;
          }
          else
          {
              $self->pushBack($magic)  ;
              last;
          }
      }
  
      return $reachedEnd ;
  }
  
  sub skipCentralDirectory
  {
      my $self = shift;
      my $magic = shift ;
  
      my $buffer;
      $self->smartReadExact(\$buffer, 46 - 4)
          or return $self->TrailerError("Minimum header size is " . 
                                       46 . " bytes") ;
  
      my $keep = $magic . $buffer ;
      *$self->{HeaderPending} = $keep ;
  
      my $compressedLength   = unpack ("V", substr($buffer, 20-4, 4));
      my $uncompressedLength = unpack ("V", substr($buffer, 24-4, 4));
      my $filename_length    = unpack ("v", substr($buffer, 28-4, 2)); 
      my $extra_length       = unpack ("v", substr($buffer, 30-4, 2));
      my $comment_length     = unpack ("v", substr($buffer, 32-4, 2));
  
      
      my $filename;
      my $extraField;
      my $comment ;
      if ($filename_length)
      {
          $self->smartReadExact(\$filename, $filename_length)
              or return $self->TruncatedTrailer("filename");
          $keep .= $filename ;
      }
  
      if ($extra_length)
      {
          $self->smartReadExact(\$extraField, $extra_length)
              or return $self->TruncatedTrailer("extra");
          $keep .= $extraField ;
      }
  
      if ($comment_length)
      {
          $self->smartReadExact(\$comment, $comment_length)
              or return $self->TruncatedTrailer("comment");
          $keep .= $comment ;
      }
  
      return STATUS_OK ;
  }
  
  sub skipArchiveExtra
  {
      my $self = shift;
      my $magic = shift ;
  
      my $buffer;
      $self->smartReadExact(\$buffer, 4)
          or return $self->TrailerError("Minimum header size is " . 
                                       4 . " bytes") ;
  
      my $keep = $magic . $buffer ;
  
      my $size = unpack ("V", $buffer);
  
      $self->smartReadExact(\$buffer, $size)
          or return $self->TrailerError("Minimum header size is " . 
                                       $size . " bytes") ;
  
      $keep .= $buffer ;
      *$self->{HeaderPending} = $keep ;
  
      return STATUS_OK ;
  }
  
  
  sub skipCentralDirectory64Rec
  {
      my $self = shift;
      my $magic = shift ;
  
      my $buffer;
      $self->smartReadExact(\$buffer, 8)
          or return $self->TrailerError("Minimum header size is " . 
                                       8 . " bytes") ;
  
      my $keep = $magic . $buffer ;
  
      my ($sizeLo, $sizeHi)  = unpack ("V V", $buffer);
      my $size = $sizeHi * U64::MAX32 + $sizeLo;
  
      $self->fastForward($size)
          or return $self->TrailerError("Minimum header size is " . 
                                       $size . " bytes") ;
  
  
  
      return STATUS_OK ;
  }
  
  sub skipCentralDirectory64Loc
  {
      my $self = shift;
      my $magic = shift ;
  
      my $buffer;
      $self->smartReadExact(\$buffer, 20 - 4)
          or return $self->TrailerError("Minimum header size is " . 
                                       20 . " bytes") ;
  
      my $keep = $magic . $buffer ;
      *$self->{HeaderPending} = $keep ;
  
  
      return STATUS_OK ;
  }
  
  sub skipEndCentralDirectory
  {
      my $self = shift;
      my $magic = shift ;
  
      my $buffer;
      $self->smartReadExact(\$buffer, 22 - 4)
          or return $self->TrailerError("Minimum header size is " . 
                                       22 . " bytes") ;
  
      my $keep = $magic . $buffer ;
      *$self->{HeaderPending} = $keep ;
  
      my $comment_length     = unpack ("v", substr($buffer, 20-4, 2));
  
      
      my $comment ;
      if ($comment_length)
      {
          $self->smartReadExact(\$comment, $comment_length)
              or return $self->TruncatedTrailer("comment");
          $keep .= $comment ;
      }
  
      return STATUS_OK ;
  }
  
  
  sub _isZipMagic
  {
      my $buffer = shift ;
      return 0 if length $buffer < 4 ;
      my $sig = unpack("V", $buffer) ;
      return $sig == ZIP_LOCAL_HDR_SIG ;
  }
  
  
  sub _readFullZipHeader($)
  {
      my ($self) = @_ ;
      my $magic = '' ;
  
      $self->smartReadExact(\$magic, 4);
  
      *$self->{HeaderPending} = $magic ;
  
      return $self->HeaderError("Minimum header size is " . 
                                30 . " bytes") 
          if length $magic != 4 ;                                    
  
  
      return $self->HeaderError("Bad Magic")
          if ! _isZipMagic($magic) ;
  
      my $status = $self->_readZipHeader($magic);
      delete *$self->{Transparent} if ! defined $status ;
      return $status ;
  }
  
  sub _readZipHeader($)
  {
      my ($self, $magic) = @_ ;
      my ($HeaderCRC) ;
      my ($buffer) = '' ;
  
      $self->smartReadExact(\$buffer, 30 - 4)
          or return $self->HeaderError("Minimum header size is " . 
                                       30 . " bytes") ;
  
      my $keep = $magic . $buffer ;
      *$self->{HeaderPending} = $keep ;
  
      my $extractVersion     = unpack ("v", substr($buffer, 4-4,  2));
      my $gpFlag             = unpack ("v", substr($buffer, 6-4,  2));
      my $compressedMethod   = unpack ("v", substr($buffer, 8-4,  2));
      my $lastModTime        = unpack ("V", substr($buffer, 10-4, 4));
      my $crc32              = unpack ("V", substr($buffer, 14-4, 4));
      my $compressedLength   = U64::newUnpack_V32 substr($buffer, 18-4, 4);
      my $uncompressedLength = U64::newUnpack_V32 substr($buffer, 22-4, 4);
      my $filename_length    = unpack ("v", substr($buffer, 26-4, 2)); 
      my $extra_length       = unpack ("v", substr($buffer, 28-4, 2));
  
      my $filename;
      my $extraField;
      my @EXTRA = ();
      my $streamingMode = ($gpFlag & ZIP_GP_FLAG_STREAMING_MASK) ? 1 : 0 ;
  
      return $self->HeaderError("Encrypted content not supported")
          if $gpFlag & (ZIP_GP_FLAG_ENCRYPTED_MASK|ZIP_GP_FLAG_STRONG_ENCRYPTED_MASK);
  
      return $self->HeaderError("Patch content not supported")
          if $gpFlag & ZIP_GP_FLAG_PATCHED_MASK;
  
      *$self->{ZipData}{Streaming} = $streamingMode;
  
  
      if ($filename_length)
      {
          $self->smartReadExact(\$filename, $filename_length)
              or return $self->TruncatedHeader("Filename");
          $keep .= $filename ;
      }
  
      my $zip64 = 0 ;
  
      if ($extra_length)
      {
          $self->smartReadExact(\$extraField, $extra_length)
              or return $self->TruncatedHeader("Extra Field");
  
          my $bad = IO::Compress::Zlib::Extra::parseRawExtra($extraField,
                                                  \@EXTRA, 1, 0);
          return $self->HeaderError($bad)
              if defined $bad;
  
          $keep .= $extraField ;
  
          my %Extra ;
          for (@EXTRA)
          {
              $Extra{$_->[0]} = \$_->[1];
          }
          
          if (defined $Extra{ZIP_EXTRA_ID_ZIP64()})
          {
              $zip64 = 1 ;
  
              my $buff = ${ $Extra{ZIP_EXTRA_ID_ZIP64()} };
  
  
              if (! $streamingMode) {
                  my $offset = 0 ;
  
                  if (U64::full32 $uncompressedLength->get32bit() ) {
                      $uncompressedLength 
                              = U64::newUnpack_V64 substr($buff, 0, 8);
  
                      $offset += 8 ;
                  }
  
                  if (U64::full32 $compressedLength->get32bit() ) {
  
                      $compressedLength 
                          = U64::newUnpack_V64 substr($buff, $offset, 8);
  
                      $offset += 8 ;
                  }
             }
          }
      }
  
      *$self->{ZipData}{Zip64} = $zip64;
  
      if (! $streamingMode) {
          *$self->{ZipData}{Streaming} = 0;
          *$self->{ZipData}{Crc32} = $crc32;
          *$self->{ZipData}{CompressedLen} = $compressedLength;
          *$self->{ZipData}{UnCompressedLen} = $uncompressedLength;
          *$self->{CompressedInputLengthRemaining} =
              *$self->{CompressedInputLength} = $compressedLength->get64bit();
      }
  
      *$self->{ZipData}{CRC32} = Compress::Raw::Zlib::crc32(undef);
      *$self->{ZipData}{Method} = $compressedMethod;
      if ($compressedMethod == ZIP_CM_DEFLATE)
      {
          *$self->{Type} = 'zip-deflate';
          my $obj = IO::Uncompress::Adapter::Inflate::mkUncompObject(1,0,0);
  
          *$self->{Uncomp} = $obj;
      }
      elsif ($compressedMethod == ZIP_CM_BZIP2)
      {
          return $self->HeaderError("Unsupported Compression format $compressedMethod")
              if ! defined $IO::Uncompress::Adapter::Bunzip2::VERSION ;
          
          *$self->{Type} = 'zip-bzip2';
          
          my $obj = IO::Uncompress::Adapter::Bunzip2::mkUncompObject();
  
          *$self->{Uncomp} = $obj;
      }
      elsif ($compressedMethod == ZIP_CM_LZMA)
      {
          return $self->HeaderError("Unsupported Compression format $compressedMethod")
              if ! defined $IO::Uncompress::Adapter::UnLzma::VERSION ;
          
          *$self->{Type} = 'zip-lzma';
          my $LzmaHeader;
          $self->smartReadExact(\$LzmaHeader, 4)
                  or return $self->saveErrorString(undef, "Truncated file");
          my ($verHi, $verLo)   = unpack ("CC", substr($LzmaHeader, 0, 2));
          my $LzmaPropertiesSize   = unpack ("v", substr($LzmaHeader, 2, 2));
  
  
          my $LzmaPropertyData;
          $self->smartReadExact(\$LzmaPropertyData, $LzmaPropertiesSize)
                  or return $self->saveErrorString(undef, "Truncated file");
  
          if (! $streamingMode) {
              *$self->{ZipData}{CompressedLen}->subtract(4 + $LzmaPropertiesSize) ;
              *$self->{CompressedInputLengthRemaining} =
                  *$self->{CompressedInputLength} = *$self->{ZipData}{CompressedLen}->get64bit();
          }
  
          my $obj =
              IO::Uncompress::Adapter::UnLzma::mkUncompZipObject($LzmaPropertyData);
  
          *$self->{Uncomp} = $obj;
      }
      elsif ($compressedMethod == ZIP_CM_STORE)
      {
          *$self->{Type} = 'zip-stored';
          
          my $obj =
          IO::Uncompress::Adapter::Identity::mkUncompObject($streamingMode,
                                                            $zip64);
  
          *$self->{Uncomp} = $obj;
      }
      else
      {
          return $self->HeaderError("Unsupported Compression format $compressedMethod");
      }
  
      return {
          'Type'               => 'zip',
          'FingerprintLength'  => 4,
          'HeaderLength'       => length $keep,
          'Zip64'              => $zip64,
          'TrailerLength'      => ! $streamingMode ? 0 : $zip64 ? 24 : 16,
          'Header'             => $keep,
          'CompressedLength'   => $compressedLength ,
          'UncompressedLength' => $uncompressedLength ,
          'CRC32'              => $crc32 ,
          'Name'               => $filename,
          'Time'               => _dosToUnixTime($lastModTime),
          'Stream'             => $streamingMode,
  
          'MethodID'           => $compressedMethod,
          'MethodName'         => $compressedMethod == ZIP_CM_DEFLATE 
                                   ? "Deflated" 
                                   : $compressedMethod == ZIP_CM_BZIP2
                                       ? "Bzip2"
                                       : $compressedMethod == ZIP_CM_LZMA
                                           ? "Lzma"
                                           : $compressedMethod == ZIP_CM_STORE
                                               ? "Stored"
                                               : "Unknown" ,
  
          'ExtraFieldRaw' => $extraField,
          'ExtraField'    => [ @EXTRA ],
  
  
        }
  }
  
  sub filterUncompressed
  {
      my $self = shift ;
  
      if (*$self->{ZipData}{Method} == ZIP_CM_DEFLATE) {
          *$self->{ZipData}{CRC32} = *$self->{Uncomp}->crc32() ;
      }
      else {
          *$self->{ZipData}{CRC32} = Compress::Raw::Zlib::crc32(${$_[0]}, *$self->{ZipData}{CRC32}, $_[1]);
      }
  }    
  
  
  sub _dosToUnixTime
  {
  	my $dt = shift;
  
  	my $year = ( ( $dt >> 25 ) & 0x7f ) + 80;
  	my $mon  = ( ( $dt >> 21 ) & 0x0f ) - 1;
  	my $mday = ( ( $dt >> 16 ) & 0x1f );
  
  	my $hour = ( ( $dt >> 11 ) & 0x1f );
  	my $min  = ( ( $dt >> 5 ) & 0x3f );
  	my $sec  = ( ( $dt << 1 ) & 0x3e );
  
  
      use POSIX 'mktime';
  
      my $time_t = mktime( $sec, $min, $hour, $mday, $mon, $year, 0, 0, -1 );
      return 0 if ! defined $time_t;
  	return $time_t;
  }
  
  
  
  sub skip
  {
      my $self = shift;
      my $size = shift;
  
      use Fcntl qw(SEEK_CUR);
      if (ref $size eq 'U64') {
          $self->smartSeek($size->get64bit(), SEEK_CUR);
      }
      else {
          $self->smartSeek($size, SEEK_CUR);
      }
      
  }
  
  
  sub scanCentralDirectory
  {
      my $self = shift;
  
      my $here = $self->tell();
  
  
      my @CD = ();
      my $offset = $self->findCentralDirectoryOffset();
  
      return ()
          if ! defined $offset;
  
      $self->smarkSeek($offset, 0, SEEK_SET) ;
  
      my $buffer ;
      while ($self->smartReadExact(\$buffer, 46) && 
             unpack("V", $buffer) == ZIP_CENTRAL_HDR_SIG) {
  
          my $compressedLength   = unpack("V", substr($buffer, 20, 4));
          my $uncompressedLength = unpack("V", substr($buffer, 24, 4));
          my $filename_length    = unpack("v", substr($buffer, 28, 2));
          my $extra_length       = unpack("v", substr($buffer, 30, 2));
          my $comment_length     = unpack("v", substr($buffer, 32, 2));
  
          $self->skip($filename_length ) ;
  
          my $v64 = new U64 $compressedLength ;
  
          if (U64::full32 $compressedLength ) {
              $self->smartReadExact(\$buffer, $extra_length) ;
              die "xxx $offset $comment_length $filename_length $extra_length" . length($buffer) 
                  if length($buffer) != $extra_length;
              my $got = $self->get64Extra($buffer, U64::full32 $uncompressedLength);
  
              $v64 = $got if defined $got;
          }
          else {
              $self->skip($extra_length) ;
          }
  
          $self->skip($comment_length ) ;
              
          push @CD, $v64 ;
      }
  
      $self->smartSeek($here, 0, SEEK_SET) ;
  
      return @CD;
  }
  
  sub get64Extra
  {
      my $self = shift ;
  
      my $buffer = shift;
      my $is_uncomp = shift ;
  
      my $extra = IO::Compress::Zlib::Extra::findID(0x0001, $buffer);
                                              
      if (! defined $extra)
      {
          return undef;
      }
      else
      {
          my $u64 = U64::newUnpack_V64(substr($extra,  $is_uncomp ? 8 : 0)) ;
          return $u64;
      }    
  }
  
  sub offsetFromZip64
  {
      my $self = shift ;
      my $here = shift;
  
      $self->smartSeek($here - 20, 0, SEEK_SET) 
          or die "xx $!" ;
  
      my $buffer;
      my $got = 0;
      $self->smartReadExact(\$buffer, 20)  
          or die "xxx $here $got $!" ;
  
      if ( unpack("V", $buffer) == ZIP64_END_CENTRAL_LOC_HDR_SIG ) {
          my $cd64 = U64::Value_VV64 substr($buffer,  8, 8);
         
          $self->smartSeek($cd64, 0, SEEK_SET) ;
  
          $self->smartReadExact(\$buffer, 4) 
              or die "xxx" ;
  
          if ( unpack("V", $buffer) == ZIP64_END_CENTRAL_REC_HDR_SIG ) {
  
              $self->smartReadExact(\$buffer, 8)
                  or die "xxx" ;
              my $size  = U64::Value_VV64($buffer);
              $self->smartReadExact(\$buffer, $size)
                  or die "xxx" ;
  
              my $cd64 =  U64::Value_VV64 substr($buffer,  36, 8);
  
              return $cd64 ;
          }
          
          die "zzz";
      }
  
      die "zzz";
  }
  
  use constant Pack_ZIP_END_CENTRAL_HDR_SIG => pack("V", ZIP_END_CENTRAL_HDR_SIG);
  
  sub findCentralDirectoryOffset
  {
      my $self = shift ;
  
  
      $self->smartSeek(-22, 0, SEEK_END) ;
      my $here = $self->tell();
  
      my $buffer;
      $self->smartReadExact(\$buffer, 22) 
          or die "xxx" ;
  
      my $zip64 = 0;                             
      my $centralDirOffset ;
      if ( unpack("V", $buffer) == ZIP_END_CENTRAL_HDR_SIG ) {
          $centralDirOffset = unpack("V", substr($buffer, 16,  4));
      }
      else {
          $self->smartSeek(0, 0, SEEK_END) ;
  
          my $fileLen = $self->tell();
          my $want = 0 ;
  
          while(1) {
              $want += 1024;
              my $seekTo = $fileLen - $want;
              if ($seekTo < 0 ) {
                  $seekTo = 0;
                  $want = $fileLen ;
              }
              $self->smartSeek( $seekTo, 0, SEEK_SET) 
                  or die "xxx $!" ;
              my $got;
              $self->smartReadExact($buffer, $want)
                  or die "xxx " ;
              my $pos = rindex( $buffer, Pack_ZIP_END_CENTRAL_HDR_SIG);
  
              if ($pos >= 0) {
                  $here = $seekTo + $pos ;
                  $centralDirOffset = unpack("V", substr($buffer, $pos + 16,  4));
                  last ;
              }
  
              return undef
                  if $want == $fileLen;
          }
      }
  
      $centralDirOffset = $self->offsetFromZip64($here)
          if U64::full32 $centralDirOffset ;
  
      return $centralDirOffset ;
  }
  
  1;
  
  __END__
  
  
IO_UNCOMPRESS_UNZIP

$fatpacked{"IOD.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'IOD';
  package IOD;
  
  our $DATE = '2015-03-18'; 
  our $VERSION = '0.9.9'; 
  
  1;
  
  __END__
  
IOD

$fatpacked{"JSON.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'JSON';
  package JSON;
  
  
  use strict;
  use Carp ();
  use base qw(Exporter);
  @JSON::EXPORT = qw(from_json to_json jsonToObj objToJson encode_json decode_json);
  
  BEGIN {
      $JSON::VERSION = '2.90';
      $JSON::DEBUG   = 0 unless (defined $JSON::DEBUG);
      $JSON::DEBUG   = $ENV{ PERL_JSON_DEBUG } if exists $ENV{ PERL_JSON_DEBUG };
  }
  
  my $Module_XS  = 'JSON::XS';
  my $Module_PP  = 'JSON::PP';
  my $Module_bp  = 'JSON::backportPP'; 
  my $PP_Version = '2.27203';
  my $XS_Version = '2.34';
  
  
  
  my @PublicMethods = qw/
      ascii latin1 utf8 pretty indent space_before space_after relaxed canonical allow_nonref 
      allow_blessed convert_blessed filter_json_object filter_json_single_key_object 
      shrink max_depth max_size encode decode decode_prefix allow_unknown
  /;
  
  my @Properties = qw/
      ascii latin1 utf8 indent space_before space_after relaxed canonical allow_nonref
      allow_blessed convert_blessed shrink max_depth max_size allow_unknown
  /;
  
  my @XSOnlyMethods = qw/allow_tags/; 
  
  my @PPOnlyMethods = qw/
      indent_length sort_by
      allow_singlequote allow_bignum loose allow_barekey escape_slash as_nonblessed
  /; 
  
  
  my $_INSTALL_DONT_DIE  = 1; 
  my $_INSTALL_ONLY      = 2; 
  my $_ALLOW_UNSUPPORTED = 0;
  my $_UNIV_CONV_BLESSED = 0;
  my $_USSING_bpPP       = 0;
  
  
  
  unless ($JSON::Backend) {
      $JSON::DEBUG and  Carp::carp("Check used worker module...");
  
      my $backend = exists $ENV{PERL_JSON_BACKEND} ? $ENV{PERL_JSON_BACKEND} : 1;
  
      if ($backend eq '1' or $backend =~ /JSON::XS\s*,\s*JSON::PP/) {
          _load_xs($_INSTALL_DONT_DIE) or _load_pp();
      }
      elsif ($backend eq '0' or $backend eq 'JSON::PP') {
          _load_pp();
      }
      elsif ($backend eq '2' or $backend eq 'JSON::XS') {
          _load_xs();
      }
      elsif ($backend eq 'JSON::backportPP') {
          $_USSING_bpPP = 1;
          _load_pp();
      }
      else {
          Carp::croak "The value of environmental variable 'PERL_JSON_BACKEND' is invalid.";
      }
  }
  
  
  sub import {
      my $pkg = shift;
      my @what_to_export;
      my $no_export;
  
      for my $tag (@_) {
          if ($tag eq '-support_by_pp') {
              if (!$_ALLOW_UNSUPPORTED++) {
                  JSON::Backend::XS
                      ->support_by_pp(@PPOnlyMethods) if ($JSON::Backend eq $Module_XS);
              }
              next;
          }
          elsif ($tag eq '-no_export') {
              $no_export++, next;
          }
          elsif ( $tag eq '-convert_blessed_universally' ) {
              eval q|
                  require B;
                  *UNIVERSAL::TO_JSON = sub {
                      my $b_obj = B::svref_2object( $_[0] );
                      return    $b_obj->isa('B::HV') ? { %{ $_[0] } }
                              : $b_obj->isa('B::AV') ? [ @{ $_[0] } ]
                              : undef
                              ;
                  }
              | if ( !$_UNIV_CONV_BLESSED++ );
              next;
          }
          push @what_to_export, $tag;
      }
  
      return if ($no_export);
  
      __PACKAGE__->export_to_level(1, $pkg, @what_to_export);
  }
  
  
  
  sub jsonToObj {
      my $alternative = 'from_json';
      if (defined $_[0] and UNIVERSAL::isa($_[0], 'JSON')) {
          shift @_; $alternative = 'decode';
      }
      Carp::carp "'jsonToObj' will be obsoleted. Please use '$alternative' instead.";
      return JSON::from_json(@_);
  };
  
  sub objToJson {
      my $alternative = 'to_json';
      if (defined $_[0] and UNIVERSAL::isa($_[0], 'JSON')) {
          shift @_; $alternative = 'encode';
      }
      Carp::carp "'objToJson' will be obsoleted. Please use '$alternative' instead.";
      JSON::to_json(@_);
  };
  
  
  
  sub to_json ($@) {
      if (
          ref($_[0]) eq 'JSON'
          or (@_ > 2 and $_[0] eq 'JSON')
      ) {
          Carp::croak "to_json should not be called as a method.";
      }
      my $json = JSON->new;
  
      if (@_ == 2 and ref $_[1] eq 'HASH') {
          my $opt  = $_[1];
          for my $method (keys %$opt) {
              $json->$method( $opt->{$method} );
          }
      }
  
      $json->encode($_[0]);
  }
  
  
  sub from_json ($@) {
      if ( ref($_[0]) eq 'JSON' or $_[0] eq 'JSON' ) {
          Carp::croak "from_json should not be called as a method.";
      }
      my $json = JSON->new;
  
      if (@_ == 2 and ref $_[1] eq 'HASH') {
          my $opt  = $_[1];
          for my $method (keys %$opt) {
              $json->$method( $opt->{$method} );
          }
      }
  
      return $json->decode( $_[0] );
  }
  
  
  
  sub true  { $JSON::true  }
  
  sub false { $JSON::false }
  
  sub null  { undef; }
  
  
  sub require_xs_version { $XS_Version; }
  
  sub backend {
      my $proto = shift;
      $JSON::Backend;
  }
  
  
  
  sub is_xs {
      return $_[0]->backend eq $Module_XS;
  }
  
  
  sub is_pp {
      return not $_[0]->is_xs;
  }
  
  
  sub pureperl_only_methods { @PPOnlyMethods; }
  
  
  sub property {
      my ($self, $name, $value) = @_;
  
      if (@_ == 1) {
          my %props;
          for $name (@Properties) {
              my $method = 'get_' . $name;
              if ($name eq 'max_size') {
                  my $value = $self->$method();
                  $props{$name} = $value == 1 ? 0 : $value;
                  next;
              }
              $props{$name} = $self->$method();
          }
          return \%props;
      }
      elsif (@_ > 3) {
          Carp::croak('property() can take only the option within 2 arguments.');
      }
      elsif (@_ == 2) {
          if ( my $method = $self->can('get_' . $name) ) {
              if ($name eq 'max_size') {
                  my $value = $self->$method();
                  return $value == 1 ? 0 : $value;
              }
              $self->$method();
          }
      }
      else {
          $self->$name($value);
      }
  
  }
  
  
  
  
  sub _load_xs {
      my $opt = shift;
  
      $JSON::DEBUG and Carp::carp "Load $Module_XS.";
  
      JSON::Boolean::_overrride_overload($Module_XS);
      JSON::Boolean::_overrride_overload($Module_PP);
  
      eval qq|
          use $Module_XS $XS_Version ();
      |;
  
      if ($@) {
          if (defined $opt and $opt & $_INSTALL_DONT_DIE) {
              $JSON::DEBUG and Carp::carp "Can't load $Module_XS...($@)";
              return 0;
          }
          Carp::croak $@;
      }
  
      unless (defined $opt and $opt & $_INSTALL_ONLY) {
          _set_module( $JSON::Backend = $Module_XS );
          my $data = join("", <DATA>); 
          close(DATA);
          eval $data;
          JSON::Backend::XS->init;
      }
  
      return 1;
  };
  
  
  sub _load_pp {
      my $opt = shift;
      my $backend = $_USSING_bpPP ? $Module_bp : $Module_PP;
  
      $JSON::DEBUG and Carp::carp "Load $backend.";
  
      JSON::Boolean::_overrride_overload($Module_XS);
      JSON::Boolean::_overrride_overload($backend);
  
      if ( $_USSING_bpPP ) {
          eval qq| require $backend |;
      }
      else {
          eval qq| use $backend $PP_Version () |;
      }
  
      if ($@) {
          if ( $backend eq $Module_PP ) {
              $JSON::DEBUG and Carp::carp "Can't load $Module_PP ($@), so try to load $Module_bp";
              $_USSING_bpPP++;
              $backend = $Module_bp;
              JSON::Boolean::_overrride_overload($backend);
              local $^W; 
              eval qq| require $Module_bp |;
          }
          Carp::croak $@ if $@;
      }
  
      unless (defined $opt and $opt & $_INSTALL_ONLY) {
          _set_module( $JSON::Backend = $Module_PP ); 
          JSON::Backend::PP->init;
      }
  };
  
  
  sub _set_module {
      return if defined $JSON::true;
  
      my $module = shift;
  
      local $^W;
      no strict qw(refs);
  
      $JSON::true  = ${"$module\::true"};
      $JSON::false = ${"$module\::false"};
  
      push @JSON::ISA, $module;
      if ( JSON->is_xs and JSON->backend->VERSION < 3 ) {
          eval 'package JSON::PP::Boolean';
          push @{"$module\::Boolean::ISA"}, qw(JSON::PP::Boolean);
      }
  
      *{"JSON::is_bool"} = \&{"$module\::is_bool"};
  
      for my $method ($module eq $Module_XS ? @PPOnlyMethods : @XSOnlyMethods) {
          *{"JSON::$method"} = sub {
              Carp::carp("$method is not supported in $module.");
              $_[0];
          };
      }
  
      return 1;
  }
  
  
  
  
  package JSON::Boolean;
  
  my %Installed;
  
  sub _overrride_overload {
      return; 
      return if ($Installed{ $_[0] }++);
  
      my $boolean = $_[0] . '::Boolean';
  
      eval sprintf(q|
          package %s;
          use overload (
              '""' => sub { ${$_[0]} == 1 ? 'true' : 'false' },
              'eq' => sub {
                  my ($obj, $op) = ref ($_[0]) ? ($_[0], $_[1]) : ($_[1], $_[0]);
                  if ($op eq 'true' or $op eq 'false') {
                      return "$obj" eq 'true' ? 'true' eq $op : 'false' eq $op;
                  }
                  else {
                      return $obj ? 1 == $op : 0 == $op;
                  }
              },
          );
      |, $boolean);
  
      if ($@) { Carp::croak $@; }
  
      if ( exists $INC{'JSON/XS.pm'} and $boolean eq 'JSON::XS::Boolean' ) {
          local $^W;
          my $true  = do { bless \(my $dummy = 1), $boolean };
          my $false = do { bless \(my $dummy = 0), $boolean };
          *JSON::XS::true  = sub () { $true };
          *JSON::XS::false = sub () { $false };
      }
      elsif ( exists $INC{'JSON/PP.pm'} and $boolean eq 'JSON::PP::Boolean' ) {
          local $^W;
          my $true  = do { bless \(my $dummy = 1), $boolean };
          my $false = do { bless \(my $dummy = 0), $boolean };
          *JSON::PP::true  = sub { $true };
          *JSON::PP::false = sub { $false };
      }
  
      return 1;
  }
  
  
  
  package JSON::Backend::PP;
  
  sub init {
      local $^W;
      no strict qw(refs); 
      *{"JSON::decode_json"} = \&{"JSON::PP::decode_json"};
      *{"JSON::encode_json"} = \&{"JSON::PP::encode_json"};
      *{"JSON::PP::is_xs"}  = sub { 0 };
      *{"JSON::PP::is_pp"}  = sub { 1 };
      return 1;
  }
  
  
  package JSON;
  
  1;
  __DATA__
  
  
  #
  # Helper classes for Backend Module (XS)
  #
  
  package JSON::Backend::XS;
  
  use constant INDENT_LENGTH_FLAG => 15 << 12;
  
  use constant UNSUPPORTED_ENCODE_FLAG => {
      ESCAPE_SLASH      => 0x00000010,
      ALLOW_BIGNUM      => 0x00000020,
      AS_NONBLESSED     => 0x00000040,
      EXPANDED          => 0x10000000, # for developer's
  };
  
  use constant UNSUPPORTED_DECODE_FLAG => {
      LOOSE             => 0x00000001,
      ALLOW_BIGNUM      => 0x00000002,
      ALLOW_BAREKEY     => 0x00000004,
      ALLOW_SINGLEQUOTE => 0x00000008,
      EXPANDED          => 0x20000000, # for developer's
  };
  
  
  sub init {
      local $^W;
      no strict qw(refs);
      *{"JSON::decode_json"} = \&{"JSON::XS::decode_json"};
      *{"JSON::encode_json"} = \&{"JSON::XS::encode_json"};
      *{"JSON::XS::is_xs"}  = sub { 1 };
      *{"JSON::XS::is_pp"}  = sub { 0 };
      return 1;
  }
  
  
  sub support_by_pp {
      my ($class, @methods) = @_;
  
      local $^W;
      no strict qw(refs);
  
      my $JSON_XS_encode_orignal     = \&JSON::XS::encode;
      my $JSON_XS_decode_orignal     = \&JSON::XS::decode;
      my $JSON_XS_incr_parse_orignal = \&JSON::XS::incr_parse;
  
      *JSON::XS::decode     = \&JSON::Backend::XS::Supportable::_decode;
      *JSON::XS::encode     = \&JSON::Backend::XS::Supportable::_encode;
      *JSON::XS::incr_parse = \&JSON::Backend::XS::Supportable::_incr_parse;
  
      *{JSON::XS::_original_decode}     = $JSON_XS_decode_orignal;
      *{JSON::XS::_original_encode}     = $JSON_XS_encode_orignal;
      *{JSON::XS::_original_incr_parse} = $JSON_XS_incr_parse_orignal;
  
      push @JSON::Backend::XS::Supportable::ISA, 'JSON';
  
      my $pkg = 'JSON::Backend::XS::Supportable';
  
      *{JSON::new} = sub {
          my $proto = JSON::XS->new; $$proto = 0;
          bless  $proto, $pkg;
      };
  
  
      for my $method (@methods) {
          my $flag = uc($method);
          my $type |= (UNSUPPORTED_ENCODE_FLAG->{$flag} || 0);
             $type |= (UNSUPPORTED_DECODE_FLAG->{$flag} || 0);
  
          next unless($type);
  
          $pkg->_make_unsupported_method($method => $type);
      }
  
  #    push @{"JSON::XS::Boolean::ISA"}, qw(JSON::PP::Boolean);
  #    push @{"JSON::PP::Boolean::ISA"}, qw(JSON::Boolean);
  
      $JSON::DEBUG and Carp::carp("set -support_by_pp mode.");
  
      return 1;
  }
  
  
  
  
  #
  # Helper classes for XS
  #
  
  package JSON::Backend::XS::Supportable;
  
  $Carp::Internal{'JSON::Backend::XS::Supportable'} = 1;
  
  sub _make_unsupported_method {
      my ($pkg, $method, $type) = @_;
  
      local $^W;
      no strict qw(refs);
  
      *{"$pkg\::$method"} = sub {
          local $^W;
          if (defined $_[1] ? $_[1] : 1) {
              ${$_[0]} |= $type;
          }
          else {
              ${$_[0]} &= ~$type;
          }
          $_[0];
      };
  
      *{"$pkg\::get_$method"} = sub {
          ${$_[0]} & $type ? 1 : '';
      };
  
  }
  
  
  sub _set_for_pp {
      JSON::_load_pp( $_INSTALL_ONLY );
  
      my $type  = shift;
      my $pp    = JSON::PP->new;
      my $prop = $_[0]->property;
  
      for my $name (keys %$prop) {
          $pp->$name( $prop->{$name} ? $prop->{$name} : 0 );
      }
  
      my $unsupported = $type eq 'encode' ? JSON::Backend::XS::UNSUPPORTED_ENCODE_FLAG
                                          : JSON::Backend::XS::UNSUPPORTED_DECODE_FLAG;
      my $flags       = ${$_[0]} || 0;
  
      for my $name (keys %$unsupported) {
          next if ($name eq 'EXPANDED'); # for developer's
          my $enable = ($flags & $unsupported->{$name}) ? 1 : 0;
          my $method = lc $name;
          $pp->$method($enable);
      }
  
      $pp->indent_length( $_[0]->get_indent_length );
  
      return $pp;
  }
  
  sub _encode { # using with PP encode
      if (${$_[0]}) {
          _set_for_pp('encode' => @_)->encode($_[1]);
      }
      else {
          $_[0]->_original_encode( $_[1] );
      }
  }
  
  
  sub _decode { # if unsupported-flag is set, use PP
      if (${$_[0]}) {
          _set_for_pp('decode' => @_)->decode($_[1]);
      }
      else {
          $_[0]->_original_decode( $_[1] );
      }
  }
  
  
  sub decode_prefix { # if unsupported-flag is set, use PP
      _set_for_pp('decode' => @_)->decode_prefix($_[1]);
  }
  
  
  sub _incr_parse {
      if (${$_[0]}) {
          _set_for_pp('decode' => @_)->incr_parse($_[1]);
      }
      else {
          $_[0]->_original_incr_parse( $_[1] );
      }
  }
  
  
  sub get_indent_length {
      ${$_[0]} << 4 >> 16;
  }
  
  
  sub indent_length {
      my $length = $_[1];
  
      if (!defined $length or $length > 15 or $length < 0) {
          Carp::carp "The acceptable range of indent_length() is 0 to 15.";
      }
      else {
          local $^W;
          $length <<= 12;
          ${$_[0]} &= ~ JSON::Backend::XS::INDENT_LENGTH_FLAG;
          ${$_[0]} |= $length;
          *JSON::XS::encode = \&JSON::Backend::XS::Supportable::_encode;
      }
  
      $_[0];
  }
  
  
  1;
  __END__
  
  =head1 NAME
  
  JSON - JSON (JavaScript Object Notation) encoder/decoder
  
  =head1 SYNOPSIS
  
   use JSON; # imports encode_json, decode_json, to_json and from_json.
   
   # simple and fast interfaces (expect/generate UTF-8)
   
   $utf8_encoded_json_text = encode_json $perl_hash_or_arrayref;
   $perl_hash_or_arrayref  = decode_json $utf8_encoded_json_text;
   
   # OO-interface
   
   $json = JSON->new->allow_nonref;
   
   $json_text   = $json->encode( $perl_scalar );
   $perl_scalar = $json->decode( $json_text );
   
   $pretty_printed = $json->pretty->encode( $perl_scalar ); # pretty-printing
   
   # If you want to use PP only support features, call with '-support_by_pp'
   # When XS unsupported feature is enable, using PP (de|en)code instead of XS ones.
   
   use JSON -support_by_pp;
   
   # option-acceptable interfaces (expect/generate UNICODE by default)
   
   $json_text   = to_json( $perl_scalar, { ascii => 1, pretty => 1 } );
   $perl_scalar = from_json( $json_text, { utf8  => 1 } );
   
   # Between (en|de)code_json and (to|from)_json, if you want to write
   # a code which communicates to an outer world (encoded in UTF-8),
   # recommend to use (en|de)code_json.
   
  =head1 VERSION
  
      2.90
  
  This version is compatible with JSON::XS B<2.34> and later.
  (Not yet compatble to JSON::XS B<3.0x>.)
  
  
  =head1 NOTE
  
  JSON::PP was earlier included in the C<JSON> distribution, but
  has since Perl 5.14 been a core module. For this reason,
  L<JSON::PP> was removed from the JSON distribution and can now
  be found also in the Perl5 repository at
  
  =over
  
  =item * L<http://perl5.git.perl.org/perl.git>
  
  =back
  
  (The newest JSON::PP version still exists in CPAN.)
  
  Instead, the C<JSON> distribution will include JSON::backportPP
  for backwards computability. JSON.pm should thus work as it did
  before.
  
  =head1 DESCRIPTION
  
   *************************** CAUTION **************************************
   *                                                                        *
   * INCOMPATIBLE CHANGE (JSON::XS version 2.90)                            *
   *                                                                        *
   * JSON.pm had patched JSON::XS::Boolean and JSON::PP::Boolean internally *
   * on loading time for making these modules inherit JSON::Boolean.        *
   * But since JSON::XS v3.0 it use Types::Serialiser as boolean class.     *
   * Then now JSON.pm breaks boolean classe overload features and           *
   * -support_by_pp if JSON::XS v3.0 or later is installed.                 *
   *                                                                        *
   * JSON::true and JSON::false returned JSON::Boolean objects.             *
   * For workaround, they return JSON::PP::Boolean objects in this version. *
   *                                                                        *
   *     isa_ok(JSON::true, 'JSON::PP::Boolean');                           *
   *                                                                        *
   * And it discards a feature:                                             *
   *                                                                        *
   *     ok(JSON::true eq 'true');                                          *
   *                                                                        *
   * In other word, JSON::PP::Boolean overload numeric only.                *
   *                                                                        *
   *     ok( JSON::true == 1 );                                             *
   *                                                                        *
   **************************************************************************
  
   ************************** CAUTION ********************************
   * This is 'JSON module version 2' and there are many differences  *
   * to version 1.xx                                                 *
   * Please check your applications using old version.              *
   *   See to 'INCOMPATIBLE CHANGES TO OLD VERSION'                  *
   *******************************************************************
  
  JSON (JavaScript Object Notation) is a simple data format.
  See to L<http://www.json.org/> and C<RFC4627>(L<http://www.ietf.org/rfc/rfc4627.txt>).
  
  This module converts Perl data structures to JSON and vice versa using either
  L<JSON::XS> or L<JSON::PP>.
  
  JSON::XS is the fastest and most proper JSON module on CPAN which must be
  compiled and installed in your environment.
  JSON::PP is a pure-Perl module which is bundled in this distribution and
  has a strong compatibility to JSON::XS.
  
  This module try to use JSON::XS by default and fail to it, use JSON::PP instead.
  So its features completely depend on JSON::XS or JSON::PP.
  
  See to L<BACKEND MODULE DECISION>.
  
  To distinguish the module name 'JSON' and the format type JSON,
  the former is quoted by CE<lt>E<gt> (its results vary with your using media),
  and the latter is left just as it is.
  
  Module name : C<JSON>
  
  Format type : JSON
  
  =head2 FEATURES
  
  =over
  
  =item * correct unicode handling
  
  This module (i.e. backend modules) knows how to handle Unicode, documents
  how and when it does so, and even documents what "correct" means.
  
  Even though there are limitations, this feature is available since Perl version 5.6.
  
  JSON::XS requires Perl 5.8.2 (but works correctly in 5.8.8 or later), so in older versions
  C<JSON> should call JSON::PP as the backend which can be used since Perl 5.005.
  
  With Perl 5.8.x JSON::PP works, but from 5.8.0 to 5.8.2, because of a Perl side problem,
  JSON::PP works slower in the versions. And in 5.005, the Unicode handling is not available.
  See to L<JSON::PP/UNICODE HANDLING ON PERLS> for more information.
  
  See also to L<JSON::XS/A FEW NOTES ON UNICODE AND PERL>
  and L<JSON::XS/ENCODING/CODESET_FLAG_NOTES>.
  
  
  =item * round-trip integrity
  
  When you serialise a perl data structure using only data types supported
  by JSON and Perl, the deserialised data structure is identical on the Perl
  level. (e.g. the string "2.0" doesn't suddenly become "2" just because
  it looks like a number). There I<are> minor exceptions to this, read the
  L</MAPPING> section below to learn about those.
  
  
  =item * strict checking of JSON correctness
  
  There is no guessing, no generating of illegal JSON texts by default,
  and only JSON is accepted as input by default (the latter is a security
  feature).
  
  See to L<JSON::XS/FEATURES> and L<JSON::PP/FEATURES>.
  
  =item * fast
  
  This module returns a JSON::XS object itself if available.
  Compared to other JSON modules and other serialisers such as Storable,
  JSON::XS usually compares favorably in terms of speed, too.
  
  If not available, C<JSON> returns a JSON::PP object instead of JSON::XS and
  it is very slow as pure-Perl.
  
  =item * simple to use
  
  This module has both a simple functional interface as well as an
  object oriented interface interface.
  
  =item * reasonably versatile output formats
  
  You can choose between the most compact guaranteed-single-line format possible
  (nice for simple line-based protocols), a pure-ASCII format (for when your transport
  is not 8-bit clean, still supports the whole Unicode range), or a pretty-printed
  format (for when you want to read that stuff). Or you can combine those features
  in whatever way you like.
  
  =back
  
  =head1 FUNCTIONAL INTERFACE
  
  Some documents are copied and modified from L<JSON::XS/FUNCTIONAL INTERFACE>.
  C<to_json> and C<from_json> are additional functions.
  
  =head2 encode_json
  
      $json_text = encode_json $perl_scalar
  
  Converts the given Perl data structure to a UTF-8 encoded, binary string.
  
  This function call is functionally identical to:
  
      $json_text = JSON->new->utf8->encode($perl_scalar)
  
  =head2 decode_json
  
      $perl_scalar = decode_json $json_text
  
  The opposite of C<encode_json>: expects an UTF-8 (binary) string and tries
  to parse that as an UTF-8 encoded JSON text, returning the resulting
  reference.
  
  This function call is functionally identical to:
  
      $perl_scalar = JSON->new->utf8->decode($json_text)
  
  
  =head2 to_json
  
     $json_text = to_json($perl_scalar)
  
  Converts the given Perl data structure to a json string.
  
  This function call is functionally identical to:
  
     $json_text = JSON->new->encode($perl_scalar)
  
  Takes a hash reference as the second.
  
     $json_text = to_json($perl_scalar, $flag_hashref)
  
  So,
  
     $json_text = to_json($perl_scalar, {utf8 => 1, pretty => 1})
  
  equivalent to:
  
     $json_text = JSON->new->utf8(1)->pretty(1)->encode($perl_scalar)
  
  If you want to write a modern perl code which communicates to outer world,
  you should use C<encode_json> (supposed that JSON data are encoded in UTF-8).
  
  =head2 from_json
  
     $perl_scalar = from_json($json_text)
  
  The opposite of C<to_json>: expects a json string and tries
  to parse it, returning the resulting reference.
  
  This function call is functionally identical to:
  
      $perl_scalar = JSON->decode($json_text)
  
  Takes a hash reference as the second.
  
      $perl_scalar = from_json($json_text, $flag_hashref)
  
  So,
  
      $perl_scalar = from_json($json_text, {utf8 => 1})
  
  equivalent to:
  
      $perl_scalar = JSON->new->utf8(1)->decode($json_text)
  
  If you want to write a modern perl code which communicates to outer world,
  you should use C<decode_json> (supposed that JSON data are encoded in UTF-8).
  
  =head2 JSON::is_bool
  
      $is_boolean = JSON::is_bool($scalar)
  
  Returns true if the passed scalar represents either JSON::true or
  JSON::false, two constants that act like C<1> and C<0> respectively
  and are also used to represent JSON C<true> and C<false> in Perl strings.
  
  =head2 JSON::true
  
  Returns JSON true value which is blessed object.
  It C<isa> JSON::Boolean object.
  
  =head2 JSON::false
  
  Returns JSON false value which is blessed object.
  It C<isa> JSON::Boolean object.
  
  =head2 JSON::null
  
  Returns C<undef>.
  
  See L<MAPPING>, below, for more information on how JSON values are mapped to
  Perl.
  
  =head1 HOW DO I DECODE A DATA FROM OUTER AND ENCODE TO OUTER
  
  This section supposes that your perl version is 5.8 or later.
  
  If you know a JSON text from an outer world - a network, a file content, and so on,
  is encoded in UTF-8, you should use C<decode_json> or C<JSON> module object
  with C<utf8> enable. And the decoded result will contain UNICODE characters.
  
    # from network
    my $json        = JSON->new->utf8;
    my $json_text   = CGI->new->param( 'json_data' );
    my $perl_scalar = $json->decode( $json_text );
    
    # from file content
    local $/;
    open( my $fh, '<', 'json.data' );
    $json_text   = <$fh>;
    $perl_scalar = decode_json( $json_text );
  
  If an outer data is not encoded in UTF-8, firstly you should C<decode> it.
  
    use Encode;
    local $/;
    open( my $fh, '<', 'json.data' );
    my $encoding = 'cp932';
    my $unicode_json_text = decode( $encoding, <$fh> ); # UNICODE
    
    # or you can write the below code.
    #
    # open( my $fh, "<:encoding($encoding)", 'json.data' );
    # $unicode_json_text = <$fh>;
  
  In this case, C<$unicode_json_text> is of course UNICODE string.
  So you B<cannot> use C<decode_json> nor C<JSON> module object with C<utf8> enable.
  Instead of them, you use C<JSON> module object with C<utf8> disable or C<from_json>.
  
    $perl_scalar = $json->utf8(0)->decode( $unicode_json_text );
    # or
    $perl_scalar = from_json( $unicode_json_text );
  
  Or C<encode 'utf8'> and C<decode_json>:
  
    $perl_scalar = decode_json( encode( 'utf8', $unicode_json_text ) );
    # this way is not efficient.
  
  And now, you want to convert your C<$perl_scalar> into JSON data and
  send it to an outer world - a network or a file content, and so on.
  
  Your data usually contains UNICODE strings and you want the converted data to be encoded
  in UTF-8, you should use C<encode_json> or C<JSON> module object with C<utf8> enable.
  
    print encode_json( $perl_scalar ); # to a network? file? or display?
    # or
    print $json->utf8->encode( $perl_scalar );
  
  If C<$perl_scalar> does not contain UNICODE but C<$encoding>-encoded strings
  for some reason, then its characters are regarded as B<latin1> for perl
  (because it does not concern with your $encoding).
  You B<cannot> use C<encode_json> nor C<JSON> module object with C<utf8> enable.
  Instead of them, you use C<JSON> module object with C<utf8> disable or C<to_json>.
  Note that the resulted text is a UNICODE string but no problem to print it.
  
    # $perl_scalar contains $encoding encoded string values
    $unicode_json_text = $json->utf8(0)->encode( $perl_scalar );
    # or 
    $unicode_json_text = to_json( $perl_scalar );
    # $unicode_json_text consists of characters less than 0x100
    print $unicode_json_text;
  
  Or C<decode $encoding> all string values and C<encode_json>:
  
    $perl_scalar->{ foo } = decode( $encoding, $perl_scalar->{ foo } );
    # ... do it to each string values, then encode_json
    $json_text = encode_json( $perl_scalar );
  
  This method is a proper way but probably not efficient.
  
  See to L<Encode>, L<perluniintro>.
  
  
  =head1 COMMON OBJECT-ORIENTED INTERFACE
  
  =head2 new
  
      $json = JSON->new
  
  Returns a new C<JSON> object inherited from either JSON::XS or JSON::PP
  that can be used to de/encode JSON strings.
  
  All boolean flags described below are by default I<disabled>.
  
  The mutators for flags all return the JSON object again and thus calls can
  be chained:
  
     my $json = JSON->new->utf8->space_after->encode({a => [1,2]})
     => {"a": [1, 2]}
  
  =head2 ascii
  
      $json = $json->ascii([$enable])
      
      $enabled = $json->get_ascii
  
  If $enable is true (or missing), then the encode method will not generate characters outside
  the code range 0..127. Any Unicode characters outside that range will be escaped using either
  a single \uXXXX or a double \uHHHH\uLLLLL escape sequence, as per RFC4627.
  
  If $enable is false, then the encode method will not escape Unicode characters unless
  required by the JSON syntax or other flags. This results in a faster and more compact format.
  
  This feature depends on the used Perl version and environment.
  
  See to L<JSON::PP/UNICODE HANDLING ON PERLS> if the backend is PP.
  
    JSON->new->ascii(1)->encode([chr 0x10401])
    => ["\ud801\udc01"]
  
  =head2 latin1
  
      $json = $json->latin1([$enable])
      
      $enabled = $json->get_latin1
  
  If $enable is true (or missing), then the encode method will encode the resulting JSON
  text as latin1 (or iso-8859-1), escaping any characters outside the code range 0..255.
  
  If $enable is false, then the encode method will not escape Unicode characters
  unless required by the JSON syntax or other flags.
  
    JSON->new->latin1->encode (["\x{89}\x{abc}"]
    => ["\x{89}\\u0abc"]    # (perl syntax, U+abc escaped, U+89 not)
  
  =head2 utf8
  
      $json = $json->utf8([$enable])
      
      $enabled = $json->get_utf8
  
  If $enable is true (or missing), then the encode method will encode the JSON result
  into UTF-8, as required by many protocols, while the decode method expects to be handled
  an UTF-8-encoded string. Please note that UTF-8-encoded strings do not contain any
  characters outside the range 0..255, they are thus useful for bytewise/binary I/O.
  
  In future versions, enabling this option might enable autodetection of the UTF-16 and UTF-32
  encoding families, as described in RFC4627.
  
  If $enable is false, then the encode method will return the JSON string as a (non-encoded)
  Unicode string, while decode expects thus a Unicode string. Any decoding or encoding
  (e.g. to UTF-8 or UTF-16) needs to be done yourself, e.g. using the Encode module.
  
  
  Example, output UTF-16BE-encoded JSON:
  
    use Encode;
    $jsontext = encode "UTF-16BE", JSON::XS->new->encode ($object);
  
  Example, decode UTF-32LE-encoded JSON:
  
    use Encode;
    $object = JSON::XS->new->decode (decode "UTF-32LE", $jsontext);
  
  See to L<JSON::PP/UNICODE HANDLING ON PERLS> if the backend is PP.
  
  
  =head2 pretty
  
      $json = $json->pretty([$enable])
  
  This enables (or disables) all of the C<indent>, C<space_before> and
  C<space_after> (and in the future possibly more) flags in one call to
  generate the most readable (or most compact) form possible.
  
  Equivalent to:
  
     $json->indent->space_before->space_after
  
  The indent space length is three and JSON::XS cannot change the indent
  space length.
  
  =head2 indent
  
      $json = $json->indent([$enable])
      
      $enabled = $json->get_indent
  
  If C<$enable> is true (or missing), then the C<encode> method will use a multiline
  format as output, putting every array member or object/hash key-value pair
  into its own line, identifying them properly.
  
  If C<$enable> is false, no newlines or indenting will be produced, and the
  resulting JSON text is guaranteed not to contain any C<newlines>.
  
  This setting has no effect when decoding JSON texts.
  
  The indent space length is three.
  With JSON::PP, you can also access C<indent_length> to change indent space length.
  
  
  =head2 space_before
  
      $json = $json->space_before([$enable])
      
      $enabled = $json->get_space_before
  
  If C<$enable> is true (or missing), then the C<encode> method will add an extra
  optional space before the C<:> separating keys from values in JSON objects.
  
  If C<$enable> is false, then the C<encode> method will not add any extra
  space at those places.
  
  This setting has no effect when decoding JSON texts.
  
  Example, space_before enabled, space_after and indent disabled:
  
     {"key" :"value"}
  
  
  =head2 space_after
  
      $json = $json->space_after([$enable])
      
      $enabled = $json->get_space_after
  
  If C<$enable> is true (or missing), then the C<encode> method will add an extra
  optional space after the C<:> separating keys from values in JSON objects
  and extra whitespace after the C<,> separating key-value pairs and array
  members.
  
  If C<$enable> is false, then the C<encode> method will not add any extra
  space at those places.
  
  This setting has no effect when decoding JSON texts.
  
  Example, space_before and indent disabled, space_after enabled:
  
     {"key": "value"}
  
  
  =head2 relaxed
  
      $json = $json->relaxed([$enable])
      
      $enabled = $json->get_relaxed
  
  If C<$enable> is true (or missing), then C<decode> will accept some
  extensions to normal JSON syntax (see below). C<encode> will not be
  affected in anyway. I<Be aware that this option makes you accept invalid
  JSON texts as if they were valid!>. I suggest only to use this option to
  parse application-specific files written by humans (configuration files,
  resource files etc.)
  
  If C<$enable> is false (the default), then C<decode> will only accept
  valid JSON texts.
  
  Currently accepted extensions are:
  
  =over 4
  
  =item * list items can have an end-comma
  
  JSON I<separates> array elements and key-value pairs with commas. This
  can be annoying if you write JSON texts manually and want to be able to
  quickly append elements, so this extension accepts comma at the end of
  such items not just between them:
  
     [
        1,
        2, <- this comma not normally allowed
     ]
     {
        "k1": "v1",
        "k2": "v2", <- this comma not normally allowed
     }
  
  =item * shell-style '#'-comments
  
  Whenever JSON allows whitespace, shell-style comments are additionally
  allowed. They are terminated by the first carriage-return or line-feed
  character, after which more white-space and comments are allowed.
  
    [
       1, # this comment not allowed in JSON
          # neither this one...
    ]
  
  =back
  
  
  =head2 canonical
  
      $json = $json->canonical([$enable])
      
      $enabled = $json->get_canonical
  
  If C<$enable> is true (or missing), then the C<encode> method will output JSON objects
  by sorting their keys. This is adding a comparatively high overhead.
  
  If C<$enable> is false, then the C<encode> method will output key-value
  pairs in the order Perl stores them (which will likely change between runs
  of the same script).
  
  This option is useful if you want the same data structure to be encoded as
  the same JSON text (given the same overall settings). If it is disabled,
  the same hash might be encoded differently even if contains the same data,
  as key-value pairs have no inherent ordering in Perl.
  
  This setting has no effect when decoding JSON texts.
  
  =head2 allow_nonref
  
      $json = $json->allow_nonref([$enable])
      
      $enabled = $json->get_allow_nonref
  
  If C<$enable> is true (or missing), then the C<encode> method can convert a
  non-reference into its corresponding string, number or null JSON value,
  which is an extension to RFC4627. Likewise, C<decode> will accept those JSON
  values instead of croaking.
  
  If C<$enable> is false, then the C<encode> method will croak if it isn't
  passed an arrayref or hashref, as JSON texts must either be an object
  or array. Likewise, C<decode> will croak if given something that is not a
  JSON object or array.
  
     JSON->new->allow_nonref->encode ("Hello, World!")
     => "Hello, World!"
  
  =head2 allow_unknown
  
      $json = $json->allow_unknown ([$enable])
      
      $enabled = $json->get_allow_unknown
  
  If $enable is true (or missing), then "encode" will *not* throw an
  exception when it encounters values it cannot represent in JSON (for
  example, filehandles) but instead will encode a JSON "null" value.
  Note that blessed objects are not included here and are handled
  separately by c<allow_nonref>.
  
  If $enable is false (the default), then "encode" will throw an
  exception when it encounters anything it cannot encode as JSON.
  
  This option does not affect "decode" in any way, and it is
  recommended to leave it off unless you know your communications
  partner.
  
  =head2 allow_blessed
  
      $json = $json->allow_blessed([$enable])
      
      $enabled = $json->get_allow_blessed
  
  If C<$enable> is true (or missing), then the C<encode> method will not
  barf when it encounters a blessed reference. Instead, the value of the
  B<convert_blessed> option will decide whether C<null> (C<convert_blessed>
  disabled or no C<TO_JSON> method found) or a representation of the
  object (C<convert_blessed> enabled and C<TO_JSON> method found) is being
  encoded. Has no effect on C<decode>.
  
  If C<$enable> is false (the default), then C<encode> will throw an
  exception when it encounters a blessed object.
  
  
  =head2 convert_blessed
  
      $json = $json->convert_blessed([$enable])
      
      $enabled = $json->get_convert_blessed
  
  If C<$enable> is true (or missing), then C<encode>, upon encountering a
  blessed object, will check for the availability of the C<TO_JSON> method
  on the object's class. If found, it will be called in scalar context
  and the resulting scalar will be encoded instead of the object. If no
  C<TO_JSON> method is found, the value of C<allow_blessed> will decide what
  to do.
  
  The C<TO_JSON> method may safely call die if it wants. If C<TO_JSON>
  returns other blessed objects, those will be handled in the same
  way. C<TO_JSON> must take care of not causing an endless recursion cycle
  (== crash) in this case. The name of C<TO_JSON> was chosen because other
  methods called by the Perl core (== not by the user of the object) are
  usually in upper case letters and to avoid collisions with the C<to_json>
  function or method.
  
  This setting does not yet influence C<decode> in any way.
  
  If C<$enable> is false, then the C<allow_blessed> setting will decide what
  to do when a blessed object is found.
  
  =over
  
  =item convert_blessed_universally mode
  
  If use C<JSON> with C<-convert_blessed_universally>, the C<UNIVERSAL::TO_JSON>
  subroutine is defined as the below code:
  
     *UNIVERSAL::TO_JSON = sub {
         my $b_obj = B::svref_2object( $_[0] );
         return    $b_obj->isa('B::HV') ? { %{ $_[0] } }
                 : $b_obj->isa('B::AV') ? [ @{ $_[0] } ]
                 : undef
                 ;
     }
  
  This will cause that C<encode> method converts simple blessed objects into
  JSON objects as non-blessed object.
  
     JSON -convert_blessed_universally;
     $json->allow_blessed->convert_blessed->encode( $blessed_object )
  
  This feature is experimental and may be removed in the future.
  
  =back
  
  =head2 filter_json_object
  
      $json = $json->filter_json_object([$coderef])
  
  When C<$coderef> is specified, it will be called from C<decode> each
  time it decodes a JSON object. The only argument passed to the coderef
  is a reference to the newly-created hash. If the code references returns
  a single scalar (which need not be a reference), this value
  (i.e. a copy of that scalar to avoid aliasing) is inserted into the
  deserialised data structure. If it returns an empty list
  (NOTE: I<not> C<undef>, which is a valid scalar), the original deserialised
  hash will be inserted. This setting can slow down decoding considerably.
  
  When C<$coderef> is omitted or undefined, any existing callback will
  be removed and C<decode> will not change the deserialised hash in any
  way.
  
  Example, convert all JSON objects into the integer 5:
  
     my $js = JSON->new->filter_json_object (sub { 5 });
     # returns [5]
     $js->decode ('[{}]'); # the given subroutine takes a hash reference.
     # throw an exception because allow_nonref is not enabled
     # so a lone 5 is not allowed.
     $js->decode ('{"a":1, "b":2}');
  
  
  =head2 filter_json_single_key_object
  
      $json = $json->filter_json_single_key_object($key [=> $coderef])
  
  Works remotely similar to C<filter_json_object>, but is only called for
  JSON objects having a single key named C<$key>.
  
  This C<$coderef> is called before the one specified via
  C<filter_json_object>, if any. It gets passed the single value in the JSON
  object. If it returns a single value, it will be inserted into the data
  structure. If it returns nothing (not even C<undef> but the empty list),
  the callback from C<filter_json_object> will be called next, as if no
  single-key callback were specified.
  
  If C<$coderef> is omitted or undefined, the corresponding callback will be
  disabled. There can only ever be one callback for a given key.
  
  As this callback gets called less often then the C<filter_json_object>
  one, decoding speed will not usually suffer as much. Therefore, single-key
  objects make excellent targets to serialise Perl objects into, especially
  as single-key JSON objects are as close to the type-tagged value concept
  as JSON gets (it's basically an ID/VALUE tuple). Of course, JSON does not
  support this in any way, so you need to make sure your data never looks
  like a serialised Perl hash.
  
  Typical names for the single object key are C<__class_whatever__>, or
  C<$__dollars_are_rarely_used__$> or C<}ugly_brace_placement>, or even
  things like C<__class_md5sum(classname)__>, to reduce the risk of clashing
  with real hashes.
  
  Example, decode JSON objects of the form C<< { "__widget__" => <id> } >>
  into the corresponding C<< $WIDGET{<id>} >> object:
  
     # return whatever is in $WIDGET{5}:
     JSON
        ->new
        ->filter_json_single_key_object (__widget__ => sub {
              $WIDGET{ $_[0] }
           })
        ->decode ('{"__widget__": 5')
  
     # this can be used with a TO_JSON method in some "widget" class
     # for serialisation to json:
     sub WidgetBase::TO_JSON {
        my ($self) = @_;
  
        unless ($self->{id}) {
           $self->{id} = ..get..some..id..;
           $WIDGET{$self->{id}} = $self;
        }
  
        { __widget__ => $self->{id} }
     }
  
  
  =head2 shrink
  
      $json = $json->shrink([$enable])
      
      $enabled = $json->get_shrink
  
  With JSON::XS, this flag resizes strings generated by either
  C<encode> or C<decode> to their minimum size possible. This can save
  memory when your JSON texts are either very very long or you have many
  short strings. It will also try to downgrade any strings to octet-form
  if possible: perl stores strings internally either in an encoding called
  UTF-X or in octet-form. The latter cannot store everything but uses less
  space in general (and some buggy Perl or C code might even rely on that
  internal representation being used).
  
  With JSON::PP, it is noop about resizing strings but tries
  C<utf8::downgrade> to the returned string by C<encode>. See to L<utf8>.
  
  See to L<JSON::XS/OBJECT-ORIENTED INTERFACE> and L<JSON::PP/METHODS>.
  
  =head2 max_depth
  
      $json = $json->max_depth([$maximum_nesting_depth])
      
      $max_depth = $json->get_max_depth
  
  Sets the maximum nesting level (default C<512>) accepted while encoding
  or decoding. If a higher nesting level is detected in JSON text or a Perl
  data structure, then the encoder and decoder will stop and croak at that
  point.
  
  Nesting level is defined by number of hash- or arrayrefs that the encoder
  needs to traverse to reach a given point or the number of C<{> or C<[>
  characters without their matching closing parenthesis crossed to reach a
  given character in a string.
  
  If no argument is given, the highest possible setting will be used, which
  is rarely useful.
  
  Note that nesting is implemented by recursion in C. The default value has
  been chosen to be as large as typical operating systems allow without
  crashing. (JSON::XS)
  
  With JSON::PP as the backend, when a large value (100 or more) was set and
  it de/encodes a deep nested object/text, it may raise a warning
  'Deep recursion on subroutine' at the perl runtime phase.
  
  See L<JSON::XS/SECURITY CONSIDERATIONS> for more info on why this is useful.
  
  =head2 max_size
  
      $json = $json->max_size([$maximum_string_size])
      
      $max_size = $json->get_max_size
  
  Set the maximum length a JSON text may have (in bytes) where decoding is
  being attempted. The default is C<0>, meaning no limit. When C<decode>
  is called on a string that is longer then this many bytes, it will not
  attempt to decode the string but throw an exception. This setting has no
  effect on C<encode> (yet).
  
  If no argument is given, the limit check will be deactivated (same as when
  C<0> is specified).
  
  See L<JSON::XS/SECURITY CONSIDERATIONS>, below, for more info on why this is useful.
  
  =head2 encode
  
      $json_text = $json->encode($perl_scalar)
  
  Converts the given Perl data structure (a simple scalar or a reference
  to a hash or array) to its JSON representation. Simple scalars will be
  converted into JSON string or number sequences, while references to arrays
  become JSON arrays and references to hashes become JSON objects. Undefined
  Perl values (e.g. C<undef>) become JSON C<null> values.
  References to the integers C<0> and C<1> are converted into C<true> and C<false>.
  
  =head2 decode
  
      $perl_scalar = $json->decode($json_text)
  
  The opposite of C<encode>: expects a JSON text and tries to parse it,
  returning the resulting simple scalar or reference. Croaks on error.
  
  JSON numbers and strings become simple Perl scalars. JSON arrays become
  Perl arrayrefs and JSON objects become Perl hashrefs. C<true> becomes
  C<1> (C<JSON::true>), C<false> becomes C<0> (C<JSON::false>) and
  C<null> becomes C<undef>.
  
  =head2 decode_prefix
  
      ($perl_scalar, $characters) = $json->decode_prefix($json_text)
  
  This works like the C<decode> method, but instead of raising an exception
  when there is trailing garbage after the first JSON object, it will
  silently stop parsing there and return the number of characters consumed
  so far.
  
     JSON->new->decode_prefix ("[1] the tail")
     => ([], 3)
  
  See to L<JSON::XS/OBJECT-ORIENTED INTERFACE>
  
  =head2 property
  
      $boolean = $json->property($property_name)
  
  Returns a boolean value about above some properties.
  
  The available properties are C<ascii>, C<latin1>, C<utf8>,
  C<indent>,C<space_before>, C<space_after>, C<relaxed>, C<canonical>,
  C<allow_nonref>, C<allow_unknown>, C<allow_blessed>, C<convert_blessed>,
  C<shrink>, C<max_depth> and C<max_size>.
  
     $boolean = $json->property('utf8');
      => 0
     $json->utf8;
     $boolean = $json->property('utf8');
      => 1
  
  Sets the property with a given boolean value.
  
      $json = $json->property($property_name => $boolean);
  
  With no argument, it returns all the above properties as a hash reference.
  
      $flag_hashref = $json->property();
  
  =head1 INCREMENTAL PARSING
  
  Most of this section are copied and modified from L<JSON::XS/INCREMENTAL PARSING>.
  
  In some cases, there is the need for incremental parsing of JSON texts.
  This module does allow you to parse a JSON stream incrementally.
  It does so by accumulating text until it has a full JSON object, which
  it then can decode. This process is similar to using C<decode_prefix>
  to see if a full JSON object is available, but is much more efficient
  (and can be implemented with a minimum of method calls).
  
  The backend module will only attempt to parse the JSON text once it is sure it
  has enough text to get a decisive result, using a very simple but
  truly incremental parser. This means that it sometimes won't stop as
  early as the full parser, for example, it doesn't detect parenthesis
  mismatches. The only thing it guarantees is that it starts decoding as
  soon as a syntactically valid JSON text has been seen. This means you need
  to set resource limits (e.g. C<max_size>) to ensure the parser will stop
  parsing in the presence if syntax errors.
  
  The following methods implement this incremental parser.
  
  =head2 incr_parse
  
      $json->incr_parse( [$string] ) # void context
      
      $obj_or_undef = $json->incr_parse( [$string] ) # scalar context
      
      @obj_or_empty = $json->incr_parse( [$string] ) # list context
  
  This is the central parsing function. It can both append new text and
  extract objects from the stream accumulated so far (both of these
  functions are optional).
  
  If C<$string> is given, then this string is appended to the already
  existing JSON fragment stored in the C<$json> object.
  
  After that, if the function is called in void context, it will simply
  return without doing anything further. This can be used to add more text
  in as many chunks as you want.
  
  If the method is called in scalar context, then it will try to extract
  exactly I<one> JSON object. If that is successful, it will return this
  object, otherwise it will return C<undef>. If there is a parse error,
  this method will croak just as C<decode> would do (one can then use
  C<incr_skip> to skip the erroneous part). This is the most common way of
  using the method.
  
  And finally, in list context, it will try to extract as many objects
  from the stream as it can find and return them, or the empty list
  otherwise. For this to work, there must be no separators between the JSON
  objects or arrays, instead they must be concatenated back-to-back. If
  an error occurs, an exception will be raised as in the scalar context
  case. Note that in this case, any previously-parsed JSON texts will be
  lost.
  
  Example: Parse some JSON arrays/objects in a given string and return them.
  
      my @objs = JSON->new->incr_parse ("[5][7][1,2]");
  
  =head2 incr_text
  
      $lvalue_string = $json->incr_text
  
  This method returns the currently stored JSON fragment as an lvalue, that
  is, you can manipulate it. This I<only> works when a preceding call to
  C<incr_parse> in I<scalar context> successfully returned an object. Under
  all other circumstances you must not call this function (I mean it.
  although in simple tests it might actually work, it I<will> fail under
  real world conditions). As a special exception, you can also call this
  method before having parsed anything.
  
  This function is useful in two cases: a) finding the trailing text after a
  JSON object or b) parsing multiple JSON objects separated by non-JSON text
  (such as commas).
  
      $json->incr_text =~ s/\s*,\s*//;
  
  In Perl 5.005, C<lvalue> attribute is not available.
  You must write codes like the below:
  
      $string = $json->incr_text;
      $string =~ s/\s*,\s*//;
      $json->incr_text( $string );
  
  =head2 incr_skip
  
      $json->incr_skip
  
  This will reset the state of the incremental parser and will remove the
  parsed text from the input buffer. This is useful after C<incr_parse>
  died, in which case the input buffer and incremental parser state is left
  unchanged, to skip the text parsed so far and to reset the parse state.
  
  =head2 incr_reset
  
      $json->incr_reset
  
  This completely resets the incremental parser, that is, after this call,
  it will be as if the parser had never parsed anything.
  
  This is useful if you want to repeatedly parse JSON objects and want to
  ignore any trailing data, which means you have to reset the parser after
  each successful decode.
  
  See to L<JSON::XS/INCREMENTAL PARSING> for examples.
  
  
  =head1 JSON::PP SUPPORT METHODS
  
  The below methods are JSON::PP own methods, so when C<JSON> works
  with JSON::PP (i.e. the created object is a JSON::PP object), available.
  See to L<JSON::PP/JSON::PP OWN METHODS> in detail.
  
  If you use C<JSON> with additional C<-support_by_pp>, some methods
  are available even with JSON::XS. See to L<USE PP FEATURES EVEN THOUGH XS BACKEND>.
  
     BEING { $ENV{PERL_JSON_BACKEND} = 'JSON::XS' }
     
     use JSON -support_by_pp;
     
     my $json = JSON->new;
     $json->allow_nonref->escape_slash->encode("/");
  
     # functional interfaces too.
     print to_json(["/"], {escape_slash => 1});
     print from_json('["foo"]', {utf8 => 1});
  
  If you do not want to all functions but C<-support_by_pp>,
  use C<-no_export>.
  
     use JSON -support_by_pp, -no_export;
     # functional interfaces are not exported.
  
  =head2 allow_singlequote
  
      $json = $json->allow_singlequote([$enable])
  
  If C<$enable> is true (or missing), then C<decode> will accept
  any JSON strings quoted by single quotations that are invalid JSON
  format.
  
      $json->allow_singlequote->decode({"foo":'bar'});
      $json->allow_singlequote->decode({'foo':"bar"});
      $json->allow_singlequote->decode({'foo':'bar'});
  
  As same as the C<relaxed> option, this option may be used to parse
  application-specific files written by humans.
  
  =head2 allow_barekey
  
      $json = $json->allow_barekey([$enable])
  
  If C<$enable> is true (or missing), then C<decode> will accept
  bare keys of JSON object that are invalid JSON format.
  
  As same as the C<relaxed> option, this option may be used to parse
  application-specific files written by humans.
  
      $json->allow_barekey->decode('{foo:"bar"}');
  
  =head2 allow_bignum
  
      $json = $json->allow_bignum([$enable])
  
  If C<$enable> is true (or missing), then C<decode> will convert
  the big integer Perl cannot handle as integer into a L<Math::BigInt>
  object and convert a floating number (any) into a L<Math::BigFloat>.
  
  On the contrary, C<encode> converts C<Math::BigInt> objects and C<Math::BigFloat>
  objects into JSON numbers with C<allow_blessed> enable.
  
     $json->allow_nonref->allow_blessed->allow_bignum;
     $bigfloat = $json->decode('2.000000000000000000000000001');
     print $json->encode($bigfloat);
     # => 2.000000000000000000000000001
  
  See to L<MAPPING> about the conversion of JSON number.
  
  =head2 loose
  
      $json = $json->loose([$enable])
  
  The unescaped [\x00-\x1f\x22\x2f\x5c] strings are invalid in JSON strings
  and the module doesn't allow to C<decode> to these (except for \x2f).
  If C<$enable> is true (or missing), then C<decode>  will accept these
  unescaped strings.
  
      $json->loose->decode(qq|["abc
                                     def"]|);
  
  See to L<JSON::PP/JSON::PP OWN METHODS>.
  
  =head2 escape_slash
  
      $json = $json->escape_slash([$enable])
  
  According to JSON Grammar, I<slash> (U+002F) is escaped. But by default
  JSON backend modules encode strings without escaping slash.
  
  If C<$enable> is true (or missing), then C<encode> will escape slashes.
  
  =head2 indent_length
  
      $json = $json->indent_length($length)
  
  With JSON::XS, The indent space length is 3 and cannot be changed.
  With JSON::PP, it sets the indent space length with the given $length.
  The default is 3. The acceptable range is 0 to 15.
  
  =head2 sort_by
  
      $json = $json->sort_by($function_name)
      $json = $json->sort_by($subroutine_ref)
  
  If $function_name or $subroutine_ref are set, its sort routine are used.
  
     $js = $pc->sort_by(sub { $JSON::PP::a cmp $JSON::PP::b })->encode($obj);
     # is($js, q|{"a":1,"b":2,"c":3,"d":4,"e":5,"f":6,"g":7,"h":8,"i":9}|);
  
     $js = $pc->sort_by('own_sort')->encode($obj);
     # is($js, q|{"a":1,"b":2,"c":3,"d":4,"e":5,"f":6,"g":7,"h":8,"i":9}|);
  
     sub JSON::PP::own_sort { $JSON::PP::a cmp $JSON::PP::b }
  
  As the sorting routine runs in the JSON::PP scope, the given
  subroutine name and the special variables C<$a>, C<$b> will begin
  with 'JSON::PP::'.
  
  If $integer is set, then the effect is same as C<canonical> on.
  
  See to L<JSON::PP/JSON::PP OWN METHODS>.
  
  =head1 MAPPING
  
  This section is copied from JSON::XS and modified to C<JSON>.
  JSON::XS and JSON::PP mapping mechanisms are almost equivalent.
  
  See to L<JSON::XS/MAPPING>.
  
  =head2 JSON -> PERL
  
  =over 4
  
  =item object
  
  A JSON object becomes a reference to a hash in Perl. No ordering of object
  keys is preserved (JSON does not preserver object key ordering itself).
  
  =item array
  
  A JSON array becomes a reference to an array in Perl.
  
  =item string
  
  A JSON string becomes a string scalar in Perl - Unicode codepoints in JSON
  are represented by the same codepoints in the Perl string, so no manual
  decoding is necessary.
  
  =item number
  
  A JSON number becomes either an integer, numeric (floating point) or
  string scalar in perl, depending on its range and any fractional parts. On
  the Perl level, there is no difference between those as Perl handles all
  the conversion details, but an integer may take slightly less memory and
  might represent more values exactly than floating point numbers.
  
  If the number consists of digits only, C<JSON> will try to represent
  it as an integer value. If that fails, it will try to represent it as
  a numeric (floating point) value if that is possible without loss of
  precision. Otherwise it will preserve the number as a string value (in
  which case you lose roundtripping ability, as the JSON number will be
  re-encoded to a JSON string).
  
  Numbers containing a fractional or exponential part will always be
  represented as numeric (floating point) values, possibly at a loss of
  precision (in which case you might lose perfect roundtripping ability, but
  the JSON number will still be re-encoded as a JSON number).
  
  Note that precision is not accuracy - binary floating point values cannot
  represent most decimal fractions exactly, and when converting from and to
  floating point, C<JSON> only guarantees precision up to but not including
  the least significant bit.
  
  If the backend is JSON::PP and C<allow_bignum> is enable, the big integers 
  and the numeric can be optionally converted into L<Math::BigInt> and
  L<Math::BigFloat> objects.
  
  =item true, false
  
  These JSON atoms become C<JSON::true> and C<JSON::false>,
  respectively. They are overloaded to act almost exactly like the numbers
  C<1> and C<0>. You can check whether a scalar is a JSON boolean by using
  the C<JSON::is_bool> function.
  
     print JSON::true + 1;
      => 1
  
     ok(JSON::true eq  '1');
     ok(JSON::true == 1);
  
  C<JSON> will install these missing overloading features to the backend modules.
  
  
  =item null
  
  A JSON null atom becomes C<undef> in Perl.
  
  C<JSON::null> returns C<undef>.
  
  =back
  
  
  =head2 PERL -> JSON
  
  The mapping from Perl to JSON is slightly more difficult, as Perl is a
  truly typeless language, so we can only guess which JSON type is meant by
  a Perl value.
  
  =over 4
  
  =item hash references
  
  Perl hash references become JSON objects. As there is no inherent ordering
  in hash keys (or JSON objects), they will usually be encoded in a
  pseudo-random order that can change between runs of the same program but
  stays generally the same within a single run of a program. C<JSON>
  optionally sort the hash keys (determined by the I<canonical> flag), so
  the same data structure will serialise to the same JSON text (given same
  settings and version of JSON::XS), but this incurs a runtime overhead
  and is only rarely useful, e.g. when you want to compare some JSON text
  against another for equality.
  
  In future, the ordered object feature will be added to JSON::PP using C<tie> mechanism.
  
  
  =item array references
  
  Perl array references become JSON arrays.
  
  =item other references
  
  Other unblessed references are generally not allowed and will cause an
  exception to be thrown, except for references to the integers C<0> and
  C<1>, which get turned into C<false> and C<true> atoms in JSON. You can
  also use C<JSON::false> and C<JSON::true> to improve readability.
  
     to_json [\0,JSON::true]      # yields [false,true]
  
  =item JSON::true, JSON::false, JSON::null
  
  These special values become JSON true and JSON false values,
  respectively. You can also use C<\1> and C<\0> directly if you want.
  
  JSON::null returns C<undef>.
  
  =item blessed objects
  
  Blessed objects are not directly representable in JSON. See the
  C<allow_blessed> and C<convert_blessed> methods on various options on
  how to deal with this: basically, you can choose between throwing an
  exception, encoding the reference as if it weren't blessed, or provide
  your own serialiser method.
  
  With C<convert_blessed_universally> mode,  C<encode> converts blessed
  hash references or blessed array references (contains other blessed references)
  into JSON members and arrays.
  
     use JSON -convert_blessed_universally;
     JSON->new->allow_blessed->convert_blessed->encode( $blessed_object );
  
  See to L<convert_blessed>.
  
  =item simple scalars
  
  Simple Perl scalars (any scalar that is not a reference) are the most
  difficult objects to encode: JSON::XS and JSON::PP will encode undefined scalars as
  JSON C<null> values, scalars that have last been used in a string context
  before encoding as JSON strings, and anything else as number value:
  
     # dump as number
     encode_json [2]                      # yields [2]
     encode_json [-3.0e17]                # yields [-3e+17]
     my $value = 5; encode_json [$value]  # yields [5]
  
     # used as string, so dump as string
     print $value;
     encode_json [$value]                 # yields ["5"]
  
     # undef becomes null
     encode_json [undef]                  # yields [null]
  
  You can force the type to be a string by stringifying it:
  
     my $x = 3.1; # some variable containing a number
     "$x";        # stringified
     $x .= "";    # another, more awkward way to stringify
     print $x;    # perl does it for you, too, quite often
  
  You can force the type to be a number by numifying it:
  
     my $x = "3"; # some variable containing a string
     $x += 0;     # numify it, ensuring it will be dumped as a number
     $x *= 1;     # same thing, the choice is yours.
  
  You can not currently force the type in other, less obscure, ways.
  
  Note that numerical precision has the same meaning as under Perl (so
  binary to decimal conversion follows the same rules as in Perl, which
  can differ to other languages). Also, your perl interpreter might expose
  extensions to the floating point numbers of your platform, such as
  infinities or NaN's - these cannot be represented in JSON, and it is an
  error to pass those in.
  
  =item Big Number
  
  If the backend is JSON::PP and C<allow_bignum> is enable, 
  C<encode> converts C<Math::BigInt> objects and C<Math::BigFloat>
  objects into JSON numbers.
  
  
  =back
  
  =head1 JSON and ECMAscript
  
  See to L<JSON::XS/JSON and ECMAscript>.
  
  =head1 JSON and YAML
  
  JSON is not a subset of YAML.
  See to L<JSON::XS/JSON and YAML>.
  
  
  =head1 BACKEND MODULE DECISION
  
  When you use C<JSON>, C<JSON> tries to C<use> JSON::XS. If this call failed, it will
  C<uses> JSON::PP. The required JSON::XS version is I<2.2> or later.
  
  The C<JSON> constructor method returns an object inherited from the backend module,
  and JSON::XS object is a blessed scalar reference while JSON::PP is a blessed hash
  reference.
  
  So, your program should not depend on the backend module, especially
  returned objects should not be modified.
  
   my $json = JSON->new; # XS or PP?
   $json->{stash} = 'this is xs object'; # this code may raise an error!
  
  To check the backend module, there are some methods - C<backend>, C<is_pp> and C<is_xs>.
  
    JSON->backend; # 'JSON::XS' or 'JSON::PP'
    
    JSON->backend->is_pp: # 0 or 1
    
    JSON->backend->is_xs: # 1 or 0
    
    $json->is_xs; # 1 or 0
    
    $json->is_pp; # 0 or 1
  
  
  If you set an environment variable C<PERL_JSON_BACKEND>, the calling action will be changed.
  
  =over
  
  =item PERL_JSON_BACKEND = 0 or PERL_JSON_BACKEND = 'JSON::PP'
  
  Always use JSON::PP
  
  =item PERL_JSON_BACKEND == 1 or PERL_JSON_BACKEND = 'JSON::XS,JSON::PP'
  
  (The default) Use compiled JSON::XS if it is properly compiled & installed,
  otherwise use JSON::PP.
  
  =item PERL_JSON_BACKEND == 2 or PERL_JSON_BACKEND = 'JSON::XS'
  
  Always use compiled JSON::XS, die if it isn't properly compiled & installed.
  
  =item PERL_JSON_BACKEND = 'JSON::backportPP'
  
  Always use JSON::backportPP.
  JSON::backportPP is JSON::PP back port module.
  C<JSON> includes JSON::backportPP instead of JSON::PP.
  
  =back
  
  These ideas come from L<DBI::PurePerl> mechanism.
  
  example:
  
   BEGIN { $ENV{PERL_JSON_BACKEND} = 'JSON::PP' }
   use JSON; # always uses JSON::PP
  
  In future, it may be able to specify another module.
  
  =head1 USE PP FEATURES EVEN THOUGH XS BACKEND
  
  Many methods are available with either JSON::XS or JSON::PP and
  when the backend module is JSON::XS, if any JSON::PP specific (i.e. JSON::XS unsupported)
  method is called, it will C<warn> and be noop.
  
  But If you C<use> C<JSON> passing the optional string C<-support_by_pp>,
  it makes a part of those unsupported methods available.
  This feature is achieved by using JSON::PP in C<de/encode>.
  
     BEGIN { $ENV{PERL_JSON_BACKEND} = 2 } # with JSON::XS
     use JSON -support_by_pp;
     my $json = JSON->new;
     $json->allow_nonref->escape_slash->encode("/");
  
  At this time, the returned object is a C<JSON::Backend::XS::Supportable>
  object (re-blessed XS object), and  by checking JSON::XS unsupported flags
  in de/encoding, can support some unsupported methods - C<loose>, C<allow_bignum>,
  C<allow_barekey>, C<allow_singlequote>, C<escape_slash> and C<indent_length>.
  
  When any unsupported methods are not enable, C<XS de/encode> will be
  used as is. The switch is achieved by changing the symbolic tables.
  
  C<-support_by_pp> is effective only when the backend module is JSON::XS
  and it makes the de/encoding speed down a bit.
  
  See to L<JSON::PP SUPPORT METHODS>.
  
  =head1 INCOMPATIBLE CHANGES TO OLD VERSION
  
  There are big incompatibility between new version (2.00) and old (1.xx).
  If you use old C<JSON> 1.xx in your code, please check it.
  
  See to L<Transition ways from 1.xx to 2.xx.>
  
  =over
  
  =item jsonToObj and objToJson are obsoleted.
  
  Non Perl-style name C<jsonToObj> and C<objToJson> are obsoleted
  (but not yet deleted from the source).
  If you use these functions in your code, please replace them
  with C<from_json> and C<to_json>.
  
  
  =item Global variables are no longer available.
  
  C<JSON> class variables - C<$JSON::AUTOCONVERT>, C<$JSON::BareKey>, etc...
  - are not available any longer.
  Instead, various features can be used through object methods.
  
  
  =item Package JSON::Converter and JSON::Parser are deleted.
  
  Now C<JSON> bundles with JSON::PP which can handle JSON more properly than them.
  
  =item Package JSON::NotString is deleted.
  
  There was C<JSON::NotString> class which represents JSON value C<true>, C<false>, C<null>
  and numbers. It was deleted and replaced by C<JSON::Boolean>.
  
  C<JSON::Boolean> represents C<true> and C<false>.
  
  C<JSON::Boolean> does not represent C<null>.
  
  C<JSON::null> returns C<undef>.
  
  C<JSON> makes L<JSON::XS::Boolean> and L<JSON::PP::Boolean> is-a relation
  to L<JSON::Boolean>.
  
  =item function JSON::Number is obsoleted.
  
  C<JSON::Number> is now needless because JSON::XS and JSON::PP have
  round-trip integrity.
  
  =item JSONRPC modules are deleted.
  
  Perl implementation of JSON-RPC protocol - C<JSONRPC >, C<JSONRPC::Transport::HTTP>
  and C<Apache::JSONRPC > are deleted in this distribution.
  Instead of them, there is L<JSON::RPC> which supports JSON-RPC protocol version 1.1.
  
  =back
  
  =head2 Transition ways from 1.xx to 2.xx.
  
  You should set C<suport_by_pp> mode firstly, because
  it is always successful for the below codes even with JSON::XS.
  
      use JSON -support_by_pp;
  
  =over
  
  =item Exported jsonToObj (simple)
  
    from_json($json_text);
  
  =item Exported objToJson (simple)
  
    to_json($perl_scalar);
  
  =item Exported jsonToObj (advanced)
  
    $flags = {allow_barekey => 1, allow_singlequote => 1};
    from_json($json_text, $flags);
  
  equivalent to:
  
    $JSON::BareKey = 1;
    $JSON::QuotApos = 1;
    jsonToObj($json_text);
  
  =item Exported objToJson (advanced)
  
    $flags = {allow_blessed => 1, allow_barekey => 1};
    to_json($perl_scalar, $flags);
  
  equivalent to:
  
    $JSON::BareKey = 1;
    objToJson($perl_scalar);
  
  =item jsonToObj as object method
  
    $json->decode($json_text);
  
  =item objToJson as object method
  
    $json->encode($perl_scalar);
  
  =item new method with parameters
  
  The C<new> method in 2.x takes any parameters no longer.
  You can set parameters instead;
  
     $json = JSON->new->pretty;
  
  =item $JSON::Pretty, $JSON::Indent, $JSON::Delimiter
  
  If C<indent> is enable, that means C<$JSON::Pretty> flag set. And
  C<$JSON::Delimiter> was substituted by C<space_before> and C<space_after>.
  In conclusion:
  
     $json->indent->space_before->space_after;
  
  Equivalent to:
  
    $json->pretty;
  
  To change indent length, use C<indent_length>.
  
  (Only with JSON::PP, if C<-support_by_pp> is not used.)
  
    $json->pretty->indent_length(2)->encode($perl_scalar);
  
  =item $JSON::BareKey
  
  (Only with JSON::PP, if C<-support_by_pp> is not used.)
  
    $json->allow_barekey->decode($json_text)
  
  =item $JSON::ConvBlessed
  
  use C<-convert_blessed_universally>. See to L<convert_blessed>.
  
  =item $JSON::QuotApos
  
  (Only with JSON::PP, if C<-support_by_pp> is not used.)
  
    $json->allow_singlequote->decode($json_text)
  
  =item $JSON::SingleQuote
  
  Disable. C<JSON> does not make such a invalid JSON string any longer.
  
  =item $JSON::KeySort
  
    $json->canonical->encode($perl_scalar)
  
  This is the ascii sort.
  
  If you want to use with your own sort routine, check the C<sort_by> method.
  
  (Only with JSON::PP, even if C<-support_by_pp> is used currently.)
  
    $json->sort_by($sort_routine_ref)->encode($perl_scalar)
   
    $json->sort_by(sub { $JSON::PP::a <=> $JSON::PP::b })->encode($perl_scalar)
  
  Can't access C<$a> and C<$b> but C<$JSON::PP::a> and C<$JSON::PP::b>.
  
  =item $JSON::SkipInvalid
  
    $json->allow_unknown
  
  =item $JSON::AUTOCONVERT
  
  Needless. C<JSON> backend modules have the round-trip integrity.
  
  =item $JSON::UTF8
  
  Needless because C<JSON> (JSON::XS/JSON::PP) sets
  the UTF8 flag on properly.
  
      # With UTF8-flagged strings
  
      $json->allow_nonref;
      $str = chr(1000); # UTF8-flagged
  
      $json_text  = $json->utf8(0)->encode($str);
      utf8::is_utf8($json_text);
      # true
      $json_text  = $json->utf8(1)->encode($str);
      utf8::is_utf8($json_text);
      # false
  
      $str = '"' . chr(1000) . '"'; # UTF8-flagged
  
      $perl_scalar  = $json->utf8(0)->decode($str);
      utf8::is_utf8($perl_scalar);
      # true
      $perl_scalar  = $json->utf8(1)->decode($str);
      # died because of 'Wide character in subroutine'
  
  See to L<JSON::XS/A FEW NOTES ON UNICODE AND PERL>.
  
  =item $JSON::UnMapping
  
  Disable. See to L<MAPPING>.
  
  =item $JSON::SelfConvert
  
  This option was deleted.
  Instead of it, if a given blessed object has the C<TO_JSON> method,
  C<TO_JSON> will be executed with C<convert_blessed>.
  
    $json->convert_blessed->encode($blessed_hashref_or_arrayref)
    # if need, call allow_blessed
  
  Note that it was C<toJson> in old version, but now not C<toJson> but C<TO_JSON>.
  
  =back
  
  =head1 TODO
  
  =over
  
  =item example programs
  
  =back
  
  =head1 THREADS
  
  No test with JSON::PP. If with JSON::XS, See to L<JSON::XS/THREADS>.
  
  
  =head1 BUGS
  
  Please report bugs relevant to C<JSON> to E<lt>makamaka[at]cpan.orgE<gt>.
  
  
  =head1 SEE ALSO
  
  Most of the document is copied and modified from JSON::XS doc.
  
  L<JSON::XS>, L<JSON::PP>
  
  C<RFC4627>(L<http://www.ietf.org/rfc/rfc4627.txt>)
  
  =head1 AUTHOR
  
  Makamaka Hannyaharamitu, E<lt>makamaka[at]cpan.orgE<gt>
  
  JSON::XS was written by  Marc Lehmann <schmorp[at]schmorp.de>
  
  The release of this new version owes to the courtesy of Marc Lehmann.
  
  
  =head1 COPYRIGHT AND LICENSE
  
  Copyright 2005-2013 by Makamaka Hannyaharamitu
  
  This library is free software; you can redistribute it and/or modify
  it under the same terms as Perl itself. 
  
  =cut
  
JSON

$fatpacked{"LWP/MediaTypes.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'LWP_MEDIATYPES';
  package LWP::MediaTypes;
  
  require Exporter;
  @ISA = qw(Exporter);
  @EXPORT = qw(guess_media_type media_suffix);
  @EXPORT_OK = qw(add_type add_encoding read_media_types);
  $VERSION = "6.02";
  
  use strict;
  
  
  my %suffixType = (
      'txt'   => 'text/plain',
      'html'  => 'text/html',
      'gif'   => 'image/gif',
      'jpg'   => 'image/jpeg',
      'xml'   => 'text/xml',
  );
  
  my %suffixExt = (
      'text/plain' => 'txt',
      'text/html'  => 'html',
      'image/gif'  => 'gif',
      'image/jpeg' => 'jpg',
      'text/xml'   => 'xml',
  );
  
  my %suffixEncoding = (
      'Z'   => 'compress',
      'gz'  => 'gzip',
      'hqx' => 'x-hqx',
      'uu'  => 'x-uuencode',
      'z'   => 'x-pack',
      'bz2' => 'x-bzip2',
  );
  
  read_media_types();
  
  
  
  sub guess_media_type
  {
      my($file, $header) = @_;
      return undef unless defined $file;
  
      my $fullname;
      if (ref($file)) {
  	$file = $file->path;
      }
      else {
  	$fullname = $file;  
      }
  
      my @encoding = ();
      my $ct = undef;
      for (file_exts($file)) {
  	if (exists $suffixEncoding{$_}) {
  	    unshift(@encoding, $suffixEncoding{$_});
  	    next;
  	}
  	if (exists $suffixEncoding{lc $_}) {
  	    unshift(@encoding, $suffixEncoding{lc $_});
  	    next;
  	}
  
  	if (exists $suffixType{$_}) {
  	    $ct = $suffixType{$_};
  	    last;
  	}
  	if (exists $suffixType{lc $_}) {
  	    $ct = $suffixType{lc $_};
  	    last;
  	}
  
  	last;
      }
      unless (defined $ct) {
  	if (defined $fullname) {
  	    $ct = (-T $fullname) ? "text/plain" : "application/octet-stream";
  	}
  	else {
  	    $ct = "application/octet-stream";
  	}
      }
  
      if ($header) {
  	$header->header('Content-Type' => $ct);
  	$header->header('Content-Encoding' => \@encoding) if @encoding;
      }
  
      wantarray ? ($ct, @encoding) : $ct;
  }
  
  
  sub media_suffix {
      if (!wantarray && @_ == 1 && $_[0] !~ /\*/) {
  	return $suffixExt{lc $_[0]};
      }
      my(@type) = @_;
      my(@suffix, $ext, $type);
      foreach (@type) {
  	if (s/\*/.*/) {
  	    while(($ext,$type) = each(%suffixType)) {
  		push(@suffix, $ext) if $type =~ /^$_$/i;
  	    }
  	}
  	else {
  	    my $ltype = lc $_;
  	    while(($ext,$type) = each(%suffixType)) {
  		push(@suffix, $ext) if lc $type eq $ltype;
  	    }
  	}
      }
      wantarray ? @suffix : $suffix[0];
  }
  
  
  sub file_exts 
  {
      require File::Basename;
      my @parts = reverse split(/\./, File::Basename::basename($_[0]));
      pop(@parts);        
      @parts;
  }
  
  
  sub add_type 
  {
      my($type, @exts) = @_;
      for my $ext (@exts) {
  	$ext =~ s/^\.//;
  	$suffixType{$ext} = $type;
      }
      $suffixExt{lc $type} = $exts[0] if @exts;
  }
  
  
  sub add_encoding
  {
      my($type, @exts) = @_;
      for my $ext (@exts) {
  	$ext =~ s/^\.//;
  	$suffixEncoding{$ext} = $type;
      }
  }
  
  
  sub read_media_types 
  {
      my(@files) = @_;
  
      local($/, $_) = ("\n", undef);  
  
      my @priv_files = ();
      push(@priv_files, "$ENV{HOME}/.media.types", "$ENV{HOME}/.mime.types")
  	if defined $ENV{HOME};  
  
      my $typefile;
      unless (@files) {
  	@files = map {"$_/LWP/media.types"} @INC;
  	push @files, @priv_files;
      }
      for $typefile (@files) {
  	local(*TYPE);
  	open(TYPE, $typefile) || next;
  	while (<TYPE>) {
  	    next if /^\s*#/; 
  	    next if /^\s*$/; 
  	    s/#.*//;         
  	    my($type, @exts) = split(' ', $_);
  	    add_type($type, @exts);
  	}
  	close(TYPE);
      }
  }
  
  1;
  
  
  __END__
  
LWP_MEDIATYPES

$fatpacked{"Lingua/EN/Numbers/Ordinate.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'LINGUA_EN_NUMBERS_ORDINATE';
  package Lingua::EN::Numbers::Ordinate;
  $Lingua::EN::Numbers::Ordinate::VERSION = '1.03';
  
  use 5.006;
  use strict;
  use warnings;
  require Exporter;
  
  our @ISA        = qw/ Exporter  /;
  our @EXPORT     = qw/ ordinate  /;
  our @EXPORT_OK  = qw/ ordsuf th /;
  
  
  
  
  sub ordsuf ($) {
    return 'th' if not(defined($_[0])) or not( 0 + $_[0] );
    my $n = abs($_[0]);  
    return 'th' unless $n == int($n); 
    $n %= 100;
    return 'th' if $n == 11 or $n == 12 or $n == 13;
    $n %= 10;
    return 'st' if $n == 1; 
    return 'nd' if $n == 2;
    return 'rd' if $n == 3;
    return 'th';
  }
  
  sub ordinate ($) {
    my $i = $_[0] || 0;
    return $i . ordsuf($i);
  }
  
  no warnings 'all';
  *th = \&ordinate; 
  
  1;
  
  __END__
LINGUA_EN_NUMBERS_ORDINATE

$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.412';
  }
  
  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.412';
  
  
  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.412';
  
      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/File.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'LOG_ANY_ADAPTER_FILE';
  use 5.008001;
  use strict;
  use warnings;
  
  package Log::Any::Adapter::File;
  
  our $VERSION = '1.032';
  
  use Config;
  use Fcntl qw/:flock/;
  use IO::File;
  use Log::Any::Adapter::Util ();
  
  use base qw/Log::Any::Adapter::Base/;
  
  my $HAS_FLOCK = $Config{d_flock} || $Config{d_fcntl_can_lock} || $Config{d_lockf};
  
  my $trace_level = Log::Any::Adapter::Util::numeric_level('trace');
  sub new {
      my ( $class, $file, @args ) = @_;
      return $class->SUPER::new( file => $file, log_level => $trace_level, @args );
  }
  
  sub init {
      my $self = shift;
      if ( exists $self->{log_level} ) {
          $self->{log_level} = Log::Any::Adapter::Util::numeric_level( $self->{log_level} )
              unless $self->{log_level} =~ /^\d+$/;
      }
      else {
          $self->{log_level} = $trace_level;
      }
      my $file = $self->{file};
      open( $self->{fh}, ">>", $file )
        or die "cannot open '$file' for append: $!";
      $self->{fh}->autoflush(1);
  }
  
  foreach my $method ( Log::Any::Adapter::Util::logging_methods() ) {
      no strict 'refs';
      my $method_level = Log::Any::Adapter::Util::numeric_level( $method );
      *{$method} = sub {
          my ( $self, $text ) = @_;
          return if $method_level > $self->{log_level};
          my $msg = sprintf( "[%s] %s\n", scalar(localtime), $text );
          flock($self->{fh}, LOCK_EX) if $HAS_FLOCK;
          $self->{fh}->print($msg);
          flock($self->{fh}, LOCK_UN) if $HAS_FLOCK;
        }
  }
  
  foreach my $method ( Log::Any::Adapter::Util::detection_methods() ) {
      no strict 'refs';
      my $base = substr($method,3);
      my $method_level = Log::Any::Adapter::Util::numeric_level( $base );
      *{$method} = sub {
          return !!(  $method_level <= $_[0]->{log_level} );
      };
  }
  
  1;
  
  __END__
  
LOG_ANY_ADAPTER_FILE

$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/Screen.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'LOG_ANY_ADAPTER_SCREEN';
  package Log::Any::Adapter::Screen;
  
  our $DATE = '2015-06-19'; 
  our $VERSION = '0.09'; 
  
  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;
  use Time::HiRes qw(time);
  
  my $Time0 = time();
  
  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->{formatter} //= sub {
          my ($self, $msg) = @_;
          my $env = $ENV{LOG_PREFIX} // '';
          if ($env eq 'elapsed') {
              my $time = time();
              $msg = sprintf("[%9.3fms] %s", ($time - $Time0)*1000, $msg);
          }
          $msg;
      };
      $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_SCREEN

$fatpacked{"Log/Any/Adapter/Stderr.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'LOG_ANY_ADAPTER_STDERR';
  use 5.008001;
  use strict;
  use warnings;
  
  package Log::Any::Adapter::Stderr;
  
  our $VERSION = '1.032';
  
  use Log::Any::Adapter::Util ();
  
  use base qw/Log::Any::Adapter::Base/;
  
  my $trace_level = Log::Any::Adapter::Util::numeric_level('trace');
  
  sub init {
      my ($self) = @_;
      if ( exists $self->{log_level} ) {
          $self->{log_level} =
            Log::Any::Adapter::Util::numeric_level( $self->{log_level} )
            unless $self->{log_level} =~ /^\d+$/;
      }
      else {
          $self->{log_level} = $trace_level;
      }
  }
  
  foreach my $method ( Log::Any::Adapter::Util::logging_methods() ) {
      no strict 'refs';
      my $method_level = Log::Any::Adapter::Util::numeric_level($method);
      *{$method} = sub {
          my ( $self, $text ) = @_;
          return if $method_level > $self->{log_level};
          print STDERR "$text\n";
      };
  }
  
  foreach my $method ( Log::Any::Adapter::Util::detection_methods() ) {
      no strict 'refs';
      my $base = substr( $method, 3 );
      my $method_level = Log::Any::Adapter::Util::numeric_level($base);
      *{$method} = sub {
          return !!( $method_level <= $_[0]->{log_level} );
      };
  }
  
  1;
  
  __END__
  
LOG_ANY_ADAPTER_STDERR

$fatpacked{"Log/Any/Adapter/Stdout.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'LOG_ANY_ADAPTER_STDOUT';
  use 5.008001;
  use strict;
  use warnings;
  
  package Log::Any::Adapter::Stdout;
  
  our $VERSION = '1.032';
  
  use Log::Any::Adapter::Util ();
  
  use base qw/Log::Any::Adapter::Base/;
  
  my $trace_level = Log::Any::Adapter::Util::numeric_level('trace');
  
  sub init {
      my ($self) = @_;
      if ( exists $self->{log_level} ) {
          $self->{log_level} =
            Log::Any::Adapter::Util::numeric_level( $self->{log_level} )
            unless $self->{log_level} =~ /^\d+$/;
      }
      else {
          $self->{log_level} = $trace_level;
      }
  }
  
  foreach my $method ( Log::Any::Adapter::Util::logging_methods() ) {
      no strict 'refs';
      my $method_level = Log::Any::Adapter::Util::numeric_level($method);
      *{$method} = sub {
          my ( $self, $text ) = @_;
          return if $method_level > $self->{log_level};
          print STDOUT "$text\n";
      };
  }
  
  foreach my $method ( Log::Any::Adapter::Util::detection_methods() ) {
      no strict 'refs';
      my $base = substr( $method, 3 );
      my $method_level = Log::Any::Adapter::Util::numeric_level($base);
      *{$method} = sub {
          return !!( $method_level <= $_[0]->{log_level} );
      };
  }
  
  1;
  
  __END__
  
LOG_ANY_ADAPTER_STDOUT

$fatpacked{"Log/Any/Adapter/Test.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'LOG_ANY_ADAPTER_TEST';
  use 5.008001;
  use strict;
  use warnings;
  
  package Log::Any::Adapter::Test;
  
  our $VERSION = '1.032';
  
  use Log::Any::Adapter::Util qw/dump_one_line/;
  use Test::Builder;
  
  use base qw/Log::Any::Adapter::Base/;
  
  my $tb = Test::Builder->new();
  my @msgs;
  
  
  sub new {
      my $class = shift;
      if ( defined $Log::Any::OverrideDefaultAdapterClass
          && $Log::Any::OverrideDefaultAdapterClass eq __PACKAGE__ )
      {
          my $category = pop @_;
          return $class->SUPER::new( category => $category );
      }
      else {
          return $class->SUPER::new(@_);
      }
  }
  
  foreach my $method ( Log::Any::Adapter::Util::detection_methods() ) {
      no strict 'refs';
      *{$method} = sub { 1 };
  }
  
  foreach my $method ( Log::Any::Adapter::Util::logging_methods() ) {
      no strict 'refs';
      *{$method} = sub {
          my ( $self, $msg ) = @_;
          push(
              @msgs,
              {
                  message  => $msg,
                  level    => $method,
                  category => $self->{category}
              }
          );
      };
  }
  
  
  sub msgs {
      my $self = shift;
  
      return \@msgs;
  }
  
  sub clear {
      my ($self) = @_;
  
      @msgs = ();
  }
  
  sub contains_ok {
      my ( $self, $regex, $test_name ) = @_;
  
      $test_name ||= "log contains '$regex'";
      my $found =
        _first_index( sub { $_->{message} =~ /$regex/ }, @{ $self->msgs } );
      if ( $found != -1 ) {
          splice( @{ $self->msgs }, $found, 1 );
          $tb->ok( 1, $test_name );
      }
      else {
          $tb->ok( 0, $test_name );
          $tb->diag( "could not find message matching $regex; log contains: "
                . $self->dump_one_line( $self->msgs ) );
      }
  }
  
  sub category_contains_ok {
      my ( $self, $category, $regex, $test_name ) = @_;
  
      $test_name ||= "log for $category contains '$regex'";
      my $found =
        _first_index(
          sub { $_->{category} eq $category && $_->{message} =~ /$regex/ },
          @{ $self->msgs } );
      if ( $found != -1 ) {
          splice( @{ $self->msgs }, $found, 1 );
          $tb->ok( 1, $test_name );
      }
      else {
          $tb->ok( 0, $test_name );
          $tb->diag(
              "could not find $category message matching $regex; log contains: "
                . $self->dump_one_line( $self->msgs ) );
      }
  }
  
  sub does_not_contain_ok {
      my ( $self, $regex, $test_name ) = @_;
  
      $test_name ||= "log does not contain '$regex'";
      my $found =
        _first_index( sub { $_->{message} =~ /$regex/ }, @{ $self->msgs } );
      if ( $found != -1 ) {
          $tb->ok( 0, $test_name );
          $tb->diag( "found message matching $regex: " . $self->msgs->[$found] );
      }
      else {
          $tb->ok( 1, $test_name );
      }
  }
  
  sub category_does_not_contain_ok {
      my ( $self, $category, $regex, $test_name ) = @_;
  
      $test_name ||= "log for $category contains '$regex'";
      my $found =
        _first_index(
          sub { $_->{category} eq $category && $_->{message} =~ /$regex/ },
          @{ $self->msgs } );
      if ( $found != -1 ) {
          $tb->ok( 0, $test_name );
          $tb->diag( "found $category message matching $regex: "
                . $self->msgs->[$found] );
      }
      else {
          $tb->ok( 1, $test_name );
      }
  }
  
  sub empty_ok {
      my ( $self, $test_name ) = @_;
  
      $test_name ||= "log is empty";
      if ( !@{ $self->msgs } ) {
          $tb->ok( 1, $test_name );
      }
      else {
          $tb->ok( 0, $test_name );
          $tb->diag( "log is not empty; contains "
                . $self->dump_one_line( $self->msgs ) );
          $self->clear();
      }
  }
  
  sub contains_only_ok {
      my ( $self, $regex, $test_name ) = @_;
  
      $test_name ||= "log contains only '$regex'";
      my $count = scalar( @{ $self->msgs } );
      if ( $count == 1 ) {
          local $Test::Builder::Level = $Test::Builder::Level + 1;
          $self->contains_ok( $regex, $test_name );
      }
      else {
          $tb->ok( 0, $test_name );
          $tb->diag( "log contains $count messages: "
                . $self->dump_one_line( $self->msgs ) );
      }
  }
  
  sub _first_index {
      my $f = shift;
      for my $i ( 0 .. $#_ ) {
          local *_ = \$_[$i];
          return $i if $f->();
      }
      return -1;
  }
  
  1;
LOG_ANY_ADAPTER_TEST

$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{"Log/Any/Proxy/Test.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'LOG_ANY_PROXY_TEST';
  use 5.008001;
  use strict;
  use warnings;
  
  package Log::Any::Proxy::Test;
  
  our $VERSION = '1.032';
  
  use base qw/Log::Any::Proxy/;
  
  my @test_methods = qw(
    msgs
    clear
    contains_ok
    category_contains_ok
    does_not_contain_ok
    category_does_not_contain_ok
    empty_ok
    contains_only_ok
  );
  
  foreach my $name (@test_methods) {
      no strict 'refs';
      *{$name} = sub {
          my $self = shift;
          $self->{adapter}->$name(@_);
      };
  }
  
  1;
LOG_ANY_PROXY_TEST

$fatpacked{"Log/Any/Test.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'LOG_ANY_TEST';
  use 5.008001;
  use strict;
  use warnings;
  
  package Log::Any::Test;
  
  our $VERSION = '1.032';
  
  no warnings 'once';
  $Log::Any::OverrideDefaultAdapterClass = 'Log::Any::Adapter::Test';
  $Log::Any::OverrideDefaultProxyClass   = 'Log::Any::Proxy::Test';
  
  1;
  
  __END__
  
LOG_ANY_TEST

$fatpacked{"MIME/Charset.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'MIME_CHARSET';
  
  package MIME::Charset;
  use 5.005;
  
  
  use strict;
  use vars qw(@ISA $VERSION @EXPORT @EXPORT_OK %EXPORT_TAGS $Config);
  use Exporter;
  @ISA = qw(Exporter);
  @EXPORT = qw(body_encoding canonical_charset header_encoding output_charset
  	     body_encode encoded_header_len header_encode);
  @EXPORT_OK = qw(alias default fallback recommended);
  %EXPORT_TAGS = (
  		"info" => [qw(body_encoding header_encoding
  			      canonical_charset output_charset)],
  		"trans" =>[ qw(body_encode encoded_header_len
  			       header_encode)],
  		);
  use Carp qw(croak);
  
  use constant USE_ENCODE => ($] >= 5.007003)? 'Encode': '';
  
  my @ENCODE_SUBS = qw(FB_CROAK FB_PERLQQ FB_HTMLCREF FB_XMLCREF
  		     is_utf8 resolve_alias);
  if (USE_ENCODE) {
      eval "use ".USE_ENCODE." \@ENCODE_SUBS;";
      if ($@) { 
  	eval "use ".USE_ENCODE." qw(is_utf8);";
  	require MIME::Charset::_Compat;
  	for my $sub (@ENCODE_SUBS) {
  	    no strict "refs";
  	    *{$sub} = \&{"MIME::Charset::_Compat::$sub"}
  		unless $sub eq 'is_utf8';
  	}
      }
  } else {
      require MIME::Charset::_Compat;
      for my $sub (@ENCODE_SUBS) {
  	no strict "refs";
  	*{$sub} = \&{"MIME::Charset::_Compat::$sub"};
      }
  }
  
  $VERSION = '1.012';
  
  
  my $DEFAULT_CHARSET = 'US-ASCII';
  my $FALLBACK_CHARSET = 'UTF-8';
  
  
  my %CHARSETS = (
  		'ISO-8859-1' =>		['Q',	'Q',	undef],
  		'ISO-8859-2' =>		['Q',	'Q',	undef],
  		'ISO-8859-3' =>		['Q',	'Q',	undef],
  		'ISO-8859-4' =>		['Q',	'Q',	undef],
  		'ISO-8859-9' =>		['Q',	'Q',	undef],
  		'ISO-8859-10' =>	['Q',	'Q',	undef],
  		'ISO-8859-13' =>	['Q',	'Q',	undef],
  		'ISO-8859-14' =>	['Q',	'Q',	undef],
  		'ISO-8859-15' =>	['Q',	'Q',	undef],
  		'ISO-8859-16' =>	['Q',	'Q',	undef],
  		'WINDOWS-1252' =>	['Q',	'Q',	undef],
  		'VISCII' =>		['Q',	'Q',	undef],
  		'US-ASCII' =>		[undef,	undef,	undef],
  		'BIG5' =>		['B',	'B',	undef],
  		'GB2312' =>		['B',	'B',	undef],
  		'HZ-GB-2312' =>		['B',	undef,	undef],
  		'EUC-JP' =>		['B',	undef,	'ISO-2022-JP'],
  		'SHIFT_JIS' =>		['B',	undef,	'ISO-2022-JP'],
  		'ISO-2022-JP' =>	['B',	undef,	undef],
  		'ISO-2022-JP-1' =>	['B',	undef,	undef],
  		'ISO-2022-JP-2' =>	['B',	undef,	undef],
  		'EUC-JISX0213' =>	['B',	undef,	'ISO-2022-JP-3'],
  		'SHIFT_JISX0213' =>	['B',	undef,	'ISO-2022-JP-3'],
  		'ISO-2022-JP-3' =>	['B',	undef,	undef],
  		'EUC-JIS-2004' =>	['B',	undef,	'ISO-2022-JP-2004'],
  		'SHIFT_JIS-2004' =>	['B',	undef,	'ISO-2022-JP-2004'],
  		'ISO-2022-JP-2004' =>	['B',	undef,	undef],
  		'KOI8-R' =>		['B',	'B',	undef],
  		'TIS-620' =>		['B',	'B',	undef], 
  		'UTF-16' =>		['B',	'B',	undef],
  		'UTF-16BE' => 		['B',	'B',	undef],
  		'UTF-16LE' =>		['B',	'B',	undef],
  		'UTF-32' =>		['B',	'B',	undef],
  		'UTF-32BE' => 		['B',	'B',	undef],
  		'UTF-32LE' =>		['B',	'B',	undef],
  		'UTF-7' =>		['Q',	undef,	undef],
  		'UTF-8' =>		['S',	'S',	undef],
  		'GSM03.38' =>		[undef,	undef,	undef], 
  		'8BIT' =>		[undef,	'B',	'ISO-8859-1'],
  		);
  
  my %CHARSET_ALIASES = (
  		       "ASCII" =>		"US-ASCII",
  		       "BIG5-ETEN" =>		"BIG5",
  		       "CP1250" =>		"WINDOWS-1250",
  		       "CP1251" =>		"WINDOWS-1251",
  		       "CP1252" =>		"WINDOWS-1252",
  		       "CP1253" =>		"WINDOWS-1253",
  		       "CP1254" =>		"WINDOWS-1254",
  		       "CP1255" =>		"WINDOWS-1255",
  		       "CP1256" =>		"WINDOWS-1256",
  		       "CP1257" =>		"WINDOWS-1257",
  		       "CP1258" =>		"WINDOWS-1258",
  		       "CP874" =>		"WINDOWS-874",
  		       "CP936" =>		"GBK",
  		       "CP949" =>		"KS_C_5601-1987",
  		       "EUC-CN" =>		"GB2312",
  		       "HZ" =>			"HZ-GB-2312", 
  		       "KS_C_5601" =>		"KS_C_5601-1987",
  		       "SHIFTJIS" =>		"SHIFT_JIS",
  		       "SHIFTJISX0213" =>	"SHIFT_JISX0213",
  		       "TIS620" =>		"TIS-620", 
  		       "UNICODE-1-1-UTF-7" =>	"UTF-7", 
  		       "UTF8" =>		"UTF-8",
  		       "UTF-8-STRICT" =>	"UTF-8", 
  		       "GSM0338" =>		"GSM03.38", 
  		       );
  
  my %ENCODERS = (
  		'EXTENDED' => {
  		    'ISO-8859-1' => [['cp1252'], ],     
  		    'ISO-8859-2' => [['cp1250'], ],     
  		    'ISO-8859-5' => [['cp1251'], ],     
  		    'ISO-8859-6' => [
  				     ['cp1256'],        
  				    ],
  		    'ISO-8859-6-I'=>[['cp1256'], ],     
  		    'ISO-8859-7' => [['cp1253'], ],     
  		    'ISO-8859-8' => [['cp1255'], ],     
  		    'ISO-8859-8-I'=>[['cp1255'], ],     
  		    'ISO-8859-9' => [['cp1254'], ],     
  		    'ISO-8859-13'=> [['cp1257'], ],     
  		    'GB2312'     => [
  				     ['gb18030',	'Encode::HanExtra'],
  				     ['cp936'],		
  				    ],
  		    'EUC-JP'     => [
  				     ['eucJP-ascii',	'Encode::EUCJPASCII'],
  				    ],
  		    'ISO-2022-JP'=> [
  				     ['x-iso2022jp-ascii',
  				      			'Encode::EUCJPASCII'],
  				     ['iso-2022-jp-1'], 
  				    ],
  		    'SHIFT_JIS'  => [
  				     ['cp932'],		
  				    ],
  		    'EUC-JISX0213'  => [['euc-jis-2004', 'Encode::JISX0213'], ],
  		    'ISO-2022-JP-3' => [['iso-2022-jp-2004', 'Encode::JISX0213'], ],
  		    'SHIFT_JISX0213'=> [['shift_jis-2004', 'Encode::ShiftJIS2004'], ],
  		    'EUC-KR'     => [['cp949'], ],      
  		    'BIG5'       => [
  				     ['cp950'],         
  				    ],
  		    'TIS-620'    => [['cp874'], ],      
  		    'UTF-8'      => [['utf8'], ],       
  		},
  		'STANDARD' => {
  		    'ISO-8859-6-E'  => [['iso-8859-6'],],
  		    'ISO-8859-6-I'  => [['iso-8859-6'],],
  		    'ISO-8859-8-E'  => [['iso-8859-8'],],
  		    'ISO-8859-8-I'  => [['iso-8859-8'],],
  		    'GB18030'       => [['gb18030',     'Encode::HanExtra'], ],
  		    'ISO-2022-JP-2' => [['iso-2022-jp-2','Encode::ISO2022JP2'], ],
  		    'EUC-JISX0213'  => [['euc-jisx0213', 'Encode::JISX0213'], ],
  		    'ISO-2022-JP-3' => [['iso-2022-jp-3', 'Encode::JISX0213'], ],
  		    'EUC-JIS-2004'  => [['euc-jis-2004', 'Encode::JISX0213'], ],
  		    'ISO-2022-JP-2004' => [['iso-2022-jp-2004', 'Encode::JISX0213'], ],
  		    'SHIFT_JIS-2004'=> [['shift_jis-2004', 'Encode::ShiftJIS2004'], ],
  		    'EUC-TW'        => [['euc-tw',      'Encode::HanExtra'], ],
  		    'HZ-GB-2312'    => [['hz'], ],	
  		    'TIS-620'       => [['tis620'], ],  
  		    'UTF-16'        => [['x-utf16auto', 'MIME::Charset::UTF'],],
  		    'UTF-32'        => [['x-utf32auto', 'MIME::Charset::UTF'],],
  		    'GSM03.38'      => [['gsm0338'], ],	
  
  		},
  );
  
  my @ESCAPE_SEQS = ( 
  		   ["\033\$\@",	"ISO-2022-JP"],	
  		   ["\033\$B",	"ISO-2022-JP"],	
  		   ["\033(J",	"ISO-2022-JP"],	
  		   ["\033(I",	"ISO-2022-JP"],	
  		   ["\033\$(D",	"ISO-2022-JP"],	
  		   ["\033.A",   "ISO-2022-JP-2"], 
  		   ["\033.F",   "ISO-2022-JP-2"], 
  		   ["\033\$(C", "ISO-2022-JP-2"], 
  		   ["\033\$(O",	"ISO-2022-JP-3"], 
  		   ["\033\$(P",	"ISO-2022-JP-2004"], 
  		   ["\033\$(Q",	"ISO-2022-JP-2004"], 
  		   ["\033\$)C",	"ISO-2022-KR"],	
  		   ["\033\$)A",	"ISO-2022-CN"], 
  		   ["\033\$A",	"ISO-2022-CN"], 
  		   ["\033\$)G",	"ISO-2022-CN"], 
  		   ["\033\$*H",	"ISO-2022-CN"], 
  
  
  		   ["\033e",	"GSM03.38"],	
  		   ["\033\012",	"GSM03.38"],	
  		   ["\033<",	"GSM03.38"],	
  		   ["\033/",	"GSM03.38"],	
  		   ["\033>",	"GSM03.38"],	
  		   ["\033\024",	"GSM03.38"],	
  		   ["\033(",	"GSM03.38"],	
  		   ["\033\@",	"GSM03.38"],	
  		   ["\033)",	"GSM03.38"],	
  		   ["\033=",	"GSM03.38"],	
  
  		  );
  
  
  $Config = {
      Detect7bit =>      'YES',
      Mapping =>         'EXTENDED',
      Replacement =>     'DEFAULT',
  };
  eval { require MIME::Charset::Defaults; };
  
  
  my $NON7BITRE = qr{
      [^\x01-\x7e]
  }x;
  
  my $NONASCIIRE = qr{
      [^\x09\x0a\x0d\x20\x21-\x7e]
  }x;
  
  my $ISO2022RE = qr{
      ISO-2022-.+
  }ix;
  
  my $ASCIITRANSRE = qr{
      HZ-GB-2312 | UTF-7
  }ix;
  
  
  
  
  sub new {
      my $class = shift;
      my $charset = shift;
      return bless {}, $class unless $charset;
      return bless {}, $class if 75 < length $charset; 
      my %params = @_;
      my $mapping = uc($params{'Mapping'} || $Config->{Mapping});
  
      if ($charset =~ /\bhz.?gb.?2312$/i) {
  	$charset = "HZ-GB-2312";
      } elsif ($charset =~ /\btis-?620$/i) {
  	$charset = "TIS-620";
      } else {
  	$charset = resolve_alias($charset) || $charset
      }
      $charset = $CHARSET_ALIASES{uc($charset)} || uc($charset);
      my ($henc, $benc, $outcset);
      my $spec = $CHARSETS{$charset};
      if ($spec) {
  	($henc, $benc, $outcset) =
  	    ($$spec[0], $$spec[1], USE_ENCODE? $$spec[2]: undef);
      } else {
  	($henc, $benc, $outcset) = ('S', 'B', undef);
      }
      my ($decoder, $encoder);
      if (USE_ENCODE) {
  	$decoder = _find_encoder($charset, $mapping);
  	$encoder = _find_encoder($outcset, $mapping);
      } else {
  	$decoder = $encoder = undef;
      }
  
      bless {
  	InputCharset => $charset,
  	Decoder => $decoder,
  	HeaderEncoding => $henc,
  	BodyEncoding => $benc,
  	OutputCharset => ($outcset || $charset),
  	Encoder => ($encoder || $decoder),
      }, $class;
  }
  
  my %encoder_cache = ();
  
  sub _find_encoder($$) {
      my $charset = uc(shift || "");
      return undef unless $charset;
      my $mapping = uc(shift);
      my ($spec, $name, $module, $encoder);
  
      local($@);
      $encoder = $encoder_cache{$charset, $mapping};
      return $encoder if ref $encoder;
  
      foreach my $m (('EXTENDED', 'STANDARD')) {
  	next if $m eq 'EXTENDED' and $mapping ne 'EXTENDED';
  	$spec = $ENCODERS{$m}->{$charset};
  	next unless $spec;
  	foreach my $s (@{$spec}) {
  	    ($name, $module) = @{$s};
  	    if ($module) {
  		next unless eval "require $module;";
  	    }
  	    $encoder = Encode::find_encoding($name);
  	    last if ref $encoder;
  	}
  	last if ref $encoder;
      }
      $encoder ||= Encode::find_encoding($charset);
      $encoder_cache{$charset, $mapping} = $encoder if $encoder;
      return $encoder;
  }
  
  
  sub body_encoding($) {
      my $self = shift;
      return undef unless $self;
      $self = __PACKAGE__->new($self) unless ref $self;
      $self->{BodyEncoding};
  }
  
  
  sub canonical_charset($) {
      my $self = shift;
      return undef unless $self;
      $self = __PACKAGE__->new($self) unless ref $self;
      $self->{InputCharset};
  }
  
  sub as_string($) {
      my $self = shift;
      $self->{InputCharset};
  }
  
  
  sub decoder($) {
      my $self = shift;
      $self->{Decoder};
  }
  
  
  sub dup($) {
      my $self = shift;
      my $obj = __PACKAGE__->new(undef);
      %{$obj} = %{$self};
      $obj;
  }
  
  
  sub encoder($$;) {
      my $self = shift;
      my $charset = shift;
      if ($charset) {
  	$charset = __PACKAGE__->new($charset) unless ref $charset;
  	$self->{OutputCharset} = $charset->{InputCharset};
  	$self->{Encoder} = $charset->{Decoder};
  	$self->{BodyEncoding} = $charset->{BodyEncoding};
  	$self->{HeaderEncoding} = $charset->{HeaderEncoding};
      }
      $self->{Encoder};
  }
  
  
  sub header_encoding($) {
      my $self = shift;
      return undef unless $self;
      $self = __PACKAGE__->new($self) unless ref $self;
      $self->{HeaderEncoding};
  }
  
  
  sub output_charset($) {
      my $self = shift;
      return undef unless $self;
      $self = __PACKAGE__->new($self) unless ref $self;
      $self->{OutputCharset};
  }
  
  
  sub body_encode {
      my $self = shift;
      my $text;
      if (ref $self) {
  	$text = shift;
      } else {
  	$text = $self;
  	$self = __PACKAGE__->new(shift);
      }
      my ($encoded, $charset) = $self->_text_encode($text, @_);
      return ($encoded, undef, 'BASE64')
  	unless $charset and $charset->{InputCharset};
      my $cset = $charset->{OutputCharset};
  
      my $enc = $charset->{BodyEncoding};
  
      if (!$enc and $encoded !~ /\x00/) {	
          if ($encoded =~ $NON7BITRE) {	
              $enc = '8BIT';
  	} elsif ($cset =~ /^($ISO2022RE|$ASCIITRANSRE)$/) {	
              $enc = '7BIT';
          } else {			
              $enc = '7BIT';
              $cset = 'US-ASCII';
          }
      } elsif ($enc eq 'S') {
  	$enc = _resolve_S($encoded, 1);
      } elsif ($enc eq 'B') {
          $enc = 'BASE64';
      } elsif ($enc eq 'Q') {
          $enc = 'QUOTED-PRINTABLE';
      } else {
          $enc = 'BASE64';
      }
      return ($encoded, $cset, $enc);
  }
  
  
  sub decode($$$;) {
      my $self = shift;
      my $s = shift;
      my $check = shift || 0;
      $self->{Decoder}->decode($s, $check);
  }
  
  
  sub detect_7bit_charset($) {
      return $DEFAULT_CHARSET unless &USE_ENCODE;
      my $s = shift;
      return $DEFAULT_CHARSET unless $s;
  
      return undef if $s =~ $NON7BITRE;
  
      foreach (@ESCAPE_SEQS) {
  	my ($seq, $cset) = @$_;
  	if (index($s, $seq) >= 0) {
              my $decoder = __PACKAGE__->new($cset);
              next unless $decoder->{Decoder};
              eval {
  		my $dummy = $s;
  		$decoder->decode($dummy, FB_CROAK());
  	    };
  	    if ($@) {
  		next;
  	    }
  	    return $decoder->{InputCharset};
  	}
      }
  
  
      return $DEFAULT_CHARSET;
  }
  
  sub _detect_7bit_charset {
      detect_7bit_charset(@_);
  }
  
  
  sub encode($$$;) {
      my $self = shift;
      my $s = shift;
      my $check = shift || 0;
  
      unless (is_utf8($s) or $s =~ /[^\x00-\xFF]/) {
  	$s = $self->{Decoder}->decode($s, ($check & 0x1)? FB_CROAK(): 0);
      }
      my $enc = $self->{Encoder}->encode($s, $check);
      Encode::_utf8_off($enc) if is_utf8($enc); 
      $enc;
  }
  
  
  sub encoded_header_len($$$;) {
      my $self = shift;
      my ($encoding, $s);
      if (ref $self) {
  	$s = shift;
  	$encoding = uc(shift || $self->{HeaderEncoding});
      } else {
  	$s = $self;
  	$encoding = uc(shift);
  	$self  = shift;
  	$self = __PACKAGE__->new($self) unless ref $self;
      }
  
  
      my $enclen;
      if ($encoding eq 'Q') {
          $enclen = _enclen_Q($s);
      } elsif ($encoding eq 'S' and _resolve_S($s) eq 'Q') {
  	$enclen = _enclen_Q($s);
      } else { 
          $enclen = _enclen_B($s);
      }
  
      length($self->{OutputCharset})+$enclen+7;
  }
  
  sub _enclen_B($) {
      int((length(shift) + 2) / 3) * 4;
  }
  
  sub _enclen_Q($;$) {
      my $s = shift;
      my $in_body = shift;
      my @o;
      if ($in_body) {
  	@o = ($s =~ m{([^-\t\r\n !*+/0-9A-Za-z])}go);
      } else {
  	@o = ($s =~ m{([^- !*+/0-9A-Za-z])}gos);
      }
      length($s) + scalar(@o) * 2;
  }
  
  sub _resolve_S($;$) {
      my $s = shift;
      my $in_body = shift;
      my $e;
      if ($in_body) {
  	$e = scalar(() = $s =~ m{[^-\t\r\n !*+/0-9A-Za-z]}g);
  	return (length($s) + 8 < $e * 6) ? 'BASE64' : 'QUOTED-PRINTABLE';
      } else {
  	$e = scalar(() = $s =~ m{[^- !*+/0-9A-Za-z]}g);
  	return (length($s) + 8 < $e * 6) ? 'B' : 'Q';
      }
  }
  
  
  sub header_encode {
      my $self = shift;
      my $text;
      if (ref $self) {
  	$text = shift;
      } else {
  	$text = $self;
  	$self = __PACKAGE__->new(shift);
      }
      my ($encoded, $charset) = $self->_text_encode($text, @_);
      return ($encoded, '8BIT', undef)
  	unless $charset and $charset->{InputCharset};
      my $cset = $charset->{OutputCharset};
  
      my $enc = $charset->{HeaderEncoding};
  
      if (!$enc and $encoded !~ $NON7BITRE) {
  	unless ($cset =~ /^($ISO2022RE|$ASCIITRANSRE)$/) {	
              $cset = 'US-ASCII';
          }
      } elsif ($enc eq 'S') {
  	$enc = _resolve_S($encoded);
      } elsif ($enc !~ /^[BQ]$/) {
          $enc = 'B';
      }
      return ($encoded, $cset, $enc);
  }
  
  sub _text_encode {
      my $charset = shift;
      my $s = shift;
      my %params = @_;
      my $replacement = uc($params{'Replacement'} || $Config->{Replacement});
      my $detect7bit = uc($params{'Detect7bit'} || $Config->{Detect7bit});
      my $encoding = $params{'Encoding'} ||
  	(exists $params{'Encoding'}? undef: 'A'); 
  
      if (!$encoding or $encoding ne 'A') { 
  	$detect7bit = 'NO';
      }
      unless ($charset->{InputCharset}) {
  	if ($s =~ $NON7BITRE) {
  	    return ($s, undef);
  	} elsif ($detect7bit ne "NO") {
  	    $charset = __PACKAGE__->new(&detect_7bit_charset($s));
  	} else {
  	    $charset = __PACKAGE__->new($DEFAULT_CHARSET,
  					Mapping => 'STANDARD');
  	} 
      }
      if (!$encoding or $encoding ne 'A') { 
  	$charset = $charset->dup;
  	$charset->encoder($charset);
  	$charset->{HeaderEncoding} = $encoding;
  	$charset->{BodyEncoding} = $encoding;
      }
      my $check = ($replacement and $replacement =~ /^\d+$/)?
  	$replacement:
      {
  	'CROAK' => FB_CROAK(),
  	'STRICT' => FB_CROAK(),
  	'FALLBACK' => FB_CROAK(), 
  	'PERLQQ' => FB_PERLQQ(),
  	'HTMLCREF' => FB_HTMLCREF(),
  	'XMLCREF' => FB_XMLCREF(),
      }->{$replacement || ""} || 0;
  
      my $encoded;
      if (is_utf8($s) or $s =~ /[^\x00-\xFF]/ or
  	($charset->{InputCharset} || "") ne ($charset->{OutputCharset} || "")) {
  	if ($check & 0x1) { 
  	    eval {
  		$encoded = $s;
  		$encoded = $charset->encode($encoded, FB_CROAK());
  	    };
  	    if ($@) {
  		if ($replacement eq "FALLBACK" and $FALLBACK_CHARSET) {
  		    my $cset = __PACKAGE__->new($FALLBACK_CHARSET,
  						Mapping => 'STANDARD');
  		    croak "unknown charset ``$FALLBACK_CHARSET''"
  			unless $cset->{Decoder};
  		    $charset = $charset->dup;
  		    $charset->encoder($cset);
  		    $encoded = $s;
  		    $encoded = $charset->encode($encoded, 0);
  		    $cset->encoder($cset);
  		    $charset = $cset;
  		} else {
  		    $@ =~ s/ at .+$//;
  		    croak $@;
  		}
  	    }
  	} else {
  	    $encoded = $s;
  	    $encoded = $charset->encode($encoded, $check);
  	}
      } else {
          $encoded = $s;
      }
  
      if ($encoded !~ /$NONASCIIRE/) { 
  	if ($charset->{OutputCharset} =~ /^($ASCIITRANSRE)$/) {
  	    my $u = $encoded;
  	    if (USE_ENCODE) {
  		$u = $charset->encoder->decode($encoded); 
  	    } elsif ($encoded =~ /[+~]/) { 
  		$u = "x$u";
  	    }
  	    if ($u eq $encoded) {
  		$charset = $charset->dup;
  		$charset->encoder($DEFAULT_CHARSET);
  	    }
  	} elsif ($charset->{OutputCharset} ne "US-ASCII") {
  	    $charset = $charset->dup;
  	    $charset->encoder($DEFAULT_CHARSET);
  	}
      }
  
      return ($encoded, $charset);
  }
  
  
  sub undecode($$$;) {
      my $self = shift;
      my $s = shift;
      my $check = shift || 0;
      my $enc = $self->{Decoder}->encode($s, $check);
      Encode::_utf8_off($enc); 
      $enc;
  }
  
  
  sub alias ($;$) {
      my $alias = uc(shift);
      my $charset = uc(shift);
  
      return $CHARSET_ALIASES{$alias} unless $charset;
  
      $CHARSET_ALIASES{$alias} = $charset;
      return $charset;
  }
  
  
  sub default(;$) {
      my $charset = &canonical_charset(shift);
  
      if ($charset) {
  	croak "Unknown charset '$charset'"
  	    unless resolve_alias($charset);
  	$DEFAULT_CHARSET = $charset;
      }
      return $DEFAULT_CHARSET;
  }
  
  
  sub fallback(;$) {
      my $charset = &canonical_charset(shift);
  
      if ($charset eq "NONE") {
  	$FALLBACK_CHARSET = undef;
      } elsif ($charset) {
  	croak "Unknown charset '$charset'"
  	    unless resolve_alias($charset);
  	$FALLBACK_CHARSET = $charset;
      }
      return $FALLBACK_CHARSET;
  }
  
  
  sub recommended ($;$;$;$) {
      my $charset = &canonical_charset(shift);
      my $henc = uc(shift) || undef;
      my $benc = uc(shift) || undef;
      my $cset = &canonical_charset(shift);
  
      croak "CHARSET is not specified" unless $charset;
      croak "Unknown header encoding" unless !$henc or $henc =~ /^[BQS]$/;
      croak "Unknown body encoding" unless !$benc or $benc =~ /^[BQ]$/;
  
      if ($henc or $benc or $cset) {
  	$cset = undef if $charset eq $cset;
  	my @spec = ($henc, $benc, USE_ENCODE? $cset: undef);
  	$CHARSETS{$charset} = \@spec;
  	return @spec;
      } else {
  	$charset = __PACKAGE__->new($charset) unless ref $charset;
  	return map { $charset->{$_} } qw(HeaderEncoding BodyEncoding
  					 OutputCharset);
      }
  }
  
  
  1;
MIME_CHARSET

$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/Golf.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'MO_GOLF';
  
  use strict;
  use warnings;
  package Mo::Golf;
  
  our $VERSION=0.39;
  
  use PPI;
  
  my %short_names = (
      (
          map {($_, substr($_, 0, 1))}
          qw(
              args builder class default exports features
              generator import is_lazy method MoPKG name
              nonlazy_defaults options reftype self
          )
      ),
      build_subs => 'B',
      old_constructor => 'C',
      caller_pkg => 'P',
  );
  
  my %short_barewords = ( EAGERINIT => q{':E'}, NONLAZY => q{':N'} );
  
  my %hands_off = map {($_,1)} qw'&import *import';
  
  sub import {
      return unless @_ == 2 and $_[1] eq 'golf';
      binmode STDOUT;
      my $text = do { local $/; <> };
      print STDOUT golf( $text );
  };
  
  sub golf {
      my ( $text ) = @_;
  
      my $tree = PPI::Document->new( \$text );
  
      my %finder_subs = _finder_subs();
  
      my @order = qw( comments duplicate_whitespace whitespace trailing_whitespace );
  
      for my $name ( @order ) {
          my $elements = $tree->find( $finder_subs{$name} );
          die $@ if !defined $elements;
          $_->delete for @{ $elements || [] };
      }
  
      $tree->find( $finder_subs{$_} )
        for qw( del_superfluous_concat del_last_semicolon_in_block separate_version shorten_var_names shorten_barewords );
      die $@ if $@;
  
      for my $name ( 'double_semicolon' ) {
          my $elements = $tree->find( $finder_subs{$name} );
          die $@ if !defined $elements;
          $_->delete for @{ $elements || [] };
      }
  
      return $tree->serialize . "\n";
  }
  
  sub tok { "PPI::Token::$_[0]" }
  
  sub _finder_subs {
      return (
          comments => sub { $_[1]->isa( tok 'Comment' ) },
  
          duplicate_whitespace => sub {
              my ( $top, $current ) = @_;
              return 0 if !$current->isa( tok 'Whitespace' );
  
              $current->set_content(' ') if 1 < length $current->content;
  
              return 0 if !$current->next_token;
              return 0 if !$current->next_token->isa( tok 'Whitespace' );
              return 1;
          },
  
          whitespace => sub {
              my ( $top, $current ) = @_;
              return 0 if !$current->isa( tok 'Whitespace' );
              my $prev = $current->previous_token;
              my $next = $current->next_token;
  
              return 1 if $prev->isa( tok 'Number' ) and $next->isa( tok 'Operator' ) and $next->content =~ /^\W/; 
              return 1 if $prev->isa( tok 'Word' )   and $next->isa( tok 'Operator' ) and $next->content =~ /^\W/; 
              return 1 if $prev->isa( tok 'Symbol' ) and $next->isa( tok 'Operator' ) and $next->content =~ /^\W/; 
  
              return 1 if $prev->isa( tok 'Operator' ) and $next->isa( tok 'Quote::Single' ) and $next->content =~ /^\W/; 
              return 1 if $prev->isa( tok 'Operator' ) and $next->isa( tok 'Quote::Double' ) and $next->content =~ /^\W/; 
              return 1 if $prev->isa( tok 'Operator' ) and $next->isa( tok 'Symbol' )        and $next->content =~ /^\W/; 
              return 1 if $prev->isa( tok 'Operator' ) and $next->isa( tok 'Structure' )     and $next->content =~ /^\W/; 
  
              return 1 if $prev->isa( tok 'Word' )       and $next->isa( tok 'Symbol' );           
              return 1 if $prev->isa( tok 'Word' )       and $next->isa( tok 'Structure' );        
              return 1 if $prev->isa( tok 'Word' )       and $next->isa( tok 'Quote::Double' );    
              return 1 if $prev->isa( tok 'Symbol' )     and $next->isa( tok 'Structure' );        
              return 1 if $prev->isa( tok 'ArrayIndex' ) and $next->isa( tok 'Operator' );         
              return 1 if $prev->isa( tok 'Word' )       and $next->isa( tok 'Cast' );             
              return 0;
          },
  
          trailing_whitespace => sub {
              my ( $top, $current ) = @_;
              return 0 if !$current->isa( tok 'Whitespace' );
              my $prev = $current->previous_token;
  
              return 1 if $prev->isa( tok 'Structure' );                                           
              return 1 if $prev->isa( tok 'Operator' ) and $prev->content =~ /\W$/;                
              return 1 if $prev->isa( tok 'Quote::Double' );                                       
              return 1 if $prev->isa( tok 'Quote::Single' );                                       
  
              return 0;
          },
  
          double_semicolon => sub {
              my ( $top, $current ) = @_;
              return 0 if !$current->isa( tok 'Structure' );
              return 0 if $current->content ne ';';
  
              my $prev = $current->previous_token;
  
              return 0 if !$prev->isa( tok 'Structure' );
              return 0 if $prev->content ne ';';
  
              return 1;
          },
  
          del_last_semicolon_in_block => sub {
              my ( $top, $current ) = @_;
              return 0 if !$current->isa( 'PPI::Structure::Block' );
  
              my $last = $current->last_token;
  
              return 0 if !$last->isa( tok 'Structure' );
              return 0 if $last->content ne '}';
  
              my $maybe_semi = $last->previous_token;
  
              return 0 if !$maybe_semi->isa( tok 'Structure' );
              return 0 if $maybe_semi->content ne ';';
  
              $maybe_semi->delete;
  
              return 1;
          },
  
          del_superfluous_concat => sub {
              my ( $top, $current ) = @_;
              return 0 if !$current->isa( tok 'Operator' );
  
              my $prev = $current->previous_token;
              my $next = $current->next_token;
  
              return 0 if $current->content ne '.';
              return 0 if !$prev->isa( tok 'Quote::Double' );
              return 0 if !$next->isa( tok 'Quote::Double' );
  
              $current->delete;
              $prev->set_content( $prev->{separator} . $prev->string . $next->string . $prev->{separator} );
              $next->delete;
  
              return 1;
          },
  
          separate_version => sub {
              my ( $top, $current ) = @_;
              return 0 if !$current->isa( 'PPI::Statement' );
  
              my $first = $current->first_token;
              return 0 if $first->content ne '$VERSION';
  
              $current->$_( PPI::Token::Whitespace->new( "\n" ) ) for qw( insert_before insert_after );
  
              return 1;
          },
  
          shorten_var_names => sub {
              my ( $top, $current ) = @_;
              return 0 if !$current->isa( tok 'Symbol' );
  
              my $long_name = $current->canonical;
  
              return 1 if $hands_off{$long_name};
              (my $name = $long_name) =~ s/^([\$\@\%])// or die $long_name;
              my $sigil = $1;
              die "variable $long_name conflicts with shortened var name"
                  if grep {
                      $name eq $_
                  } values %short_names;
  
              my $short_name = $short_names{$name};
              $current->set_content( "$sigil$short_name" ) if $short_name;
  
              return 1;
          },
  
          shorten_barewords => sub {
              my ( $top, $current ) = @_;
              return 0 if !$current->isa( tok 'Word' );
  
              my $name = $current->content;
  
              die "bareword $name conflicts with shortened bareword"
                  if grep {
                      $name eq $_
                  } values %short_barewords;
  
              my $short_name = $short_barewords{$name};
              $current->set_content( $short_name ) if $short_name;
  
              return 1;
          },
      );
  }
  
MO_GOLF

$fatpacked{"Mo/Inline.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'MO_INLINE';
  
  package Mo::Inline;
  use Mo;
  
  our $VERSION=0.39;
  
  use IO::All;
  
  my $matcher = qr/((?m:^#\s*use Mo(\s.*)?;.*\n))(?:#.*\n)*(?:.{400,}\n)?/;
  
  sub run {
      my $self = shift;
      my @files;
      if (not @_ and -d 'lib') {
          print "Searching the 'lib' directory for a Mo to inline:\n";
          @_ = 'lib';
      }
      if (not @_ or @_ == 1 and $_[0] =~ /^(?:-\?|-h|--help)$/) {
          print usage();
          return 0;
      }
      for my $name (@_) {
          die "No file or directory called '$name'"
              unless -e $name;
          die "'$name' is not a Perl module"
              if -f $name and $name !~ /\.pm$/;
          if (-f $name) {
              push @files, $name;
          }
          elsif (-d $name) {
              push @_, grep /\.pm$/, map { "$_" } io($name)->All_Files;
          }
      }
  
      die "No .pm files specified"
          unless @files;
  
      for my $file (@files) {
          my $text = io($file)->all;
          if ($text !~ $matcher) {
              print "Ignoring $file - No Mo to Inline!\n";
              next;
          }
          $self->inline($file, 1);
      }
  }
  
  sub inline {
      my ($self, $file, $noisy) = @_;
      my $text = io($file)->all;
      $text =~ s/$matcher/"$1" . &inliner($2)/eg;
      io($file)->print($text);
      print "Mo Inlined $file\n"
          if $noisy;
  }
  
  sub inliner {
      my $mo = shift;
      require Mo;
      my @features = grep {$_ ne 'qw'} ($mo =~ /(\w+)/g);
      for (@features) {
          eval "require Mo::$_; 1" or die $@;
      }
      my $inline = '';
      $inline .= $_ for map {
          my $module = $_;
          $module .= '.pm';
          my @lines = io($INC{$module})->chomp->getlines;
          $lines[-1];
      } ('Mo', map { s!::!/!g; "Mo/$_" } @features);
      return <<"...";
  #   The following line of code was produced from the previous line by
  #   Mo::Inline version $VERSION
  $inline\@f=qw[@features];use strict;use warnings;
  ...
  }
  
  sub usage {
      <<'...';
  Usage: mo-linline <perl module files or directories>
  
  ...
  }
  
  1;
  
MO_INLINE

$fatpacked{"Mo/Moose.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'MO_MOOSE';
  package Mo::Moose;$M="Mo::";
  $VERSION=0.39;
  *{$M.'Moose::e'}=sub{my($P,$e)=@_;$P=~s/::$//;%$e=(M=>1);require Moose;Moose->import({into=>$P});Moose::Util::MetaRole::apply_metaroles(for=>$P,class_metaroles=>{attribute=>['Attr::Trait']},)};BEGIN{package Attr::Trait;use Moose::Role;around _process_options=>sub{my$orig=shift;my$c=shift;my($n,$o)=@_;$o->{is}||='rw';$o->{lazy}||=1 if defined$o->{default}or defined$o->{builder};$c->$orig(@_)};$INC{'Attr/Trait.pm'}=1}
MO_MOOSE

$fatpacked{"Mo/Mouse.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'MO_MOUSE';
  package Mo::Mouse;$M="Mo::";
  $VERSION=0.39;
  *{$M.'Mouse::e'}=sub{my($P,$e)=@_;$P=~s/::$//;%$e=(M=>1);require Mouse;require Mouse::Util::MetaRole;Mouse->import({into=>$P});Mouse::Util::MetaRole::apply_metaroles(for=>$P,class_metaroles=>{attribute=>['Attr::Trait']},)};BEGIN{package Attr::Trait;use Mouse::Role;around _process_options=>sub{my$orig=shift;my$c=shift;my($n,$o)=@_;$o->{is}||='rw';$o->{lazy}||=1 if defined$o->{default}or defined$o->{builder};$c->$orig(@_)};$INC{'Attr/Trait.pm'}=1}
MO_MOUSE

$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/builder.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'MO_BUILDER';
  package Mo::builder;my$M="Mo::";
  $VERSION=0.39;
  *{$M.'builder::e'}=sub{my($P,$e,$o)=@_;$o->{builder}=sub{my($m,$n,%a)=@_;my$b=$a{builder}or return$m;my$i=exists$a{lazy}?$a{lazy}:!${$P.':N'};$i or ${$P.':E'}{$n}=\&{$P.$b}and return$m;sub{$#_?$m->(@_):!exists$_[0]{$n}?$_[0]{$n}=$_[0]->$b:$m->(@_)}}};
MO_BUILDER

$fatpacked{"Mo/chain.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'MO_CHAIN';
  package Mo::chain;my$M="Mo::";
  $VERSION=0.39;
  *{$M.'chain::e'}=sub{my($P,$e,$o)=@_;$o->{chain}=sub{my($m,$n,%a)=@_;$a{chain}or return$m;sub{$#_?($m->(@_),return$_[0]):$m->(@_)}}};
MO_CHAIN

$fatpacked{"Mo/coerce.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'MO_COERCE';
  package Mo::coerce;my$M="Mo::";
  $VERSION=0.39;
  *{$M.'coerce::e'}=sub{my($P,$e,$o)=@_;$o->{coerce}=sub{my($m,$n,%a)=@_;$a{coerce}or return$m;sub{$#_?$m->($_[0],$a{coerce}->($_[1])):$m->(@_)}};my$C=$e->{new}||*{$M.Object::new}{CODE};$e->{new}=sub{my$s=$C->(@_);$s->$_($s->{$_})for keys%$s;$s}};
MO_COERCE

$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{"Mo/exporter.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'MO_EXPORTER';
  package Mo::exporter;my$M="Mo::";
  $VERSION=0.39;
  *{$M.'exporter::e'}=sub{my($P)=@_;if(@{$M.EXPORT}){*{$P.$_}=\&{$M.$_}for@{$M.EXPORT}}};
MO_EXPORTER

$fatpacked{"Mo/import.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'MO_IMPORT';
  package Mo::import;my$M="Mo::";
  $VERSION=0.39;
  my$i=\&import;*{$M.import}=sub{(@_==2 and not$_[1])?pop@_:@_==1?push@_,grep!/import/,@f:();goto&$i};
MO_IMPORT

$fatpacked{"Mo/importer.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'MO_IMPORTER';
  package Mo::importer;my$M="Mo::";
  $VERSION=0.39;
  *{$M.'importer::e'}=sub{my($P,$e,$o,$f)=@_;(my$pkg=$P)=~s/::$//;&{$P.'importer'}($pkg,@$f)if defined&{$P.'importer'}};
MO_IMPORTER

$fatpacked{"Mo/is.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'MO_IS';
  package Mo::is;$M="Mo::";
  $VERSION=0.39;
  *{$M.'is::e'}=sub{my($P,$e,$o)=@_;$o->{is}=sub{my($m,$n,%a)=@_;$a{is}or return$m;sub{$#_&&$a{is}eq'ro'&&caller ne'Mo::coerce'?die$n.' is ro':$m->(@_)}}};
MO_IS

$fatpacked{"Mo/nonlazy.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'MO_NONLAZY';
  package Mo::nonlazy;my$M="Mo::";
  $VERSION=0.39;
  *{$M.'nonlazy::e'}=sub{${shift().':N'}=1};
MO_NONLAZY

$fatpacked{"Mo/option.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'MO_OPTION';
  package Mo::option;my$M="Mo::";
  $VERSION=0.39;
  *{$M.'option::e'}=sub{my($P,$e,$o)=@_;$o->{option}=sub{my($m,$n,%a)=@_;$a{option}or return$m;my$n2=$n;*{$P."read_$n2"}=sub{$_[0]->{$n2}};sub{$#_?$m->(@_):$m->(@_,1);$_[0]}}};
MO_OPTION

$fatpacked{"Mo/required.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'MO_REQUIRED';
  package Mo::required;my$M="Mo::";
  $VERSION=0.39;
  *{$M.'required::e'}=sub{my($P,$e,$o)=@_;$o->{required}=sub{my($m,$n,%a)=@_;if($a{required}){my$C=*{$P."new"}{CODE}||*{$M.Object::new}{CODE};no warnings 'redefine';*{$P."new"}=sub{my$s=$C->(@_);my%a=@_[1..$#_];die$n." required"if!exists$a{$n};$s}}$m}};
MO_REQUIRED

$fatpacked{"Mo/xs.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'MO_XS';
  package Mo::xs;my$M="Mo::";
  $VERSION=0.39;
  require Class::XSAccessor;*{$M.'xs::e'}=sub{my($P,$e,$o,$f)=@_;$P=~s/::$//;$e->{has}=sub{my($n,%a)=@_;Class::XSAccessor->import(class=>$P,accessors=>{$n=>$n})}if!grep!/^xs$/,@$f};
MO_XS

$fatpacked{"Module/Path/More.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'MODULE_PATH_MORE';
  package Module::Path::More;
  
  our $DATE = '2015-04-15'; 
  our $VERSION = '0.28'; 
  
  use 5.010001;
  use strict;
  use warnings;
  
  require Exporter;
  our @ISA       = qw(Exporter);
  our @EXPORT_OK = qw(module_path pod_path);
  
  my $SEPARATOR;
  
  our %SPEC;
  
  $SPEC{':package'} = {
      v => 1.1,
      summary => 'Get path to locally installed Perl module',
  };
  
  BEGIN {
      if ($^O =~ /^(dos|os2)/i) {
          $SEPARATOR = '\\';
      } elsif ($^O =~ /^MacOS/i) {
          $SEPARATOR = ':';
      } else {
          $SEPARATOR = '/';
      }
  }
  
  $SPEC{module_path} = {
      v => 1.1,
      summary => 'Get path to locally installed Perl module',
      description => <<'_',
  
  Search `@INC` (reference entries are skipped) and return path(s) to Perl module
  files with the requested name.
  
  This function is like the one from `Module::Path`, except with a different
  interface and more options (finding all matches instead of the first, the option
  of not absolutizing paths, finding `.pmc` & `.pod` files, finding module
  prefixes).
  
  _
      args => {
          module => {
              summary => 'Module name to search',
              schema  => 'str*',
              req     => 1,
              pos     => 0,
          },
          find_pm => {
              summary => 'Whether to find .pm files',
              schema  => 'bool',
              default => 1,
          },
          find_pmc => {
              summary => 'Whether to find .pmc files',
              schema  => 'bool',
              default => 1,
          },
          find_pod => {
              summary => 'Whether to find .pod files',
              schema  => 'bool',
              default => 0,
          },
          find_prefix => {
              summary => 'Whether to find module prefixes',
              schema  => 'bool',
              default => 0,
          },
          all => {
              summary => 'Return all results instead of just the first',
              schema  => 'bool',
              default => 0,
          },
          abs => {
              summary => 'Whether to return absolute paths',
              schema  => 'bool',
              default => 0,
          },
      },
      result => {
          schema => ['any' => of => ['str*', ['array*' => of => 'str*']]],
      },
      result_naked => 1,
  };
  sub module_path {
      my %args = @_;
  
      my $module = $args{module} or die "Please specify module";
  
      $args{abs}         //= 0;
      $args{all}         //= 0;
      $args{find_pm}     //= 1;
      $args{find_pmc}    //= 1;
      $args{find_pod}    //= 0;
      $args{find_prefix} //= 0;
  
      require Cwd if $args{abs};
  
      my @res;
      my $add = sub { push @res, $args{abs} ? Cwd::abs_path($_[0]) : $_[0] };
  
      my $relpath;
  
      ($relpath = $module) =~ s/::/$SEPARATOR/g;
      $relpath =~ s/\.(pm|pmc|pod)\z//i;
  
      foreach my $dir (@INC) {
          next if not defined($dir);
          next if ref($dir);
  
          my $prefix = $dir . $SEPARATOR . $relpath;
          if ($args{find_pmc}) {
              my $file = $prefix . ".pmc";
              if (-f $file) {
                  $add->($file);
                  last unless $args{all};
              }
          }
          if ($args{find_pm}) {
              my $file = $prefix . ".pm";
              if (-f $file) {
                  $add->($file);
                  last unless $args{all};
              }
          }
          if ($args{find_pod}) {
              my $file = $prefix . ".pod";
              if (-f $file) {
                  $add->($file);
                  last unless $args{all};
              }
          }
          if ($args{find_prefix}) {
              if (-d $prefix) {
                  $add->($prefix);
                  last unless $args{all};
              }
          }
      }
  
      if ($args{all}) {
          return \@res;
      } else {
          return @res ? $res[0] : undef;
      }
  }
  
  $SPEC{pod_path} = {
      v => 1.1,
      summary => 'Get path to locally installed POD',
      description => <<'_',
  
  This is a shortcut for:
  
      module_path(%args, find_pm=>0, find_pmc=>0, find_pod=>1, find_prefix=>0)
  
  _
      args => {
          module => {
              summary => 'Module name to search',
              schema  => 'str*',
              req     => 1,
              pos     => 0,
          },
          all => {
              summary => 'Return all results instead of just the first',
              schema  => 'bool',
              default => 0,
          },
          abs => {
              summary => 'Whether to return absolute paths',
              schema  => 'bool',
              default => 0,
          },
      },
      result => {
          schema => ['any' => of => ['str*', ['array*' => of => 'str*']]],
      },
      result_naked => 1,
  };
  sub pod_path {
      module_path(@_, find_pm=>0, find_pmc=>0, find_pod=>1, find_prefix=>0);
  }
  
  1;
  
  __END__
  
MODULE_PATH_MORE

$fatpacked{"Monkey/Patch/Action.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'MONKEY_PATCH_ACTION';
  package Monkey::Patch::Action;
  
  use 5.010;
  use warnings;
  use strict;
  
  our $VERSION = '0.04'; 
  
  use Monkey::Patch::Action::Handle;
  
  use Exporter qw(import);
  our @EXPORT_OK = qw(patch_package);
  our %EXPORT_TAGS = (all => \@EXPORT_OK);
  
  sub patch_package {
      my ($package, $subname, $action, $code, @extra) = @_;
  
      die "Please specify action" unless $action;
      if ($action eq 'delete') {
          die "code not needed for 'delete' action" if $code;
      } else {
          die "Please specify code" unless $code;
      }
  
      my $name = "$package\::$subname";
      my $type;
      if ($action eq 'add') {
          die "Adding $name: must not already exist" if defined(&$name);
          $type = 'sub';
      } elsif ($action eq 'replace') {
          die "Replacing $name: must already exist" unless defined(&$name);
          $type = 'sub';
      } elsif ($action eq 'add_or_replace') {
          $type = 'sub';
      } elsif ($action eq 'wrap') {
          die "Wrapping $name: must already exist" unless defined(&$name);
          $type = 'wrap';
      } elsif ($action eq 'delete') {
          $type = 'delete';
      } else {
          die "Unknown action '$action', please use either ".
              "wrap/add/replace/add_or_replace/delete";
      }
  
      my @caller = caller(0);
  
      Monkey::Patch::Action::Handle->new(
          package => $package,
          subname => $subname,
          extra   => \@extra,
          patcher => \@caller,
          code    => $code,
  
          -type   => $type,
      );
  }
  
  1;
  
  
  __END__
  
MONKEY_PATCH_ACTION

$fatpacked{"Monkey/Patch/Action/Handle.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'MONKEY_PATCH_ACTION_HANDLE';
  package Monkey::Patch::Action::Handle;
  
  use 5.010;
  use strict;
  use warnings;
  
  use Scalar::Util qw(weaken);
  use Sub::Delete;
  
  our $VERSION = '0.04'; 
  
  my %stacks;
  
  sub __find_previous {
      my ($stack, $code) = @_;
      state $empty = sub {};
  
      for my $i (1..$#$stack) {
          if ($stack->[$i][1] == $code) {
              return $stack->[$i-1][2] // $stack->[$i-1][1];
          }
      }
      $empty;
  }
  
  sub new {
      my ($class, %args) = @_;
  
      my $type = $args{-type};
      delete $args{-type};
  
      my $code = $args{code};
  
      my $name = "$args{package}::$args{subname}";
      my $stack;
      if (!$stacks{$name}) {
          $stacks{$name} = [];
          push @{$stacks{$name}}, [sub => \&$name] if defined(&$name);
      }
      $stack = $stacks{$name};
  
      my $self = bless \%args, $class;
  
      no strict 'refs';
      no warnings 'redefine';
      if ($type eq 'sub') {
          push @$stack, [$type => $code];
          *$name = $code;
      } elsif ($type eq 'delete') {
          $code = sub {};
          $args{code} = $code;
          push @$stack, [$type, $code];
          delete_sub $name;
      } elsif ($type eq 'wrap') {
          weaken($self);
          my $wrapper = sub {
              my $ctx = {
                  package => $self->{package},
                  subname => $self->{subname},
                  extra   => $self->{extra},
                  orig    => __find_previous($stack, $self->{code}),
              };
              unshift @_, $ctx;
              goto &{$self->{code}};
          };
          push @$stack, [$type => $code => $wrapper];
          *$name = $wrapper;
      }
  
      $self;
  }
  
  sub DESTROY {
      my $self = shift;
  
      my $name  = "$self->{package}::$self->{subname}";
      my $stack = $stacks{$name};
      my $code  = $self->{code};
  
      for my $i (0..$#$stack) {
          if($stack->[$i][1] == $code) {
              if ($stack->[$i+1]) {
                  if ($stack->[$i+1][0] eq 'wrap' &&
                          ($i == 0 || $stack->[$i-1][0] eq 'delete')) {
                      my $p = $self->{patcher};
                      warn "Warning: unapplying patch to $name ".
                          "(applied in $p->[1]:$p->[2]) before a wrapping patch";
                  }
              }
  
              no strict 'refs';
              if ($i == @$stack-1) {
                  if ($i) {
                      no warnings 'redefine';
                      if ($stack->[$i-1][0] eq 'delete') {
                          delete_sub $name;
                      } else {
                          *$name = $stack->[$i-1][2] // $stack->[$i-1][1];
                      }
                  } else {
                      delete_sub $name;
                  }
              }
              splice @$stack, $i, 1;
              last;
          }
      }
  }
  
  1;
  
  
  __END__
  
MONKEY_PATCH_ACTION_HANDLE

$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{"Params/Util.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PARAMS_UTIL';
  package Params::Util;
  
  
  use 5.00503;
  use strict;
  require overload;
  require Exporter;
  require Scalar::Util;
  require DynaLoader;
  
  use vars qw{$VERSION @ISA @EXPORT_OK %EXPORT_TAGS};
  
  $VERSION   = '1.07';
  @ISA       = qw{
  	Exporter
  	DynaLoader
  };
  @EXPORT_OK = qw{
  	_STRING     _IDENTIFIER
  	_CLASS      _CLASSISA   _SUBCLASS  _DRIVER  _CLASSDOES
  	_NUMBER     _POSINT     _NONNEGINT
  	_SCALAR     _SCALAR0
  	_ARRAY      _ARRAY0     _ARRAYLIKE
  	_HASH       _HASH0      _HASHLIKE
  	_CODE       _CODELIKE
  	_INVOCANT   _REGEX      _INSTANCE  _INSTANCEDOES
  	_SET        _SET0
  	_HANDLE
  };
  %EXPORT_TAGS = ( ALL => \@EXPORT_OK );
  
  eval {
  	local $ENV{PERL_DL_NONLAZY} = 0 if $ENV{PERL_DL_NONLAZY};
  	bootstrap Params::Util $VERSION;
  	1;
  } unless $ENV{PERL_PARAMS_UTIL_PP};
  
  my $SU = eval "$Scalar::Util::VERSION" || 0;
  if ( $SU >= 1.18 ) { 
  	Scalar::Util->import('looks_like_number');
  } else {
  	eval <<'END_PERL';
  sub looks_like_number {
  	local $_ = shift;
  
  	# checks from perlfaq4
  	return 0 if !defined($_);
  	if (ref($_)) {
  		return overload::Overloaded($_) ? defined(0 + $_) : 0;
  	}
  	return 1 if (/^[+-]?[0-9]+$/); # is a +/- integer
  	return 1 if (/^([+-]?)(?=[0-9]|\.[0-9])[0-9]*(\.[0-9]*)?([Ee]([+-]?[0-9]+))?$/); # a C float
  	return 1 if ($] >= 5.008 and /^(Inf(inity)?|NaN)$/i) or ($] >= 5.006001 and /^Inf$/i);
  
  	0;
  }
  END_PERL
  }
  
  
  
  
  
  
  
  eval <<'END_PERL' unless defined &_STRING;
  sub _STRING ($) {
  	(defined $_[0] and ! ref $_[0] and length($_[0])) ? $_[0] : undef;
  }
  END_PERL
  
  
  eval <<'END_PERL' unless defined &_IDENTIFIER;
  sub _IDENTIFIER ($) {
  	(defined $_[0] and ! ref $_[0] and $_[0] =~ m/^[^\W\d]\w*\z/s) ? $_[0] : undef;
  }
  END_PERL
  
  
  eval <<'END_PERL' unless defined &_CLASS;
  sub _CLASS ($) {
  	(defined $_[0] and ! ref $_[0] and $_[0] =~ m/^[^\W\d]\w*(?:::\w+)*\z/s) ? $_[0] : undef;
  }
  END_PERL
  
  
  eval <<'END_PERL' unless defined &_CLASSISA;
  sub _CLASSISA ($$) {
  	(defined $_[0] and ! ref $_[0] and $_[0] =~ m/^[^\W\d]\w*(?:::\w+)*\z/s and $_[0]->isa($_[1])) ? $_[0] : undef;
  }
  END_PERL
  
  
  eval <<'END_PERL' unless defined &_CLASSDOES;
  sub _CLASSDOES ($$) {
  	(defined $_[0] and ! ref $_[0] and $_[0] =~ m/^[^\W\d]\w*(?:::\w+)*\z/s and $_[0]->DOES($_[1])) ? $_[0] : undef;
  }
  END_PERL
  
  
  eval <<'END_PERL' unless defined &_SUBCLASS;
  sub _SUBCLASS ($$) {
  	(defined $_[0] and ! ref $_[0] and $_[0] =~ m/^[^\W\d]\w*(?:::\w+)*\z/s and $_[0] ne $_[1] and $_[0]->isa($_[1])) ? $_[0] : undef;
  }
  END_PERL
  
  
  eval <<'END_PERL' unless defined &_NUMBER;
  sub _NUMBER ($) {
  	( defined $_[0] and ! ref $_[0] and looks_like_number($_[0]) )
  	? $_[0]
  	: undef;
  }
  END_PERL
  
  
  eval <<'END_PERL' unless defined &_POSINT;
  sub _POSINT ($) {
  	(defined $_[0] and ! ref $_[0] and $_[0] =~ m/^[1-9]\d*$/) ? $_[0] : undef;
  }
  END_PERL
  
  
  eval <<'END_PERL' unless defined &_NONNEGINT;
  sub _NONNEGINT ($) {
  	(defined $_[0] and ! ref $_[0] and $_[0] =~ m/^(?:0|[1-9]\d*)$/) ? $_[0] : undef;
  }
  END_PERL
  
  
  eval <<'END_PERL' unless defined &_SCALAR;
  sub _SCALAR ($) {
  	(ref $_[0] eq 'SCALAR' and defined ${$_[0]} and ${$_[0]} ne '') ? $_[0] : undef;
  }
  END_PERL
  
  
  eval <<'END_PERL' unless defined &_SCALAR0;
  sub _SCALAR0 ($) {
  	ref $_[0] eq 'SCALAR' ? $_[0] : undef;
  }
  END_PERL
  
  
  eval <<'END_PERL' unless defined &_ARRAY;
  sub _ARRAY ($) {
  	(ref $_[0] eq 'ARRAY' and @{$_[0]}) ? $_[0] : undef;
  }
  END_PERL
  
  
  eval <<'END_PERL' unless defined &_ARRAY0;
  sub _ARRAY0 ($) {
  	ref $_[0] eq 'ARRAY' ? $_[0] : undef;
  }
  END_PERL
  
  
  eval <<'END_PERL' unless defined &_ARRAYLIKE;
  sub _ARRAYLIKE {
  	(defined $_[0] and ref $_[0] and (
  		(Scalar::Util::reftype($_[0]) eq 'ARRAY')
  		or
  		overload::Method($_[0], '@{}')
  	)) ? $_[0] : undef;
  }
  END_PERL
  
  
  eval <<'END_PERL' unless defined &_HASH;
  sub _HASH ($) {
  	(ref $_[0] eq 'HASH' and scalar %{$_[0]}) ? $_[0] : undef;
  }
  END_PERL
  
  
  eval <<'END_PERL' unless defined &_HASH0;
  sub _HASH0 ($) {
  	ref $_[0] eq 'HASH' ? $_[0] : undef;
  }
  END_PERL
  
  
  eval <<'END_PERL' unless defined &_HASHLIKE;
  sub _HASHLIKE {
  	(defined $_[0] and ref $_[0] and (
  		(Scalar::Util::reftype($_[0]) eq 'HASH')
  		or
  		overload::Method($_[0], '%{}')
  	)) ? $_[0] : undef;
  }
  END_PERL
  
  
  eval <<'END_PERL' unless defined &_CODE;
  sub _CODE ($) {
  	ref $_[0] eq 'CODE' ? $_[0] : undef;
  }
  END_PERL
  
  
  eval <<'END_PERL' unless defined &_CODELIKE;
  sub _CODELIKE($) {
  	(
  		(Scalar::Util::reftype($_[0])||'') eq 'CODE'
  		or
  		Scalar::Util::blessed($_[0]) and overload::Method($_[0],'&{}')
  	)
  	? $_[0] : undef;
  }
  END_PERL
  
  
  eval <<'END_PERL' unless defined &_INVOCANT;
  sub _INVOCANT($) {
  	(defined $_[0] and
  		(defined Scalar::Util::blessed($_[0])
  		or      
  		# We used to check for stash definedness, but any class-like name is a
  		# valid invocant for UNIVERSAL methods, so we stopped. -- rjbs, 2006-07-02
  		Params::Util::_CLASS($_[0]))
  	) ? $_[0] : undef;
  }
  END_PERL
  
  
  eval <<'END_PERL' unless defined &_INSTANCE;
  sub _INSTANCE ($$) {
  	(Scalar::Util::blessed($_[0]) and $_[0]->isa($_[1])) ? $_[0] : undef;
  }
  END_PERL
  
  
  eval <<'END_PERL' unless defined &_INSTANCEDOES;
  sub _INSTANCEDOES ($$) {
  	(Scalar::Util::blessed($_[0]) and $_[0]->DOES($_[1])) ? $_[0] : undef;
  }
  END_PERL
  
  
  eval <<'END_PERL' unless defined &_REGEX;
  sub _REGEX ($) {
  	(defined $_[0] and 'Regexp' eq ref($_[0])) ? $_[0] : undef;
  }
  END_PERL
  
  
  eval <<'END_PERL' unless defined &_SET;
  sub _SET ($$) {
  	my $set = shift;
  	_ARRAY($set) or return undef;
  	foreach my $item ( @$set ) {
  		_INSTANCE($item,$_[0]) or return undef;
  	}
  	$set;
  }
  END_PERL
  
  
  eval <<'END_PERL' unless defined &_SET0;
  sub _SET0 ($$) {
  	my $set = shift;
  	_ARRAY0($set) or return undef;
  	foreach my $item ( @$set ) {
  		_INSTANCE($item,$_[0]) or return undef;
  	}
  	$set;
  }
  END_PERL
  
  
  eval <<'END_PERL' unless defined &_HANDLE;
  sub _HANDLE {
  	my $it = shift;
  
  	# It has to be defined, of course
  	unless ( defined $it ) {
  		return undef;
  	}
  
  	# Normal globs are considered to be file handles
  	if ( ref $it eq 'GLOB' ) {
  		return $it;
  	}
  
  	# Check for a normal tied filehandle
  	# Side Note: 5.5.4's tied() and can() doesn't like getting undef
  	if ( tied($it) and tied($it)->can('TIEHANDLE') ) {
  		return $it;
  	}
  
  	# There are no other non-object handles that we support
  	unless ( Scalar::Util::blessed($it) ) {
  		return undef;
  	}
  
  	# Check for a common base classes for conventional IO::Handle object
  	if ( $it->isa('IO::Handle') ) {
  		return $it;
  	}
  
  
  	# Check for tied file handles using Tie::Handle
  	if ( $it->isa('Tie::Handle') ) {
  		return $it;
  	}
  
  	# IO::Scalar is not a proper seekable, but it is valid is a
  	# regular file handle
  	if ( $it->isa('IO::Scalar') ) {
  		return $it;
  	}
  
  	# Yet another special case for IO::String, which refuses (for now
  	# anyway) to become a subclass of IO::Handle.
  	if ( $it->isa('IO::String') ) {
  		return $it;
  	}
  
  	# This is not any sort of object we know about
  	return undef;
  }
  END_PERL
  
  
  eval <<'END_PERL' unless defined &_DRIVER;
  sub _DRIVER ($$) {
  	(defined _CLASS($_[0]) and eval "require $_[0];" and ! $@ and $_[0]->isa($_[1]) and $_[0] ne $_[1]) ? $_[0] : undef;
  }
  END_PERL
  
  1;
  
PARAMS_UTIL

$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-06-30'; 
  our $VERSION = '1.17'; 
  
  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;
      },
  );
  
  has extra_urls_for_version => (is=>'rw');
  
  
  
  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} = (-t STDOUT) ? 'json-pretty' : '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', 'no_ignore_case', 'bundling', '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 = [500, "Died: $err"] unless ref($err) eq 'ARRAY';
              if (%Devel::Confess::) {
                  require Scalar::Util;
                  my $id = Scalar::Util::refaddr($err);
                  my $stack_trace = $Devel::Confess::MESSAGES{$id};
                  $err->[1] .= "\n$stack_trace" if $stack_trace;
              }
              $err->[1] =~ s/\n+$//;
              $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-06-30'; 
  our $VERSION = '1.17'; 
  
  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';
      },
  );
  has validate_args => (
      is=>'rw',
      default => 1,
  );
  
  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(
              'Screen',
              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 $self->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"];
              }
          }
  
          if ($meta->{args_rels}) {
              my $schema = [hash => $meta->{args_rels}];
              my $sah = Data::Sah->new;
              my $hc  = $sah->get_compiler("human");
              my $cd  = $hc->init_cd;
              $cd->{args}{lang} //= $cd->{default_lang};
              my $v = Data::Sah::gen_validator($schema, {
                  return_type => 'str',
                  human_hash_values => {
                      field  => $hc->_xlt($cd, "argument"),
                      fields => $hc->_xlt($cd, "arguments"),
                  },
              });
              my $res = $v->($r->{args});
              if ($res) {
                  die [400, $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';
  
      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 @text;
  
      {
          my $meta = $r->{meta} = $self->get_meta($r, $self->url);
          push @text, $self->get_program_and_subcommand_name($r),
              " version ", ($meta->{entity_v} // "?"),
              ($meta->{entity_date} ? " ($meta->{entity_date})" : ''),
              "\n";
      }
  
      for my $url (@{ $self->extra_urls_for_version // [] }) {
          my $meta = $self->get_meta($r, $url);
          push @text, "  $url version ", ($meta->{entity_v} // "?"),
              ($meta->{entity_date} ? " ($meta->{entity_date})" : ''),
              "\n";
      }
  
      push @text, "  ", __PACKAGE__,
          " version ", ($Perinci::CmdLine::Lite::VERSION // "?"),
          ($Perinci::CmdLine::Lite::DATE ?
           " ($Perinci::CmdLine::Lite::DATE)":'');
  
      [200, "OK", join("", @text), {"x.perinci.cmdline._skip_format"=>1}];
  }
  
  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-06-30'; 
  our $VERSION = '1.17'; 
  
  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-16'; 
  our $VERSION = '0.29'; 
  
  use 5.010001;
  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/EnvResult.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PERINCI_OBJECT_ENVRESULT';
  package Perinci::Object::EnvResult;
  
  our $DATE = '2014-12-11'; 
  our $VERSION = '0.21'; 
  
  use 5.010;
  use strict;
  use warnings;
  
  sub new {
      my ($class, $res) = @_;
      $res //= [0, "", undef];
      my $obj = \$res;
      bless $obj, $class;
  }
  
  sub new_ok {
      my $class = shift;
      my $res = [200, "OK"];
      if (@_) {
          push @$res, $_[0];
      }
      $class->new($res);
  }
  
  sub status {
      my ($self, $new) = @_;
      if (defined $new) {
          die "Status must be an integer between 100 and 555" unless
              int($new) eq $new && $new >= 100 && $new <= 555;
          my $old = ${$self}->[0];
          ${$self}->[0] = $new;
          return $old;
      }
      ${$self}->[0];
  }
  
  sub message {
      my ($self, $new) = @_;
      if (defined $new) {
          die "Extra must be a string" if ref($new);
          my $old = ${$self}->[1];
          ${$self}->[1] = $new;
          return $old;
      }
      ${$self}->[1];
  }
  
  
  sub payload {
      my ($self, $new) = @_;
      if (defined $new) {
          my $old = ${$self}->[2];
          ${$self}->[2] = $new;
          return $old;
      }
      ${$self}->[2];
  }
  
  sub meta {
      my ($self, $new) = @_;
      if (defined $new) {
          die "Extra must be a hashref" unless ref($new) eq 'HASH';
          my $old = ${$self}->[3];
          ${$self}->[3] = $new;
          return $old;
      }
      ${$self}->[3];
  }
  
  sub is_success {
      my ($self) = @_;
      my $status = ${$self}->[0];
      $status >= 200 && $status <= 299;
  }
  
  sub as_struct {
      my ($self) = @_;
      ${$self};
  }
  
  1;
  
  __END__
  
PERINCI_OBJECT_ENVRESULT

$fatpacked{"Perinci/Object/EnvResultMulti.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PERINCI_OBJECT_ENVRESULTMULTI';
  package Perinci::Object::EnvResultMulti;
  
  our $DATE = '2014-12-11'; 
  our $VERSION = '0.21'; 
  
  use 5.010;
  use strict;
  use warnings;
  
  use parent qw(Perinci::Object::EnvResult);
  
  sub new {
      my ($class, $res) = @_;
      $res //= [200, "Success/no items"];
      my $obj = \$res;
      bless $obj, $class;
  }
  
  sub add_result {
      my ($self, $status, $message, $extra) = @_;
      my $num_ok  = 0;
      my $num_nok = 0;
  
      push @{ ${$self}->[3]{results} },
          {%{ $extra // {} }, status=>$status, message=>$message};
      for (@{ ${$self}->[3]{results} // [] }) {
          if ($_->{status} =~ /\A(2|304)/) {
              $num_ok++;
          } else {
              $num_nok++;
          }
      }
      if ($num_ok) {
          if ($num_nok) {
              ${$self}->[0] = 207;
              ${$self}->[1] = "Partial success";
          } else {
              ${$self}->[0] = 200;
              ${$self}->[1] = "All success";
          }
      } else {
          ${$self}->[0] = $status;
          ${$self}->[1] = $message;
      }
  }
  
  1;
  
  __END__
  
PERINCI_OBJECT_ENVRESULTMULTI

$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/Object/Package.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PERINCI_OBJECT_PACKAGE';
  package Perinci::Object::Package;
  
  our $DATE = '2014-12-11'; 
  our $VERSION = '0.21'; 
  
  use 5.010;
  use strict;
  use warnings;
  
  use parent qw(Perinci::Object::Metadata);
  
  sub type { "package" }
  
  1;
  
  __END__
  
PERINCI_OBJECT_PACKAGE

$fatpacked{"Perinci/Object/ResMeta.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PERINCI_OBJECT_RESMETA';
  package Perinci::Object::ResMeta;
  
  our $DATE = '2014-12-11'; 
  our $VERSION = '0.21'; 
  
  use 5.010;
  use strict;
  use warnings;
  
  use parent qw(Perinci::Object::Metadata);
  
  sub type { "resmeta" }
  
  1;
  
  __END__
  
PERINCI_OBJECT_RESMETA

$fatpacked{"Perinci/Object/Variable.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PERINCI_OBJECT_VARIABLE';
  package Perinci::Object::Variable;
  
  our $DATE = '2014-12-11'; 
  our $VERSION = '0.21'; 
  
  use 5.010;
  use strict;
  use warnings;
  
  use parent qw(Perinci::Object::Metadata);
  
  sub type { "variable" }
  
  1;
  
  __END__
  
PERINCI_OBJECT_VARIABLE

$fatpacked{"Perinci/Sub/ArgEntity.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PERINCI_SUB_ARGENTITY';
  package Perinci::Sub::ArgEntity;
  
  our $DATE = '2015-03-01'; 
  our $VERSION = '0.01'; 
  
  1;
  
  __END__
  
PERINCI_SUB_ARGENTITY

$fatpacked{"Perinci/Sub/CoerceArgs.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PERINCI_SUB_COERCEARGS';
  package Perinci::Sub::CoerceArgs;
  
  our $DATE = '2015-05-17'; 
  our $VERSION = '0.04'; 
  
  use 5.010001;
  use strict;
  use warnings;
  
  use Exporter;
  our @ISA = qw(Exporter);
  our @EXPORT_OK = qw(
                         coerce_args
                 );
  
  our %SPEC;
  
  
  sub _coerce_to_datetime {
      my ($args, $arg_name) = @_;
  
      my $val = $args->{$arg_name};
  
      if ($val =~ /\A\d{8,}\z/) {
          require DateTime;
          $args->{$arg_name} = DateTime->from_epoch(
              epoch => $val,
              time_zone => $ENV{TZ} // "UTC",
          );
          return [200];
      } 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",
          );
          return [200];
      } else {
          return [400, "Can't coerce DateTime object " .
                   "'$arg_name' from '$args->{$arg_name}'"];
      }
  }
  
  sub _coerce_to_datetime_duration {
      my ($args, $arg_name) = @_;
  
      my $val = $args->{$arg_name};
  
      if ($val =~ /\AP
                   (?:([0-9]+(?:\.[0-9]+)?)Y)?
                   (?:([0-9]+(?:\.[0-9]+)?)M)?
                   (?:([0-9]+(?:\.[0-9]+)?)W)?
                   (?:([0-9]+(?:\.[0-9]+)?)D)?
                   (?: T
                       (?:([0-9]+(?:\.[0-9]+)?)H)?
                       (?:([0-9]+(?:\.[0-9]+)?)M)?
                       (?:([0-9]+(?:\.[0-9]+)?)S)?
                   )?\z/x) {
          require DateTime::Duration;
          $args->{$arg_name} = DateTime::Duration->new(
              years   => $1 || 0,
              months  => $2 || 0,
              weeks   => $3 || 0,
              days    => $4 || 0,
              hours   => $5 || 0,
              minutes => $6 || 0,
              seconds => $7 || 0,
          );
          return [200];
      } else {
          return [400, "Can't coerce DateTime::Duration object " .
                      "'$arg_name' from '$args->{$arg_name}'"];
      }
  }
  
  sub _coerce_to_time_moment {
      my ($args, $arg_name) = @_;
  
      my $val = $args->{$arg_name};
  
      if ($val =~ /\A\d{8,}\z/) {
          require Time::Moment;
          $args->{$arg_name} = Time::Moment->from_epoch($val);
          return [200];
      } 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,
          );
          return [200];
      } else {
          return [400, "Can't coerce Time::Moment object " .
                      "'$arg_name' from '$args->{$arg_name}'"];
      }
  }
  
  $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') {
                      my $coerce_res = _coerce_to_datetime($args, $arg_name);
                      return $coerce_res unless $coerce_res->[0] == 200;
                  } elsif ($class eq 'DateTime::Duration') {
                      my $coerce_res = _coerce_to_datetime_duration($args, $arg_name);
                      return $coerce_res unless $coerce_res->[0] == 200;
                  } elsif ($class eq 'Time::Moment') {
                      my $coerce_res = _coerce_to_time_moment($args, $arg_name);
                      return $coerce_res unless $coerce_res->[0] == 200;
                  }
              } elsif ($schema->[0] eq 'date' &&
                           $arg_spec->{'x.perl.coerce_to_datetime_obj'}) {
                  my $coerce_res = _coerce_to_datetime($args, $arg_name);
                  return $coerce_res unless $coerce_res->[0] == 200;
              } elsif ($schema->[0] eq 'date' &&
                           $arg_spec->{'x.perl.coerce_to_time_moment_obj'}) {
                  my $coerce_res = _coerce_to_time_moment($args, $arg_name);
                  return $coerce_res unless $coerce_res->[0] == 200;
              } elsif ($schema->[0] eq 'duration' &&
                           $arg_spec->{'x.perl.coerce_to_datetime_duration_obj'}) {
                  my $coerce_res = _coerce_to_datetime_duration($args, $arg_name);
                  return $coerce_res unless $coerce_res->[0] == 200;
              }
          } 
      }
  
      [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-27'; 
  our $VERSION = '0.79'; 
  
  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/ConvertArgs/Argv.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PERINCI_SUB_CONVERTARGS_ARGV';
  package Perinci::Sub::ConvertArgs::Argv;
  
  use 5.010001;
  use strict;
  use warnings;
  
  use Exporter;
  our @ISA = qw(Exporter);
  our @EXPORT_OK = qw(convert_args_to_argv);
  
  our $VERSION = '0.04'; 
  
  our %SPEC;
  
  sub _json {
      require JSON;
      state $json = JSON->new->allow_nonref;
      $json->encode($_[0]);
  }
  
  sub _encode {
      ref($_[0]) ? _json($_[0]) : $_[0];
  }
  
  $SPEC{convert_args_to_argv} = {
      v => 1.1,
      summary => 'Convert hash arguments to command-line options (and arguments)',
      description => <<'_',
  
  Convert hash arguments to command-line arguments. This is the reverse of
  `Perinci::Sub::GetArgs::Argv::get_args_from_argv`.
  
  Note: currently the function expects schemas in metadata to be normalized
  already.
  
  _
      args => {
          args => {req=>1, schema=>'hash*', pos=>0},
          meta => {req=>0, schema=>'hash*', pos=>1},
          use_pos => {
              summary => 'Whether to use positional arguments',
              schema  => 'bool',
              description => <<'_',
  
  For example, given this metadata:
  
      {
          v => 1.1,
          args => {
            arg1 => {pos=>0, req=>1},
            arg2 => {pos=>1},
            arg3 => {},
          },
      }
  
  then under `use_pos=0` the hash `{arg1=>1, arg2=>2, arg3=>'a b'}` will be
  converted to `['--arg1', 1, '--arg2', 2, '--arg3', 'a b']`. Meanwhile if
  `use_pos=1` the same hash will be converted to `[1, 2, '--arg3', 'a b']`.
  
  _
          },
      },
  };
  sub convert_args_to_argv {
      my %fargs = @_;
  
      my $iargs = $fargs{args} or return [400, "Please specify args"];
      my $meta  = $fargs{meta} // {v=>1.1};
      my $args_prop = $meta->{args} // {};
  
      my $v = $meta->{v} // 1.0;
      return [412, "Sorry, only metadata version 1.1 is supported (yours: $v)"]
          unless $v == 1.1;
  
      my @argv;
      my %iargs = %$iargs; 
  
      if ($fargs{use_pos}) {
          for (sort {$args_prop->{$a}{pos} <=> $args_prop->{$b}{pos}}
                   grep {defined $args_prop->{$_}{pos}} keys %iargs) {
              $argv[ $args_prop->{$_}{pos} ] = _encode($iargs{$_});
              delete $iargs{$_};
          }
      }
  
      for (sort keys %iargs) {
          my $is_bool = $args_prop->{$_}{schema} &&
              $args_prop->{$_}{schema}[0] eq 'bool';
          my $opt = $_; $opt =~ s/_/-/g;
          my $dashopt = length($opt) > 1 ? "--$opt" : "-$opt";
          if ($is_bool) {
              if ($iargs{$_}) {
                  push @argv, $dashopt;
              } else {
                  push @argv, "--no$opt";
              }
          } else {
              if (ref $iargs{$_}) {
                  push @argv, "$dashopt-json", _encode($iargs{$_});
              } else {
                  push @argv, $dashopt, "$iargs{$_}";
              }
          }
      }
      [200, "OK", \@argv];
  }
  
  1;
  
  __END__
  
PERINCI_SUB_CONVERTARGS_ARGV

$fatpacked{"Perinci/Sub/ConvertArgs/Array.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PERINCI_SUB_CONVERTARGS_ARRAY';
  package Perinci::Sub::ConvertArgs::Array;
  
  our $DATE = '2014-07-18'; 
  our $VERSION = '0.06'; 
  
  use 5.010001;
  use strict;
  use warnings;
  
  use Exporter;
  our @ISA = qw(Exporter);
  our @EXPORT_OK = qw(convert_args_to_array);
  
  our %SPEC;
  
  $SPEC{convert_args_to_array} = {
      v => 1.1,
      summary => 'Convert hash arguments to array',
      description => <<'_',
  
  Using information in 'args' property (particularly the 'pos' and 'greedy' of
  each argument spec), convert hash arguments to array.
  
  Example:
  
      my $meta = {
          v => 1.1,
          summary => 'Multiply 2 numbers (a & b)',
          args => {
              a => ['num*' => {arg_pos=>0}],
              b => ['num*' => {arg_pos=>1}],
          }
      }
  
  then 'convert_args_to_array(args=>{a=>2, b=>3}, meta=>$meta)' will produce:
  
      [200, "OK", [2, 3]]
  
  _
      args => {
          args => {req=>1, schema=>'hash*', pos=>0},
          meta => {req=>1, schema=>'hash*', pos=>1},
      },
  };
  sub convert_args_to_array {
      my %input_args   = @_;
      my $args         = $input_args{args} or return [400, "Please specify args"];
      my $meta         = $input_args{meta} or return [400, "Please specify meta"];
      my $args_prop    = $meta->{args} // {};
  
      my $v = $meta->{v} // 1.0;
      return [412, "Sorry, only metadata version 1.1 is supported (yours: $v)"]
          unless $v == 1.1;
  
  
      my @array;
  
      while (my ($k, $v) = each %$args) {
          my $as = $args_prop->{$k};
          return [412, "Argument $k: Not specified in args property"] unless $as;
          my $pos = $as->{pos};
          return [412, "Argument $k: No pos specified in arg spec"]
              unless defined $pos;
          if ($as->{greedy}) {
              $v = [$v] if ref($v) ne 'ARRAY';
              for (@array .. $pos-1) {
                  $array[$_] = undef;
              }
              splice @array, $pos, 0, @$v;
          } else {
              $array[$pos] = $v;
          }
      }
      [200, "OK", \@array];
  }
  
  1;
  
  __END__
  
PERINCI_SUB_CONVERTARGS_ARRAY

$fatpacked{"Perinci/Sub/GetArgs/Argv.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PERINCI_SUB_GETARGS_ARGV';
  package Perinci::Sub::GetArgs::Argv;
  
  our $DATE = '2015-05-20'; 
  our $VERSION = '0.68'; 
  
  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|date|duration)$/;
  
  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';
  
      state $yaml_xs_available = do {
          if (eval { require YAML::XS; 1 }) {
              1;
          } else {
              require YAML::Old;
              0;
          }
      };
  
      my $str = shift;
  
      my $res;
      eval {
          if ($yaml_xs_available) {
              $res = YAML::XS::Load($str);
          } else {
              $str = "--- $str" unless $str =~ /\A--- /;
              $str .= "\n" unless $str =~ /\n\z/;
              $res = YAML::Old::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};
          }
      }
  
      [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-04-24'; 
  our $VERSION = '0.11'; 
  
  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) {
          die "Invalid prop/attr syntax '$k', must be word/dotted-word only"
              unless $k =~ /\A(\w+)(?:\.(\w+(?:\.\w+)*))?(?:\((\w+)\))?\z/;
  
          my ($prop, $attr);
          if (defined $3) {
              $prop = $1;
              $attr = defined($2) ? "$2.alt.lang.$3" : "alt.lang.$3";
          } else {
              $prop = $1;
              $attr = $2;
          }
  
          my $nk = "$prop" . (defined($attr) ? ".$attr" : "");
  
          if ($prop =~ /\A_/ || defined($attr) && $attr =~ /\A_|\._/) {
              unless ($opt_rip) {
                  $nmeta->{$nk} = $meta->{$k};
              }
              next KEY;
          }
  
          my $prop_proplist = $proplist->{$prop};
  
          if (!$opt_aup && !$prop_proplist) {
              $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 $opt_aup || $prop_proplist;
  
          if ($prop_proplist && $prop_proplist->{_prop}) {
              die "Property '$prefix/$prop' must be a hash"
                  unless ref($meta->{$k}) eq 'HASH';
              $nmeta->{$nk} = {};
              _normalize(
                  $meta->{$k},
                  $prop_proplist->{_ver},
                  $opts,
                  $prop_proplist->{_prop},
                  $nmeta->{$nk},
                  "$prefix/$prop",
              );
          } elsif ($prop_proplist && $prop_proplist->{_elem_prop}) {
              die "Property '$prefix/$prop' must be an array"
                  unless ref($meta->{$k}) eq 'ARRAY';
              $nmeta->{$nk} = [];
              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->{$nk} }, $href;
                  } else {
                      push @{ $nmeta->{$nk} }, $_;
                  }
                  $i++;
              }
          } elsif ($prop_proplist && $prop_proplist->{_value_prop}) {
              die "Property '$prefix/$prop' must be a hash"
                  unless ref($meta->{$k}) eq 'HASH';
              $nmeta->{$nk} = {};
              for (keys %{ $meta->{$k} }) {
                  $nmeta->{$nk}{$_} = {};
                  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->{$nk}{$_},
                      "$prefix/$prop/$_",
                      ($prop eq 'args' ? "$prefix/arg" : undef),
                  );
              }
          } else {
              if ($k eq 'schema' && $opt_nss) { 
                  require Data::Sah::Normalize;
                  $nmeta->{$nk} = Data::Sah::Normalize::normalize_schema(
                      $meta->{$k});
              } else {
                  $nmeta->{$nk} = $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{"Perinci/Sub/Util/ResObj.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PERINCI_SUB_UTIL_RESOBJ';
  package Perinci::Sub::Util::ResObj;
  
  our $DATE = '2015-01-04'; 
  our $VERSION = '0.41'; 
  
  use Carp;
  use overload
      q("") => sub {
          my $res = shift; "ERROR $err->[0]: $err->[1]\n" . Carp::longmess();
      };
  
  1;
  
  __END__
  
PERINCI_SUB_UTIL_RESOBJ

$fatpacked{"Perinci/Sub/Util/Sort.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PERINCI_SUB_UTIL_SORT';
  package Perinci::Sub::Util::Sort;
  
  our $DATE = '2015-01-04'; 
  our $VERSION = '0.41'; 
  
  use 5.010;
  use strict;
  use warnings;
  
  require Exporter;
  our @ISA = qw(Exporter);
  our @EXPORT_OK = qw(
                         sort_args
                 );
  
  our %SPEC;
  
  sub sort_args {
      my $args = shift;
      sort {
          (($args->{$a}{pos} // 9999) <=> ($args->{$b}{pos} // 9999)) ||
              $a cmp $b
          } keys %$args;
  }
  
  1;
  
  __END__
  
PERINCI_SUB_UTIL_SORT

$fatpacked{"Progress/Any.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PROGRESS_ANY';
  package Progress::Any;
  
  our $DATE = '2015-01-27'; 
  our $VERSION = '0.20'; 
  
  use 5.010001;
  use strict;
  use warnings;
  
  use Time::Duration qw();
  use Time::HiRes qw(time);
  
  sub import {
      my ($self, @args) = @_;
      my $caller = caller();
      for (@args) {
          if ($_ eq '$progress') {
              my $progress = $self->get_indicator(task => '');
              {
                  no strict 'refs';
                  my $v = "$caller\::progress";
                  *$v = \$progress;
              }
          } else {
              die "Unknown import argument: $_";
          }
      }
  }
  
  our %indicators;  
  
  our %outputs;     
  
  our %output_data; 
  
  
  sub _init_indicator {
      my ($class, $task) = @_;
  
  
      return $indicators{$task} if $indicators{$task};
  
      my $progress = bless({
          task        => $task,
          title       => $task,
          target      => 0,
          pos         => 0,
          state       => 'stopped',
  
          _remaining          => undef,
          _set_remaining_time => undef,
          _elapsed            => 0,
          _start_time         => 0,
      }, $class);
      $indicators{$task} = $progress;
  
      if ($task =~ s/\.?\w+\z//) {
          $class->_init_indicator($task);
      }
  
      $progress;
  }
  
  sub get_indicator {
      my ($class, %args) = @_;
  
      my %oargs = %args;
  
      my $task   = delete($args{task});
      if (!defined($task)) {
          my @caller = caller(0);
          $task = $caller[0] eq '(eval)' ? 'main' : $caller[0];
          $task =~ s/::/./g;
          $task =~ s/[^.\w]+/_/g;
      }
      die "Invalid task syntax '$task', please only use dotted words"
          unless $task =~ /\A(?:\w+(\.\w+)*)?\z/;
  
      my %uargs;
  
      my $p = $class->_init_indicator($task);
      for my $an (qw/title target pos remaining state/) {
          if (exists $args{$an}) {
              $uargs{$an} = delete($args{$an});
          }
      }
      die "Unknown argument(s) to get_indicator(): ".join(", ", keys(%args))
          if keys(%args);
      $p->_update(%uargs) if keys %uargs;
  
      $p;
  }
  
  my %attrs = (
      title     => {is => 'rw'},
      target    => {is => 'rw'},
      pos       => {is => 'rw'},
      state     => {is => 'rw'},
  );
  
  for my $an (keys %attrs) {
      next if $attrs{$an}{manual};
      my $code;
      if ($attrs{$an}{is} eq 'rw') {
          $code = sub {
              my $self = shift;
              if (@_) {
                  $self->_update($an => shift);
              }
              $self->{$an};
          };
      } else {
          $code = sub {
              my $self = shift;
              die "Can't set value, $an is an ro attribute" if @_;
              $self->{$an};
          };
      }
      no strict 'refs';
      *{$an} = $code;
  }
  
  sub elapsed {
      my $self = shift;
  
      if ($self->{state} eq 'started') {
          return $self->{_elapsed} + (time()-$self->{_start_time});
      } else {
          return $self->{_elapsed};
      }
  }
  
  sub total_pos {
      my $self = shift;
  
      my $t = $self->{task};
  
      my $res = $self->{pos};
      for (keys %indicators) {
          if ($t eq '') {
              next if $_ eq '';
          } else {
              next unless index($_, "$t.") == 0;
          }
          $res += $indicators{$_}{pos};
      }
      $res;
  }
  
  sub total_target {
      my $self = shift;
  
      my $t = $self->{task};
  
      my $res = $self->{target};
      return undef unless defined($res);
  
      for (keys %indicators) {
          if ($t eq '') {
              next if $_ eq '';
          } else {
              next unless index($_, "$t.") == 0;
          }
          return undef unless defined $indicators{$_}{target};
          $res += $indicators{$_}{target};
      }
      $res;
  }
  
  sub percent_complete {
      my $self = shift;
  
      my $total_pos    = $self->total_pos;
      my $total_target = $self->total_target;
  
      return undef unless defined($total_target);
      if ($total_target == 0) {
          if ($self->{state} eq 'finished') {
              return 100;
          } else {
              return 0;
          }
      } else {
          return $total_pos / $total_target * 100;
      }
  }
  
  sub remaining {
      my $self = shift;
  
      if (defined $self->{_remaining}) {
          if ($self->{state} eq 'started') {
              my $r = $self->{_remaining}-(time()-$self->{_set_remaining_time});
              return $r > 0 ? $r : 0;
          } else {
              return $self->{_remaining};
          }
      } else {
          if (defined $self->{target}) {
              if ($self->{pos} == 0) {
                  return 0;
              } else {
                  return ($self->{target} - $self->{pos})/$self->{pos} *
                      $self->elapsed;
              }
          } else {
              return undef;
          }
      }
  }
  
  sub total_remaining {
      my $self = shift;
  
      my $t = $self->{task};
  
      my $res = $self->remaining;
      return undef unless defined $res;
  
      for (keys %indicators) {
          if ($t eq '') {
              next if $_ eq '';
          } else {
              next unless index($_, "$t.") == 0;
          }
          my $res2 = $indicators{$_}->remaining;
          return undef unless defined $res2;
          $res += $res2;
      }
      $res;
  }
  
  sub _update {
      my ($self, %args) = @_;
  
  
      my $now = time();
  
      my $task = $self->{task};
  
    SET_TITLE:
      {
          last unless exists $args{title};
          my $val = $args{title};
          die "Invalid value for title, must be defined"
              unless defined($val);
          $self->{title} = $val;
      }
  
    SET_TARGET:
      {
          last unless exists $args{target};
          my $val = $args{target};
          die "Invalid value for target, must be a positive number or undef"
              unless !defined($val) || $val >= 0;
          if (defined($val) && $self->{pos} > $val) {
              $self->{pos} = $val;
          }
          $self->{target} = $val;
          undef $self->{_remaining};
      }
  
    SET_POS:
      {
          last unless exists $args{pos};
          my $val = $args{pos};
          die "Invalid value for pos, must be a positive number"
              unless defined($val) && $val >= 0;
          if (defined($self->{target}) && $val > $self->{target}) {
              $val = $self->{target};
          }
          $self->{pos} = $val;
          undef $self->{_remaining};
      }
  
    SET_REMAINING:
      {
          last unless exists $args{remaining};
          my $val = $args{remaining};
          die "Invalid value for remaining, must be a positive number"
              unless defined($val) && $val >= 0;
          $self->{_remaining} = $val;
          $self->{_set_remaining_time} = $now;
      }
  
    SET_STATE:
      {
          last unless exists $args{state};
          my $old = $self->{state};
          my $val = $args{state} // 'started';
          die "Invalid value for state, must be stopped/started/finished"
              unless $val =~ /\A(?:stopped|started|finished)\z/;
          last if $old eq $val;
          if ($val eq 'started') {
              $self->{_start_time} = $now;
  
              my @parents;
              {
                  my $t = $task;
                  while (1) {
                      last unless $t =~ s/\.\w+\z//;
                      push @parents, $t;
                  }
                  push @parents, '';
              }
              for my $t (@parents) {
                  my $p = $indicators{$t};
                  if ($p->{state} ne 'started') {
                      $p->{state}       = 'started';
                      $p->{_start_time} = $now;
                  }
              }
          } else {
              $self->{_elapsed} += $now - $self->{_start_time};
              if ($val eq 'finished') {
                  die "BUG: Can't finish task '$task', pos is still < target"
                      if defined($self->{target}) &&
                          $self->{pos} < $self->{target};
                  $self->{_remaining} = 0;
                  $self->{_set_remaining_time} = $now;
              }
          }
          $self->{state} = $val;
      }
  
    DONE:
      return;
  }
  
  sub _should_update_output {
      my ($self, $output, $now) = @_;
  
      my $key = "$output";
      $output_data{$key} //= {};
      my $odata = $output_data{$key};
      if (!defined($odata->{mtime})) {
          return 1;
      } elsif ($self->{state} eq 'finished') {
          return 1;
      } elsif ($odata->{force_update}) {
          delete $odata->{force_update};
          return 1;
      } else {
          if (!defined($odata->{freq})) {
              $odata->{freq} = -0.5;
          }
          if ($odata->{freq} < 0) {
              return 1 if $now >= $odata->{mtime} - $odata->{freq};
          } else {
              return 1 if abs($self->{pos} - $odata->{pos}) >= $odata->{freq};
          }
          return 0;
      }
  }
  
  sub update {
      my ($self, %args) = @_;
  
      my $pos   = delete($args{pos}) // $self->{pos} + 1;
      my $state = delete($args{state}) // 'started';
      $self->_update(pos => $pos, state => $state);
  
      my $message  = delete($args{message});
      my $level    = delete($args{level});
      die "Unknown argument(s) to update(): ".join(", ", keys(%args))
          if keys(%args);
  
      my $now = time();
  
      {
          my $task = $self->{task};
          while (1) {
              if ($outputs{$task}) {
                  for my $output (@{ $outputs{$task} }) {
                      next unless $self->_should_update_output($output, $now);
                      if (ref($message) eq 'CODE') {
                          $message = $message->();
                      }
                      $output->update(
                          indicator => $indicators{$task},
                          message   => $message,
                          level     => $level,
                          time      => $now,
                      );
                      my $key = "$output";
                      $output_data{$key}{mtime} = $now;
                      $output_data{$key}{pos}   = $pos;
                  }
              }
              last unless $task =~ s/\.?\w+\z//;
          }
      }
  }
  
  sub start {
      my $self = shift;
      $self->_update(state => 'started');
  }
  
  sub stop {
      my $self = shift;
      $self->_update(state => 'stopped');
  }
  
  sub finish {
      my ($self, %args) = @_;
      $self->update(pos=>$self->{target}, state=>'finished', %args);
  }
  
  sub fill_template {
      my ($self, $template, %args) = @_;
  
  
      state $re = qr{( # all=1
                         %
                         ( #width=2
                             -?\d+ )?
                         ( #dot=3
                             \.?)
                         ( #prec=4
                             \d+)?
                         ( #conv=5
                             [emnPpRrTt%])
                     )}x;
  
      state $sub = sub {
          my %args = @_;
  
          my ($all, $width, $dot, $prec, $conv) = ($1, $2, $3, $4, $5);
  
          my $p = $args{indicator};
  
          my ($fmt, $sconv, $data);
          if ($conv eq 'n') {
              $data = $p->{task};
          } elsif ($conv eq 't') {
              $data = $p->{title};
          } elsif ($conv eq '%') {
              $data = '%';
          } elsif ($conv eq 'm') {
              $data = $args{message} // '';
          } elsif ($conv eq 'p') {
              my $val = $p->percent_complete;
              $width //= 3;
              if (defined $val) {
                  $data = $val;
                  $prec //= 0;
                  $sconv = "f";
              } else {
                  $data = '?';
              }
          } elsif ($conv eq 'P') {
              $data = $p->total_pos;
              $prec //= 0;
              $sconv = "f";
          } elsif ($conv eq 'T') {
              my $val = $p->total_target;
              if (defined $val) {
                  $data = $val;
                  $prec //= 0;
                  $sconv = "f";
              } else {
                  $data = '?';
              }
          } elsif ($conv eq 'e') {
              my $val = $p->elapsed;
              $val = 1 if $val < 1; 
              $data = Time::Duration::concise(Time::Duration::duration($val));
              $width //= -8;
          } elsif ($conv eq 'r') {
              my $val = $p->total_remaining;
              if (defined $val) {
                  $val = 1 if $val < 1; 
                  $data = Time::Duration::concise(Time::Duration::duration($val));
              } else {
                  $data = '?';
              }
              $width //= -8;
          } elsif ($conv eq 'R') {
              my $val = $p->total_remaining;
              if (defined $val) {
                  $val = 1 if $val < 1; 
                  $data = Time::Duration::concise(Time::Duration::duration($val)).
                      " left"; 
              } else {
                  $val = $p->elapsed;
                  $val = 1 if $val < 1; 
                  $data = Time::Duration::concise(Time::Duration::duration($val)).
                      " elapsed"; 
              }
              $width //= -(8 + 1 + 7);
          } else {
              $fmt = '%s';
              $data = $all;
          }
  
          $sconv //= 's';
          $dot = "." if $sconv eq 'f';
          $fmt //= join("", grep {defined} ("%", $width, $dot, $prec, $sconv));
  
          sprintf $fmt, $data;
  
      };
      $template =~ s{$re}{$sub->(%args, indicator=>$self)}egox;
  
      $template;
  }
  
  1;
  
  __END__
  
PROGRESS_ANY

$fatpacked{"Progress/Any/Output.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PROGRESS_ANY_OUTPUT';
  package Progress::Any::Output;
  
  our $DATE = '2015-01-27'; 
  our $VERSION = '0.20'; 
  
  use 5.010001;
  use strict;
  use warnings;
  
  require Progress::Any;
  
  sub import {
      my $self = shift;
      __PACKAGE__->set(@_) if @_;
  }
  
  sub _set_or_add {
      my $class = shift;
      my $which = shift;
  
      my $opts;
      if (@_ && ref($_[0]) eq 'HASH') {
          $opts = shift;
      } else {
          $opts = {};
      }
  
      my $output = shift or die "Please specify output name";
      $output =~ /\A(?:\w+(::\w+)*)?\z/ or die "Invalid output syntax '$output'";
  
      my $task = $opts->{task} // "";
  
      my $outputo;
      unless (ref $outputo) {
          my $outputpm = $output; $outputpm =~ s!::!/!g; $outputpm .= ".pm";
          require "Progress/Any/Output/$outputpm";
          no strict 'refs';
          $outputo = "Progress::Any::Output::$output"->new(@_);
      }
  
      if ($which eq 'set') {
          $Progress::Any::outputs{$task} = [$outputo];
      } else {
          $Progress::Any::outputs{$task} //= [];
          push @{ $Progress::Any::outputs{$task} }, $outputo;
      }
  
      $outputo;
  }
  
  sub set {
      my $class = shift;
      $class->_set_or_add('set', @_);
  }
  
  sub add {
      my $class = shift;
      $class->_set_or_add('add', @_);
  }
  
  1;
  
  __END__
  
PROGRESS_ANY_OUTPUT

$fatpacked{"Progress/Any/Output/Null.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PROGRESS_ANY_OUTPUT_NULL';
  package Progress::Any::Output::Null;
  
  use 5.010;
  use strict;
  use warnings;
  
  our $VERSION = '0.20'; 
  
  sub new {
      my ($class, %args) = @_;
      bless \%args, $class;
  }
  
  sub update {
      1;
  }
  
  1;
  
  __END__
  
PROGRESS_ANY_OUTPUT_NULL

$fatpacked{"Progress/Any/Output/TermProgressBarColor.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PROGRESS_ANY_OUTPUT_TERMPROGRESSBARCOLOR';
  package Progress::Any::Output::TermProgressBarColor;
  
  our $DATE = '2015-06-19'; 
  our $VERSION = '0.19'; 
  
  use 5.010001;
  use strict;
  use warnings;
  
  use Color::ANSI::Util qw(ansifg ansibg);
  use Text::ANSI::Util qw(ta_mbtrunc ta_mbswidth ta_length);
  require Win32::Console::ANSI if $^O =~ /Win/;
  
  $|++;
  
  my ($ph1, $ph2);
  
  sub _patch {
      my $out = shift;
  
      return if $ph1;
      require Monkey::Patch::Action;
      $ph1 = Monkey::Patch::Action::patch_package(
          'Log::Any::Adapter::Screen', 'hook_before_log', 'replace',
          sub {
              $out->cleanup;
              $Progress::Any::output_data{"$out"}{force_update} = 1;
          }
      ) if defined &{"Log::Any::Adapter::Screen::hook_before_log"};
      $ph2 = Monkey::Patch::Action::patch_package(
          'Log::Any::Adapter::Screen', 'hook_after_log', 'replace',
          sub {
              my ($self, $msg) = @_;
              print { $self->{_fh} } "\n" unless $msg =~ /\R\z/;
              $out->keep_delay_showing if $out->{show_delay};
          }
      ) if defined &{"Log::Any::Adapter::Screen::hook_after_log"};
  }
  
  sub _unpatch {
      undef $ph1;
      undef $ph2;
  }
  
  sub new {
      my ($class, %args0) = @_;
  
      my %args;
  
      $args{width} = delete($args0{width});
      if (!defined($args{width})) {
          my ($cols, $rows);
          if ($ENV{COLUMNS}) {
              $cols = $ENV{COLUMNS};
          } elsif (eval { require Term::Size; 1 }) {
              ($cols, $rows) = Term::Size::chars();
          } else {
              $cols = 80;
          }
          $args{width} = $^O =~ /Win/ ? $cols-1 : $cols;
      }
  
      $args{fh} = delete($args0{fh});
      $args{fh} //= \*STDOUT;
  
      $args{show_delay} = delete($args0{show_delay});
  
      keys(%args0) and die "Unknown output parameter(s): ".
          join(", ", keys(%args0));
  
      $args{_last_hide_time} = time();
  
      my $self = bless \%args, $class;
      $self->_patch;
      $self;
  }
  
  sub update {
      my ($self, %args) = @_;
  
      my $now = time();
  
      if (defined $self->{show_delay}) {
          return if $now - $self->{show_delay} < $self->{_last_hide_time};
      }
  
      my $ll = $self->{_lastlen};
      if (defined $self->{_lastlen}) {
          print { $self->{fh} } "\b" x $self->{_lastlen};
          undef $self->{_lastlen};
      }
  
      my $p = $args{indicator};
      my $tottgt = $p->total_target;
      my $totpos = $p->total_pos;
      my $is_complete = $p->{state} eq 'finished' ||
          defined($tottgt) && $tottgt > 0 && $totpos == $tottgt;
      if ($is_complete) {
          if ($ll) {
              my $fh = $self->{fh};
              print $fh " " x $ll, "\b" x $ll;
              $self->{_last_hide_time} = $now;
          }
          return;
      }
  
      my $bar;
      my $bar_pct = $p->fill_template("%p%% ", %args);
  
      my $bar_eta = $p->fill_template("%R", %args);
  
      my $bar_bar = "";
      my $bwidth = $self->{width} - length($bar_pct) - length($bar_eta) - 2;
      if ($bwidth > 0) {
          if ($tottgt) {
              my $bfilled = int($totpos / $tottgt * $bwidth);
              $bfilled = $bwidth if $bfilled > $bwidth;
              $bar_bar = ("=" x $bfilled) . (" " x ($bwidth-$bfilled));
  
              my $message = $args{message};
          } else {
              my $bfilled = int(0.15 * $bwidth);
              $bfilled = 1 if $bfilled < 1;
              $self->{_x}++;
              if ($self->{_x} > $bwidth-$bfilled) {
                  $self->{_x} = 0;
              }
              $bar_bar = (" " x $self->{_x}) . ("=" x $bfilled) .
                  (" " x ($bwidth-$self->{_x}-$bfilled));
          }
  
          my $msg = $args{message};
          if (defined $msg) {
              if ($msg =~ m!</elspan!) {
                  require String::Elide::Parts;
                  $msg = String::Elide::Parts::elide($msg, $bwidth);
              }
              $msg = ta_mbtrunc($msg, $bwidth);
              my $mwidth = ta_mbswidth($msg);
              $bar_bar = ansifg("808080") . $msg . ansifg("ff8000") .
                  substr($bar_bar, $mwidth);
          }
  
          $bar_bar = ansifg("ff8000") . $bar_bar;
      }
  
      $bar = join(
          "",
          ansifg("ffff00"), $bar_pct,
          "[$bar_bar]",
          ansifg("ffff00"), $bar_eta,
          "\e[0m",
      );
      print { $self->{fh} } $bar;
  
      $self->{_lastlen} = ta_length($bar);
  }
  
  sub cleanup {
      my ($self) = @_;
  
  
      my $ll = $self->{_lastlen};
      return unless $ll;
      print { $self->{fh} } "\b" x $ll, " " x $ll, "\b" x $ll;
  }
  
  sub keep_delay_showing {
      my $self = shift;
  
      $self->{_last_hide_time} = time();
  }
  
  sub DESTROY {
      my $self = shift;
      $self->_unpatch;
  }
  
  1;
  
  __END__
  
PROGRESS_ANY_OUTPUT_TERMPROGRESSBARCOLOR

$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{"Riap.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'RIAP';
  package Riap;
  
  our $DATE = '2015-03-05'; 
  our $VERSION = '1.2.3'; 
  
  1;
  
  __END__
  
RIAP

$fatpacked{"Rinci.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'RINCI';
  package Rinci;
  
  our $VERSION = '1.1.77'; 
  
  1;
  
  __END__
  
RINCI

$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.000001';
  $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} ||= do {
        my $abbrev = substr $new_name, 0, 250 - length $role_suffix;
        $abbrev =~ s/(?<!:):$//;
        $abbrev.'__'.$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.000001';
  $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.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'SAH';
  package Sah;
  
  our $VERSION = '0.9.37'; 
  
  1;
  
  __END__
  
SAH

$fatpacked{"Sah/Schema/DefHash.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'SAH_SCHEMA_DEFHASH';
  package Sah::Schema::DefHash;
  
  use 5.010001;
  use strict;
  use warnings;
  
  our $VERSION = '1.0.10'; 
  our $DATE = '2015-04-24'; 
  
  our %SCHEMAS;
  
  $SCHEMAS{defhash} = [hash => {
      _prop => {
          v => {},
          defhash_v => {},
          name => {},
          caption => {},
          summary => {},
          description => {},
          tags => {},
          default_lang => {},
          x => {},
      },
  
      keys => {
  
          v         => ['float*', default=>1],
  
          defhash_v => ['int*', default=>1],
  
          name      => [
              'str*',
              'clset&' => [
                  {
                      match             => qr/\A\w+\z/,
                      'match.err_level' => 'warn',
                      'match.err_msg'   => 'should be a word',
                  },
                  {
                      max_len             => 32,
                      'max_len.err_level' => 'warn',
                      'max_len.err_msg'   => 'should be short',
                  },
              ],
          ],
  
          caption   => [
              'str*',
          ],
  
          summary   => [
              'str',
              'clset&' => [
                  {
                      max_len             => 72,
                      'max_len.err_level' => 'warn',
                      'max_len.err_msg'   => 'should be short',
                  },
                  {
                      'match'           => qr/\n/,
                      'match.op'        => 'not',
                      'match.err_level' => 'warn',
                      'match.err_msg'   => 'should only be a single-line text',
                  },
              ],
          ],
  
          description => [
              'str',
          ],
  
          tags => [
              'array',
              of => [
                  'any*',
                  of => [
                      'str*',
                      'hash*', 
                  ],
              ],
          ],
  
          default_lang => [
              'str*', 
          ],
  
          x => [
              'any',
          ],
      },
      'keys.restrict' => 0,
      'allowed_keys_re' => qr/\A\w+(\.\w+)*\z/,
  }];
  
  $SCHEMAS{defhash_v1} = [defhash => {
      keys => {
          defhash_v => ['int*', is=>1],
      },
  }];
  
  
  1;
  
  __END__
  
SAH_SCHEMA_DEFHASH

$fatpacked{"Sah/Schema/Rinci.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'SAH_SCHEMA_RINCI';
  package Sah::Schema::Rinci;
  
  our $DATE = '2015-05-01'; 
  our $VERSION = '1.1.77'; 
  
  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_rels => {},
          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{"Sah/Schema/Sah.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'SAH_SCHEMA_SAH';
  package Sah::Schema::Sah;
  
  use 5.010;
  use strict;
  use warnings;
  
  our $VERSION = '0.9.37'; 
  our $DATE = '2015-06-11'; 
  
  our %SCHEMAS;
  
  $SCHEMAS{sah_type_name} = ['str' => {
      match => '\A[A-Za-z][A-Za-z0-9_]*(::[A-Za-z][A-Za-z0-9_]*)*\z',
  }];
  
  $SCHEMAS{sah_str_schema} = ['str' => {
      match => '\A[A-Za-z][A-Za-z0-9_]*(::[A-Za-z][A-Za-z0-9_]*)*\*?\z',
  }];
  
  $SCHEMAS{sah_clause_name} = undef; 
  
  $SCHEMAS{sah_clause_set} = [defhash => {
      _prop => {
          v => {},
          defhash_v => {},
          name => {},
          summary => {},
          description => {},
          tags => {},
          default_lang => {},
          x => {},
  
          clause => {
          },
          clset => {
          },
      },
  }];
  
  
  $SCHEMAS{sah_extras} = [defhash => {
      _prop => {
          def => {},
      },
  }];
  
  $SCHEMAS{sah_array_schema} = ['array' => {
      elems => [
          'sah_type_name',
          'sah_clause_set',
          'sah_extras',
      ],
      min_len => 1,
  }];
  
  $SCHEMAS{sah_schema} = [any => {
      of => [
          'sah_str_schema',
          'sah_array_schema',
      ],
  }];
  
  1;
  
  
  __END__
  
  # commented temporarily, unfinished refactoring
  sub schemas {
      my $re_var_nameU   = '(?:[A-Za-z_][A-Za-z0-9_]*)'; # U = unanchored
      my $re_func_name   = '\A(?:'.$re_var_nameU.'::)*'.$re_var_nameU.'+\z';
      my $reu_var_name   = '(?:[A-Za-z_][A-Za-z0-9_]*)';
      my $re_clause_name = '\A(?:[a-z_][a-z0-9_]*)\z'; # no uppercase
      my $re_cattr_name  = '\A(?:'.$re_var_nameU.'\.)*'.$re_var_nameU.'+\z';
      my $re_clause_key  = ''; # XXX ':ATTR' or 'NAME' or 'NAME:ATTR'
  
      # R = has req=>1
      my $clause_setR = ['hash' => {
          keys_regex => $re_clause_key,
      }];
  
      my $str_schemaR = ['str*' => {
  
          # TODO: is_sah_str_shortcut
          #if => [not_match => $re_type_name, isa_sah_str_shortcut=>1],
  
          # for now, we don't support string shortcuts
          match => $re_type_name,
      }];
  
      # TODO: is_expr
  
      my $array_schemaR = ['array*' => {
          min_len    => 1,
          # the first clause set checks the type
          {
              elems => [$str_schemaR],
          },
  
          # the second clause set checks the clause set
          {
              # first we discard the type first
              prefilters => ['array_slice($_, 1)'],
              deps       => [
                  # no clause sets, e.g. ['int']
                  [[array => {len=>1}],
                   'any'], # do nothing, succeed
  
                  # a single clause set, flattened in the array, but there are odd
                  # number of elements, e.g. ['int', min=>1, 'max']
                  [[array => {elems=>['str*'], check=>'array_len($_) % 2 != 0'}],
                   ['any', fail=>1,
                    err_msg=>'Odd number of elements in clause set']],
  
                  # a single clause set, flattened in the array, with even number
                  # of elements, e.g. ['int', min=>1, max=>10]
                  [[array => {elems=>['str*']}],
                   $clause_setR],
  
                  # otherwise, all elements must be a clause set
                   ['any',
                    [array => {of => $clause_setR}]],
              ] # END deps
          },
  
      }];
  
      # predeclare
      my $hash_schemaR = ['hash*' => undef];
  
      my $schema => ['any' => {
          of   => [qw/str array hash/],
          deps => [
              ['str*'   => $str_schemaR],
              ['array*' => $array_schemaR],
              ['hash*'  => $hash_schemaR],
          ],
      }];
  
      my $defR = ['hash*' => {
          keys_of   => ['str*' => {,
                                   # remove optional '?' suffix
                                   prefilters => [q(replace('[?]\z', '', $_))],
                                   match      => $re_type_name,
                               }],
          values_of => $schema,
      }];
SAH_SCHEMA_SAH

$fatpacked{"Scalar/Util/Numeric/PP.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'SCALAR_UTIL_NUMERIC_PP';
  package Scalar::Util::Numeric::PP;
  
  our $DATE = '2015-06-16'; 
  our $VERSION = '0.03'; 
  
  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]+)? | (\.[0-9]+) )
                   ([eE][+-]?[0-9]+)?\z/x && $1 || $2 || $3;
      return 1 if isnan($_) || isinf($_);
      0;
  }
  
  1;
  
  __END__
  
SCALAR_UTIL_NUMERIC_PP

$fatpacked{"String/Elide/Parts.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'STRING_ELIDE_PARTS';
  package String::Elide::Parts;
  
  our $DATE = '2015-01-23'; 
  our $VERSION = '0.01'; 
  
  use 5.010001;
  use strict;
  use warnings;
  
  use Exporter;
  our @ISA = qw(Exporter);
  our @EXPORT_OK = qw(elide);
  
  sub _elide_part {
      my ($str, $len, $marker, $truncate) = @_;
  
      my $len_marker = length($marker);
      if ($len <= $len_marker) {
          return substr($marker, 0, $len);
      }
  
      if ($truncate eq 'left') {
          return $marker . substr($str, length($str) - $len+$len_marker);
      } elsif ($truncate eq 'middle') {
          my $left  = substr($str, 0,
                             ($len-$len_marker)/2);
          my $right = substr($str,
                             length($str) - ($len-$len_marker-length($left)));
          return $left . $marker . $right;
      } elsif ($truncate eq 'ends') {
          if ($len <= 2*$len_marker) {
              return substr($marker . $marker, 0, $len);
          }
          return $marker . substr($str, (length($str)-$len)/2 + $len_marker,
                                  $len-2*$len_marker) . $marker;
      } else { 
          return substr($str, 0, $len-$len_marker) . $marker;
      }
  }
  
  sub elide {
      my ($str, $len, $opts) = @_;
  
      $opts //= {};
      my $truncate  = $opts->{truncate} // 'right';
      my $marker = $opts->{marker} // '..';
  
      my @parts;
      my @parts_attrs;
      my $parts_len = 0;
      while ($str =~ m#<elspan([^>]*)>(.*?)</elspan>|(.*?)(?=<elspan)|(.*)#g) {
          if (defined $1) {
              next unless length $2;
              push @parts, $2;
              push @parts_attrs, $1;
          } elsif (defined $3) {
              next unless length $3;
              push @parts, $3;
              push @parts_attrs, undef;
          } elsif (defined $4) {
              next unless length $4;
              push @parts, $4;
              push @parts_attrs, undef;
          }
      }
      return "" unless @parts && $len > 0;
      for my $i (0..@parts-1) {
          $parts_len += length($parts[$i]);
          if (defined $parts_attrs[$i]) {
              my $attrs = {};
              $attrs->{truncate} = $1 // $2
                  if $parts_attrs[$i] =~ /\btruncate=(?:"([^"]*)"|(\S+))/;
              $attrs->{prio} = $1 // $2
                  if $parts_attrs[$i] =~ /\bprio(?:rity)?=(?:"([^"]*)"|(\S+))/;
              $parts_attrs[$i] = $attrs;
          } else {
              $parts_attrs[$i] = {prio=>1};
          }
      }
  
  
      my $flip = 0;
  
    PART:
      while (1) {
          if ($parts_len <= $len) {
              return join("", @parts);
          }
  
          my @indexes;
          my $highest_prio;
          for (@parts_attrs) {
              $highest_prio = $_->{prio} if !defined($highest_prio) ||
                  $highest_prio < $_->{prio};
          }
          for my $i (0..@parts_attrs-1) {
              push @indexes, $i if $parts_attrs[$i]{prio} == $highest_prio;
          }
  
          my $index;
          if ($truncate eq 'left') {
              $index = $indexes[0];
          } elsif ($truncate eq 'middle') {
              $index = $indexes[@indexes/2];
          } elsif ($truncate eq 'ends') {
              $index = $flip++ % 2 ? $indexes[0] : $indexes[-1];
          } else { 
              $index = $indexes[-1];
          }
  
          my $part_len = length($parts[$index]);
          if ($parts_len - $part_len >= $len) {
              $parts_len -= $part_len;
              splice @parts, $index, 1;
              splice @parts_attrs, $index, 1;
              next PART;
          }
  
          $parts[$index] = _elide_part(
              $parts[$index],
              $part_len - ($parts_len-$len),
              $marker,
              $parts_attrs[$index]{truncate} // $truncate,
          );
          return join("", @parts);
  
      } 
  }
  
  1;
  
  __END__
  
STRING_ELIDE_PARTS

$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/LineNumber.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'STRING_LINENUMBER';
  package String::LineNumber;
  
  our $DATE = '2014-12-10'; 
  our $VERSION = '0.01'; 
  
  use 5.010001;
  use strict;
  use warnings;
  
  use Exporter;
  our @ISA = qw(Exporter);
  our @EXPORT_OK = qw(
                         linenum
                 );
  
  sub linenum {
      my ($str, $opts) = @_;
      $opts //= {};
      $opts->{width}      //= 4;
      $opts->{zeropad}    //= 0;
      $opts->{skip_empty} //= 1;
  
      my $i = 0;
      $str =~ s/^(([\t ]*\S)?.*)/
          sprintf(join("",
                       "%",
                       ($opts->{zeropad} && !($opts->{skip_empty}
                                                  && !defined($2)) ? "0" : ""),
                       $opts->{width}, "s",
                       "|%s"),
                  ++$i && $opts->{skip_empty} && !defined($2) ? "" : $i,
                  $1)/meg;
  
      $str;
  }
  
  1;
  
  __END__
  
STRING_LINENUMBER

$fatpacked{"String/PerlQuote.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'STRING_PERLQUOTE';
  package String::PerlQuote;
  
  our $DATE = '2014-12-10'; 
  our $VERSION = '0.01'; 
  
  use 5.010001;
  use strict;
  use warnings;
  
  use Exporter;
  our @ISA = qw(Exporter);
  our @EXPORT_OK = qw(
                         single_quote
                         double_quote
                 );
  
  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 single_quote {
    local($_) = $_[0];
    s/([\\'])/\\$1/g;
    return qq('$_');
  }
  1;
  
  __END__
  
STRING_PERLQUOTE

$fatpacked{"String/ShellQuote.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'STRING_SHELLQUOTE';
  
  
  package String::ShellQuote;
  
  use strict;
  use vars qw($VERSION @ISA @EXPORT);
  
  require Exporter;
  
  $VERSION	= '1.04';
  @ISA		= qw(Exporter);
  @EXPORT		= qw(shell_quote shell_quote_best_effort shell_comment_quote);
  
  sub croak {
      require Carp;
      goto &Carp::croak;
  }
  
  sub _shell_quote_backend {
      my @in = @_;
      my @err = ();
  
      if (0) {
  	require RS::Handy;
  	print RS::Handy::data_dump(\@in);
      }
  
      return \@err, '' unless @in;
  
      my $ret = '';
      my $saw_non_equal = 0;
      foreach (@in) {
  	if (!defined $_ or $_ eq '') {
  	    $_ = "''";
  	    next;
  	}
  
  	if (s/\x00//g) {
  	    push @err, "No way to quote string containing null (\\000) bytes";
  	}
  
      	my $escape = 0;
  
  
  	if (/=/) {
  	    if (!$saw_non_equal) {
  	    	$escape = 1;
  	    }
  	}
  	else {
  	    $saw_non_equal = 1;
  	}
  
  	if (m|[^\w!%+,\-./:=@^]|) {
  	    $escape = 1;
  	}
  
  	if ($escape
  		|| (!$saw_non_equal && /=/)) {
  
      	    s/'/'\\''/g;
  
      	    s|((?:'\\''){2,})|q{'"} . (q{'} x (length($1) / 4)) . q{"'}|ge;
  
  	    $_ = "'$_'";
  	    s/^''//;
  	    s/''$//;
  	}
      }
      continue {
  	$ret .= "$_ ";
      }
  
      chop $ret;
      return \@err, $ret;
  }
  
  
  sub shell_quote {
      my ($rerr, $s) = _shell_quote_backend @_;
  
      if (@$rerr) {
      	my %seen;
      	@$rerr = grep { !$seen{$_}++ } @$rerr;
  	my $s = join '', map { "shell_quote(): $_\n" } @$rerr;
  	chomp $s;
  	croak $s;
      }
      return $s;
  }
  
  
  sub shell_quote_best_effort {
      my ($rerr, $s) = _shell_quote_backend @_;
  
      return $s;
  }
  
  
  sub shell_comment_quote {
      return '' unless @_;
      unless (@_ == 1) {
  	croak "Too many arguments to shell_comment_quote "
  	    	    . "(got " . @_ . " expected 1)";
      }
      local $_ = shift;
      s/\n/\n#/g;
      return $_;
  }
  
  1;
  
  __END__
  
STRING_SHELLQUOTE

$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/Delete.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'SUB_DELETE';
  use 5.008003;
  
  package Sub::Delete;
  
  $VERSION = '1.00002';
  @EXPORT = delete_sub;
  
  use Exporter 5.57 'import';
  use constant point0 => 0+$] eq 5.01;
  
  sub strict_eval($) {
   local %^H if point0;
   local *@;
   use
    strict 'vars';
   local $SIG{__WARN__} = sub {};
   eval shift
  }
  
  my %sigils = qw( SCALAR $  ARRAY @  HASH % );
  
  sub delete_sub {
  	my $sub = shift;
  	my($stashname, $key) = $sub =~ /(.*::)((?:(?!::).)*)\z/s
  		? ($1,$2) : (caller()."::", $sub);
  	exists +(my $stash = \%$stashname)->{$key} or return;
  	ref $stash->{$key} eq 'SCALAR' and  
  		delete $stash->{$key}, return;
  	my $globname = "$stashname$key"; 
  	my $glob = *$globname; 
  	defined *$glob{CODE} or return;  
  	my $check_importedness
  	 = $stashname =~ /^(?:(?!\d)\w*(?:::\w*)*)\z/
  	   && $key    =~ /^(?!\d)\w+\z/;
  	my %imported_slots;
  	my $package;
  	if($check_importedness) {
  		$package = substr $stashname, 0, -2;
  		for (qw "SCALAR ARRAY HASH") {
  			defined *$glob{$_} or next;
  			$imported_slots{$_} = strict_eval
  			  "package $package; 0 && $sigils{$_}$key; 1"
  		}
  	}
          delete $stash->{$key};
  	keys %imported_slots == 1 and exists $imported_slots{SCALAR}
  	 and !$imported_slots{SCALAR} and Internals'SvREFCNT $$glob =>== 1
  	 and !defined *$glob{IO} and !defined *$glob{FORMAT}
  	 and return; 
  	my $newglob = \*$globname;
  	local *alias = *$newglob;
  	defined *$glob{$_} and (
  	 !$check_importedness || $imported_slots{$_}
  	  ? *$newglob
  	  : *alias
  	) = *$glob{$_}
  		for qw "SCALAR ARRAY HASH";
  	defined *$glob{$_} and *$newglob = *$glob{$_}
  		for qw "IO FORMAT";
  	return 
  }
  
  1;
  
  __END__
  
SUB_DELETE

$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{"Term/ReadKey.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'TERM_READKEY';
  package Term::ReadKey;
  
  
  use vars qw($VERSION);
  
  $VERSION = '2.33';
  
  require Exporter;
  require AutoLoader;
  require DynaLoader;
  use Carp;
  
  @ISA = qw(Exporter AutoLoader DynaLoader);
  
  
  @EXPORT = qw(
    ReadKey
    ReadMode
    ReadLine
    GetTerminalSize
    SetTerminalSize
    GetSpeed
    GetControlChars
    SetControlChars
  );
  
  @EXPORT_OK = qw();
  
  bootstrap Term::ReadKey;
  
  
  
  $UseEnv = 1;
  
  $CurrentMode = 0;
  
  %modes = (                            
      original    => 0,
      restore     => 0,
      normal      => 1,
      noecho      => 2,
      cbreak      => 3,
      raw         => 4,
      'ultra-raw' => 5
  );
  
  sub ReadMode
  {
      my ($mode) = $modes{ lc $_[0] };  
      my ($fh) = normalizehandle( ( @_ > 1 ? $_[1] : \*STDIN ) );
      if ( defined($mode) ) { $CurrentMode = $mode }
      elsif ( $_[0] =~ /^\d/ ) { $CurrentMode = $_[0] }
      else { croak("Unknown terminal mode `$_[0]'"); }
      SetReadMode($CurrentMode, $fh);
  }
  
  sub normalizehandle
  {
      my ($file) = @_;
  
      if ( ref($file) ) { return $file; }    
  
      if ( ref( \$file ) eq 'GLOB' ) { return $file; }    
  
      return \*{ ( ( caller(1) )[0] ) . "::$file" };
  }
  
  sub GetTerminalSize
  {
      my ($file) = normalizehandle( ( @_ > 1 ? $_[1] : \*STDOUT ) );
      my (@results) = ();
      my (@fail);
  
      if ( &termsizeoptions() & 1 )                       
      {
          @results = GetTermSizeVIO($file);
          push( @fail, "VIOGetMode call" );
      }
      elsif ( &termsizeoptions() & 2 )                    
      {
          @results = GetTermSizeGWINSZ($file);
          push( @fail, "TIOCGWINSZ ioctl" );
      }
      elsif ( &termsizeoptions() & 4 )                    
      {
          @results = GetTermSizeGSIZE($file);
          push( @fail, "TIOCGSIZE ioctl" );
      }
      elsif ( &termsizeoptions() & 8 )                    
      {
          @results = GetTermSizeWin32($file);
          push( @fail, "Win32 GetConsoleScreenBufferInfo call" );
      }
      else
      {
          @results = ();
      }
  
      if ( @results < 4 and $UseEnv )
      {
          my ($C) = defined( $ENV{COLUMNS} ) ? $ENV{COLUMNS} : 0;
          my ($L) = defined( $ENV{LINES} )   ? $ENV{LINES}   : 0;
          if ( ( $C >= 2 ) and ( $L >= 2 ) )
          {
              @results = ( $C + 0, $L + 0, 0, 0 );
          }
          push( @fail, "COLUMNS and LINES environment variables" );
      }
  
      if ( @results < 4 && $^O ne 'MSWin32')
      {
          my ($prog) = "resize";
  
          if ( -f "/usr/openwin/bin/resize" ) {
              $prog = "/usr/openwin/bin/resize";
          }
  
          my ($resize) = scalar(`$prog 2>/dev/null`);
          if (
              defined $resize
              and (  $resize =~ /COLUMNS\s*=\s*(\d+)/
                  or $resize =~ /setenv\s+COLUMNS\s+'?(\d+)/ )
            )
          {
              $results[0] = $1;
              if (   $resize =~ /LINES\s*=\s*(\d+)/
                  or $resize =~ /setenv\s+LINES\s+'?(\d+)/ )
              {
                  $results[1] = $1;
                  @results[ 2, 3 ] = ( 0, 0 );
              }
              else
              {
                  @results = ();
              }
          }
          else
          {
              @results = ();
          }
          push( @fail, "resize program" );
      }
  
      if ( @results < 4 && $^O ne 'MSWin32' )
      {
          my ($prog) = "stty size";
  
          my ($stty) = scalar(`$prog 2>/dev/null`);
          if (
              defined $stty
              and (  $stty =~ /(\d+) (\d+)/ )
            )
          {
              $results[0] = $2;
  			$results[1] = $1;
  			@results[ 2, 3 ] = ( 0, 0 );
          }
          else
          {
              @results = ();
          }
          push( @fail, "stty program" );
      }
  
      if ( @results != 4 )
      {
          warn "Unable to get Terminal Size."
            . join( "", map( " The $_ didn't work.", @fail ) );
  	return undef;
      }
  
      @results;
  }
  
  if ( &blockoptions() & 1 )    
  {
      if ( &blockoptions() & 2 )    
      {
          eval <<'DONE';
  		sub ReadKey {
  		  my($File) = normalizehandle((@_>1?$_[1]:\*STDIN));
                    if (defined $_[0] && $_[0] > 0) {
                      if ($_[0]) {
                        return undef if &pollfile($File,$_[0]) == 0;
                      }
  		  }
                    if (defined $_[0] && $_[0] < 0) {
                       &setnodelay($File,1);
                    }
                    my ($value) = getc $File;
                    if (defined $_[0] && $_[0] < 0) {
                       &setnodelay($File,0);
                    }
                    $value;
  		}
  		sub ReadLine {
  		  my($File) = normalizehandle((@_>1?$_[1]:\*STDIN));
  
                    if (defined $_[0] && $_[0] > 0) {
                       if ($_[0]) {
                         return undef if &pollfile($File,$_[0]) == 0;
                       }
  		  }
                    if (defined $_[0] && $_[0] < 0) {
                       &setnodelay($File,1)
                    };
                    my ($value) = scalar(<$File>);
                    if ( defined $_[0] && $_[0]<0 ) {
                      &setnodelay($File,0)
                    };
                    $value;
  		}
  DONE
      }
      elsif ( &blockoptions() & 4 )    
      {
          eval <<'DONE';
  		sub ReadKey {
  		  my($File) = normalizehandle((@_>1?$_[1]:\*STDIN));
                    if(defined $_[0] && $_[0]>0) {
  				if($_[0]) {return undef if &selectfile($File,$_[0])==0}
  		    }
  			if(defined $_[0] && $_[0]<0) {&setnodelay($File,1);}
  			my($value) = getc $File;
  			if(defined $_[0] && $_[0]<0) {&setnodelay($File,0);}
  			$value;
  		}
  		sub ReadLine {
  		  my($File) = normalizehandle((@_>1?$_[1]:\*STDIN));
  		    if(defined $_[0] && $_[0]>0) {
  				if($_[0]) {return undef if &selectfile($File,$_[0])==0}
  		    }
  			if(defined $_[0] && $_[0]<0) {&setnodelay($File,1)};
  			my($value)=scalar(<$File>);
  			if(defined $_[0] && $_[0]<0) {&setnodelay($File,0)};
  			$value;
  		}
  DONE
      }
      else
      {    
          eval <<'DONE';
  		sub ReadKey {
  		  my($File) = normalizehandle((@_>1?$_[1]:\*STDIN));
  		    if(defined $_[0] && $_[0]>0) {
  		    	# Nothing better seems to exist, so I just use time-of-day
  		    	# to timeout the read. This isn't very exact, though.
  		    	$starttime=time;
  		    	$endtime=$starttime+$_[0];
  				&setnodelay($File,1);
  				my($value)=undef;
  		    	while(time<$endtime) { # This won't catch wraparound!
  		    		$value = getc $File;
  		    		last if defined($value);
  		    	}
  				&setnodelay($File,0);
  				return $value;
  		    }
  			if(defined $_[0] && $_[0]<0) {&setnodelay($File,1);}
  			my($value) = getc $File;
  			if(defined $_[0] && $_[0]<0) {&setnodelay($File,0);}
  			$value;
  		}
  		sub ReadLine {
  		  my($File) = normalizehandle((@_>1?$_[1]:\*STDIN));
  		    if(defined $_[0] && $_[0]>0) {
  		    	# Nothing better seems to exist, so I just use time-of-day
  		    	# to timeout the read. This isn't very exact, though.
  		    	$starttime=time;
  		    	$endtime=$starttime+$_[0];
  				&setnodelay($File,1);
  				my($value)=undef;
  		    	while(time<$endtime) { # This won't catch wraparound!
  		    		$value = scalar(<$File>);
  		    		last if defined($value);
  		    	}
  				&setnodelay($File,0);
  				return $value;
  		    }
  			if(defined $_[0] && $_[0]<0) {&setnodelay($File,1)};
  			my($value)=scalar(<$File>);
  			if(defined $_[0] && $_[0]<0) {&setnodelay($File,0)};
  			$value;
  		}
  DONE
      }
  }
  elsif ( &blockoptions() & 2 )    
  {
      eval <<'DONE';
  	sub ReadKey {
  	  my($File) = normalizehandle((@_>1?$_[1]:\*STDIN));
  		if(defined $_[0] && $_[0] != 0) {
                       return undef if &pollfile($File,$_[0]) == 0
                  }
  		getc $File;
  	}
  	sub ReadLine {
  	  my($File) = normalizehandle((@_>1?$_[1]:\*STDIN));
  		if(defined $_[0] && $_[0]!=0) {
                       return undef if &pollfile($File,$_[0]) == 0;
                  }
  		scalar(<$File>);
  	}
  DONE
  }
  elsif ( &blockoptions() & 4 )    
  {
      eval <<'DONE';
  	sub ReadKey {
  	  my($File) = normalizehandle((@_>1?$_[1]:\*STDIN));
  		if(defined $_[0] && $_[0] !=0 ) {
                       return undef if &selectfile($File,$_[0])==0
                  }
  		getc $File;
  	}
  	sub ReadLine {
  	  my($File) = normalizehandle((@_>1?$_[1]:\*STDIN));
  		if(defined $_[0] && $_[0] != 0) {
                       return undef if &selectfile($File,$_[0]) == 0;
                  }
  		scalar(<$File>);
  	}
  DONE
  }
  elsif ( &blockoptions() & 8 )    
  {
      eval <<'DONE';
  	sub ReadKey {
  	  my($File) = normalizehandle((@_>1?$_[1]:\*STDIN));
          if ($_[0] || $CurrentMode >= 3) {
  			Win32PeekChar($File, $_[0]);
          } else {
          	getc $File;
          }
  		#if ($_[0]!=0) {return undef if !Win32PeekChar($File, $_[0])};
  		#getc $File;
  	}
  	sub ReadLine {
  	  my($File) = normalizehandle((@_>1?$_[1]:\*STDIN));
  		#if ($_[0]!=0) {return undef if !Win32PeekChar($File, $_[0])};
  		#scalar(<$File>);
  		if($_[0]) 
  			{croak("Non-blocking ReadLine is not supported on this architecture")}
  		scalar(<$File>);
  	}
  DONE
  }
  else
  {
      eval <<'DONE';
  	sub ReadKey {
  	  my($File) = normalizehandle((@_>1?$_[1]:\*STDIN));
  		if($_[0]) 
  			{croak("Non-blocking ReadKey is not supported on this architecture")}
  		getc $File;
  	}
  	sub ReadLine {
  	  my($File) = normalizehandle((@_>1?$_[1]:\*STDIN));
  		if($_[0]) 
  			{croak("Non-blocking ReadLine is not supported on this architecture")}
  		scalar(<$File>);
  	}
  DONE
  }
  
  package Term::ReadKey;    
  1;
  
  __END__
TERM_READKEY

$fatpacked{"Test/Config/IOD/Common.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'TEST_CONFIG_IOD_COMMON';
  package Test::Config::IOD::Common;
  
  our $DATE = '2015-06-07'; 
  our $VERSION = '0.17'; 
  
  use 5.010;
  use strict;
  use warnings;
  
  use Module::Load;
  use Test::More 0.98;
  
  our $CLASS = "Config::IOD::Reader";
  
  sub test_common_iod {
  
      load $CLASS;
  
      subtest "opt: default_section" => sub {
          test_read_iod(
              args  => {default_section=>'bawaan'},
              input => <<'_',
  a=1
  _
              result => {bawaan=>{a=>1}},
          );
      };
  
      subtest "opt: allow_directives" => sub {
          test_read_iod(
              args  => {allow_directives=>['merge']},
              input => <<'_',
  ;!noop
  _
              dies  => 1,
          );
          test_read_iod(
              args  => {allow_directives=>['noop']},
              input => <<'_',
  ;!noop
  _
              result => {},
          );
      };
  
      subtest "opt: disallow_directives" => sub {
          test_read_iod(
              args  => {disallow_directives=>['noop']},
              input => <<'_',
  ;!noop
  _
              dies  => 1,
          );
          test_read_iod(
              args  => {disallow_directives=>['merge']},
              input => <<'_',
  ;!noop
  _
              result => {},
          );
      };
  
      subtest "opt: allow_directives + disallow_directives" => sub {
          test_read_iod(
              args  => {
                  allow_directives    => ['noop'],
                  disallow_directives => ['noop'],
              },
              input => <<'_',
  ;!noop
  _
              dies  => 1,
          );
      };
  
      subtest "opt: enable_quoting=0" => sub {
          test_read_iod(
              args  => {enable_quoting=>0},
              input => <<'_',
  name="1\n2"
  _
              result => {GLOBAL=>{name=>'"1\\n2"'}},
          );
      };
  
      subtest "opt: enable_bracket=0" => sub {
          test_read_iod(
              args  => {enable_bracket=>0},
              input => <<'_',
  name=[1,2,3]
  _
              result => {GLOBAL=>{name=>'[1,2,3]'}},
          );
      };
  
      subtest "opt: enable_brace=0" => sub {
          test_read_iod(
              args  => {enable_brace=>0},
              input => <<'_',
  name={"a":1}
  _
              result => {GLOBAL=>{name=>'{"a":1}'}},
          );
      };
  
      subtest "opt: enable_encoding=0" => sub {
          test_read_iod(
              args  => {enable_encoding=>0},
              input => <<'_',
  name=!hex 5e5e
  _
              result => {GLOBAL=>{name=>'!hex 5e5e'}},
          );
      };
  
      subtest "opt: allow_encodings" => sub {
          test_read_iod(
              args  => {allow_encodings=>['hex']},
              input => <<'_',
  name=!json "1\n2"
  _
              dies => 1,
          );
          test_read_iod(
              args  => {allow_encodings=>['json']},
              input => <<'_',
  name=!json "1\n2"
  name2=!j "3\n4"
  _
              result => {GLOBAL=>{name=>"1\n2", name2=>"3\n4"}},
          );
      };
  
      subtest "opt: disallow_encodings" => sub {
          test_read_iod(
              args  => {disallow_encodings=>['json']},
              input => <<'_',
  name=!json "1\n2"
  _
              dies => 1,
          );
          test_read_iod(
              args  => {disallow_encodings=>['json']},
              input => <<'_',
  name=!j "1\n2"
  _
              dies => 1,
          );
          test_read_iod(
              args  => {disallow_encodings=>['hex']},
              input => <<'_',
  name=!json "1\n2"
  _
              result => {GLOBAL=>{name=>"1\n2"}},
          );
      };
  
      subtest "opt: allow_encodings + disallow_encodings" => sub {
          test_read_iod(
              args  => {
                  allow_encodings   =>['json'],
                  disallow_encodings=>['json'],
              },
              input => <<'_',
  name=!json "1\n2"
  _
              dies => 1,
          );
      };
  
      subtest "opt: allow_bang_only=0" => sub {
          test_read_iod(
              args  => {allow_bang_only=>0},
              input => <<'_',
  a=1
  !noop
  _
              dies => 1,
          );
      };
  
      subtest "opt: allow_duplicate_key=0" => sub {
          test_read_iod(
              args  => {allow_duplicate_key=>0},
              input => <<'_',
  a=1
  a=2
  _
              dies => 1,
          );
      };
  
      subtest "opt: ignore_unknown_directive=1" => sub {
          test_read_iod(
              args  => {ignore_unknown_directive=>1},
              input => <<'_',
  ;!foo bar
  _
              result => {},
          );
      };
  
      subtest "expr" => sub {
          test_read_iod(
              name  => "must be enabled first",
              args  => {},
              input => <<'_',
  a=!e 1+1
  _
              dies => 1,
          );
          test_read_iod(
              name  => "must be valid",
              args  => {enable_expr=>1},
              input => <<'_',
  a=!e 1+
  _
              dies => 1,
          );
          test_read_iod(
              args  => {enable_expr=>1},
              input => <<'_',
  a=!e 1+1
  [sect]
  b=!e val("GLOBAL.a")*3
  c=!e val("b") x 3
  _
              result => {GLOBAL=>{a=>2}, sect=>{b=>6, c=>666}},
          );
      };
  }
  
  sub test_read_iod {
      my %args = @_;
  
      my $parser_args = $args{args};
      my $test_name = $args{name} //
          "{". join(", ",
                    (map {"$_=$parser_args->{$_}"}
                         sort keys %$parser_args),
                ) . "}";
      subtest $test_name => sub {
  
          my $parser = $CLASS->new(%$parser_args);
  
          my $res;
          eval {
              if ($CLASS eq 'Config::IOD') {
                  $res = $parser->read_string($args{input})->dump;
              } else {
                  $res = $parser->read_string($args{input});
              }
          };
          my $err = $@;
          if ($args{dies}) {
              ok($err, "dies") or diag explain $res;
              return;
          } else {
              ok(!$err, "doesn't die")
                  or do { diag explain "err=$err"; return };
              is_deeply($res, $args{result}, 'result')
                  or diag explain $res;
          }
      };
  }
  
  1;
  
  __END__
  
TEST_CONFIG_IOD_COMMON

$fatpacked{"Test/Data/Sah.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'TEST_DATA_SAH';
  package Test::Data::Sah;
  
  our $DATE = '2015-07-01'; 
  our $VERSION = '0.68'; 
  
  use 5.010;
  use strict;
  use warnings;
  
  use Data::Dump qw(dump);
  use Data::Sah qw(gen_validator);
  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/ANSI/Util.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'TEXT_ANSI_UTIL';
  package Text::ANSI::Util;
  
  use 5.010001;
  use locale;
  use strict;
  use utf8;
  use warnings;
  
  use List::Util qw(min max);
  use Text::WideChar::Util 0.10 qw(mbswidth mbtrunc);
  
  require Exporter;
  our @ISA       = qw(Exporter);
  our @EXPORT_OK = qw(
                         ta_add_color_resets
                         ta_detect
                         ta_extract_codes
                         ta_highlight
                         ta_highlight_all
                         ta_length
                         ta_length_height
                         ta_mbpad
                         ta_mbswidth
                         ta_mbswidth_height
                         ta_mbtrunc
                         ta_mbwrap
                         ta_pad
                         ta_split_codes
                         ta_split_codes_single
                         ta_strip
                         ta_trunc
                         ta_wrap
                 );
  
  our $VERSION = '0.16'; 
  
  our $re       = qr/
                        #\e\[ (?: (\d+) ((?:;[^;]+?)*) )? ([\x40-\x7e])
                        # without captures
                        \e\[ (?: \d+ (?:;[^;]+?)* )? [\x40-\x7e]
                    /osx;
  
  sub ta_detect {
      my $text = shift;
      $text =~ $re ? 1:0;
  }
  
  sub ta_length {
      my $text = shift;
      length(ta_strip($text));
  }
  
  sub _ta_length_height {
      my ($is_mb, $text) = @_;
      my $num_lines = 0;
      my @lens;
      for my $e (split /(\r?\n)/, ta_strip($text)) {
          if ($e =~ /\n/) {
              $num_lines++;
              next;
          }
          $num_lines = 1 if $num_lines == 0;
          push @lens, $is_mb ? mbswidth($e) : length($e);
      }
      [max(@lens) // 0, $num_lines];
  }
  
  sub ta_length_height {
      _ta_length_height(0, @_);
  }
  
  sub ta_mbswidth_height {
      _ta_length_height(1, @_);
  }
  
  sub ta_strip {
      my $text = shift;
      $text =~ s/$re//go;
      $text;
  }
  
  sub ta_extract_codes {
      my $text = shift;
      my $res = "";
      $res .= $1 while $text =~ /((?:$re)+)/go;
      $res;
  }
  
  sub ta_split_codes {
      my $text = shift;
      return split(/((?:$re)+)/o, $text);
  }
  
  sub ta_split_codes_single {
      my $text = shift;
      return split(/($re)/o, $text);
  }
  
  sub _ta_mbswidth0 {
      my $text = shift;
      mbswidth(ta_strip($text));
  }
  
  sub ta_mbswidth {
      my $text = shift;
      ta_mbswidth_height($text)->[0];
  }
  
  sub _ta_wrap {
      my ($is_mb, $text, $width, $opts) = @_;
      $width //= 80;
      $opts  //= {};
  
  
      my @termst; 
      my @terms;  
      my @pterms; 
      my @termsw; 
      my @termsc; 
      {
          my @ch = ta_split_codes_single($text);
          my $crcode = ""; 
          my $term      = '';
          my $pterm     = '';
          my $prev_type = '';
          while (my ($pt, $c) = splice(@ch, 0, 2)) {
  
  
              my @s; 
              while ($pt =~ /($Text::WideChar::Util::re_cjk+)|(\S+)|(\s+)/gox) {
                  if ($1) {
                      push @s, $1, 'c';
                  } elsif ($3) {
                      push @s, $3, 's';
                  } else {
                      my $pt2 = $2;
                      while ($pt2 =~ /($Text::WideChar::Util::re_cjk_class+)|
                                      ($Text::WideChar::Util::re_cjk_negclass+)/gox) {
                          if ($1) {
                              push @s, $1, 'c';
                          } else {
                              push @s, $2, 'w';
                          }
                      }
                  }
              }
  
  
              my $only_code = 1 if !@s;
              while (1) {
                  my ($s, $s_type) = splice @s, 0, 2;
                  $s_type //= '';
                  last unless $only_code || defined($s);
                  if ($only_code) {
                      $s = "";
                      $term .= $c if defined $c;
                  }
  
                  if ($s_type && $s_type ne 's') {
                      if ($prev_type eq 's') {
                          push @termst, 's';
                          push @terms , $term;
                          push @pterms, $pterm;
                          push @termsw, undef;
                          push @termsc, $crcode;
                          $pterm = ''; $term = '';
                      } elsif ($prev_type && $prev_type ne $s_type) {
                          push @termst, $prev_type;
                          push @terms , $term;
                          push @pterms, $pterm;
                          push @termsw, $is_mb ? mbswidth($pterm):length($pterm);
                          push @termsc, $crcode;
                          $pterm = ''; $term = '';
                      }
                      $pterm .= $s;
                      $term  .= $s; $term .= $c if defined($c) && !@s;
                      if (!@s && !@ch) {
                          push @termst, $s_type;
                          push @terms , $term;
                          push @pterms, "";
                          push @termsw, $is_mb ? mbswidth($pterm):length($pterm);
                          push @termsc, $crcode;
                      }
                  } elsif (length($s)) {
                      if ($prev_type ne 's') {
                          push @termst, $prev_type;
                          push @terms , $term;
                          push @pterms, "";
                          push @termsw, $is_mb ? mbswidth($pterm):length($pterm);
                          push @termsc, $crcode;
                          $pterm = ''; $term = '';
                      }
                      $pterm .= $s;
                      $term  .= $c if defined($c) && !@s;
                      if (!@s && !@ch) {
                          push @termst, 's';
                          push @terms , $term;
                          push @pterms, $pterm;
                          push @termsw, undef;
                          push @termsc, $crcode;
                      }
                  }
                  $prev_type = $s_type;
  
                  if (!@s) {
                      if (defined($c) && $c =~ /m\z/) {
                          if ($c eq "\e[0m") {
                              $crcode = "";
                          } elsif ($c =~ /m\z/) {
                              $crcode .= $c;
                          }
                      }
                      last if $only_code;
                  }
  
              } 
          } 
      }
  
      {
          my $i = 0;
          while ($i < @pterms) {
              if ($termst[$i] eq 's') {
                  if ($pterms[$i] =~ /[ \t]*(\n(?:[ \t]*\n)+)([ \t]*)/) {
                      $pterms[$i] = $1;
                      $termst[$i] = 'p';
                      if ($i < @pterms-1) {
                          $terms [$i+1] = $terms[$i] . $terms [$i+1];
                          $terms [$i] = "";
                      }
                      if (length $2) {
                          splice @termst, $i+1, 0, "s";
                          splice @terms , $i+1, 0, "";
                          splice @pterms, $i+1, 0, $2;
                          splice @termsw, $i+1, 0, undef;
                          splice @termsc, $i+1, 0, $termsc[$i];
                          $i += 2;
                          next;
                      }
                  }
              }
              $i++;
          }
      }
  
  
  
      my ($maxww, $minww);
  
  
      my @res;
      {
          my $tw = $opts->{tab_width} // 8;
          die "Please specify a positive tab width" unless $tw > 0;
          my $optfli  = $opts->{flindent};
          my $optfliw = Text::WideChar::Util::_get_indent_width($is_mb, $optfli, $tw) if defined $optfli;
          my $optsli  = $opts->{slindent};
          my $optsliw = Text::WideChar::Util::_get_indent_width($is_mb, $optsli, $tw) if defined $optsli;
          my $pad = $opts->{pad};
          my $x = 0;
          my $y = 0;
          my ($fli, $sli, $fliw, $sliw);
          my $is_parastart = 1;
          my $line_has_word = 0;
          my ($termt, $prev_t);
        TERM:
          for my $i (0..$#terms) {
              $prev_t = $termt if $i;
              $termt = $termst[$i];
              my $term  = $terms[$i];
              my $pterm = $pterms[$i];
              my $termw = $termsw[$i];
              my $crcode = $i > 0 ? $termsc[$i-1] : "";
  
              if ($termt eq 'p') {
                  my $numnl = 0;
                  $numnl++ while $pterm =~ /\n/g;
                  for (1..$numnl) {
                      push @res, "\e[0m" if $crcode && $_ == 1;
                      push @res, " " x ($width-$x) if $pad;
                      push @res, "\n";
                      $x = 0;
                      $y++;
                  }
                  $line_has_word = 0;
                  $x = 0;
                  $is_parastart = 1;
                  next TERM;
              }
  
              if ($is_parastart) {
                  if (defined $optfli) {
                      $fli  = $optfli;
                      $fliw = $optfliw;
                  } else {
                      if ($termt eq 's') {
                          $fli  = $pterm;
                          $fliw = Text::WideChar::Util::_get_indent_width($is_mb, $fli, $tw);
                      } else {
                          $fli  = "";
                          $fliw = 0;
                      }
                      my $j = $i;
                      $sli = undef;
                      while ($j < @terms && $termst[$j] ne 'p') {
                          if ($termst[$j] eq 's') {
                              if ($pterms[$j] =~ /\n([ \t]+)/) {
                                  $sli  = $1;
                                  $sliw = Text::WideChar::Util::_get_indent_width($is_mb, $sli, $tw);
                                  last;
                              }
                          }
                          $j++;
                      }
                      if (!defined($sli)) {
                          $sli  = "";
                          $sliw = 0;
                      }
                      die "Subsequent indent must be less than width" if $sliw >= $width;
                  }
  
                  push @res, $fli;
                  $x += $fliw;
              } 
  
              $is_parastart = 0;
  
              if ($termt eq 's') {
                  push @res, $term;
  
                  if ($pterm =~ /\n/ && $i == $#terms) {
                      push @res, "\e[0m" if $crcode;
                      push @res, " " x ($width-$x) if $pad;
                      push @res, "\n";
                      $line_has_word = 0;
                  }
              }
  
              if ($termt ne 's') {
                  my @words;
                  my @wordsw;
                  my @wordst; 
                  my @wordswsb; 
                  my $j = 0;
                  my $c = ""; 
                  while (1) {
                      $j++;
                      if ($termw <= $width-$sliw || $termt eq 'c') {
                          push @words   , $c . $term;
                          push @wordsw  , $termw;
                          push @wordst  , $termt;
                          push @wordswsb, ($prev_t && $prev_t eq 's')?1:0;
                          last;
                      }
                      my $res = $is_mb ? ta_mbtrunc($term, $width-$sliw, 1) :
                          ta_trunc($term, $width-$sliw, 1);
  
                      my ($tword, $twordw);
                      if ($j == 1) {
                          $tword  = $res->[0];
                          $twordw = $res->[1];
                      } else {
                          $tword  = ($crcode ? "\e[0m" . $crcode : "") .
                              $c . $res->[0];
                          $twordw = $res->[1];
                      }
                      $c .= ta_extract_codes(substr($term, 0, $res->[2]));
  
                      push @words   , $tword;
                      push @wordsw  , $twordw;
                      push @wordst  , $termt;
                      push @wordswsb, $j == 1 ? (($prev_t && $prev_t eq 's')?1:0) : 0;
                      $term  = substr($term, $res->[2]);
                      $termw = $is_mb ? _ta_mbswidth0($term) : ta_length($term);
                  }
  
  
                  for my $word (@words) {
                      my $wordw = shift @wordsw;
                      my $wordt = shift @wordst;
                      my $ws_before = shift @wordswsb;
  
                      $maxww = $wordw if !defined($maxww) || $maxww < $wordw;
                      $minww = $wordw if !defined($minww) || $minww > $wordw;
  
                      if ($x + ($line_has_word ? 1:0) + $wordw <= $width) {
                          if ($line_has_word && $ws_before) {
                              push @res, " ";
                              $x++;
                          }
                          push @res, $word;
                          $x += $wordw;
                      } else {
                          while (1) {
                              if ($wordt eq 'c') {
                                  my $res;
                                  if ($ws_before) {
                                      $res = ta_mbtrunc($word, $width-$x-1, 1);
                                      push @res, " ", $res->[0];
                                  } else {
                                      $res = ta_mbtrunc($word, $width-$x, 1);
                                      push @res, $res->[0];
                                  }
                                  $word = $res->[3];
                                  $wordw = _ta_mbswidth0($res->[3]);
                              } else {
                                  push @res, "\e[0m" if $crcode;
                              }
                              push @res, " " x ($width-$x) if $pad;
                              push @res, "\n";
                              $y++;
                              push @res, $crcode;
                              push @res, $sli;
  
                              if ($sliw + $wordw <= $width) {
                                  push @res, $word;
                                  $x = $sliw + $wordw;
                                  last;
                              } else {
                                  $x = $sliw;
                              }
                          }
                      }
                      $line_has_word++;
                  }
  
              }
          } 
          push @res, " " x ($width-$x) if $line_has_word && $pad;
      }
  
      if ($opts->{return_stats}) {
          return [join("", @res), {
              max_word_width => $maxww,
              min_word_width => $minww,
          }];
      } else {
          return join("", @res);
      }
  }
  
  sub ta_wrap {
      _ta_wrap(0, @_);
  }
  
  sub ta_mbwrap {
      _ta_wrap(1, @_);
  }
  
  sub _ta_pad {
      my ($is_mb, $text, $width, $which, $padchar, $is_trunc) = @_;
      if ($which) {
          $which = substr($which, 0, 1);
      } else {
          $which = "r";
      }
      $padchar //= " ";
  
      my $w = $is_mb ? _ta_mbswidth0($text) : ta_length($text);
      if ($is_trunc && $w > $width) {
          my $res = $is_mb ?
              ta_mbtrunc($text, $width, 1) : ta_trunc($text, $width, 1);
          $text = $res->[0] . ($padchar x ($width-$res->[1]));
      } else {
          if ($which eq 'l') {
              $text = ($padchar x ($width-$w)) . $text;
          } elsif ($which eq 'c') {
              my $n = int(($width-$w)/2);
              $text = ($padchar x $n) . $text . ($padchar x ($width-$w-$n));
          } else {
              $text .= ($padchar x ($width-$w));
          }
      }
      $text;
  }
  
  sub ta_pad {
      _ta_pad(0, @_);
  }
  
  sub ta_mbpad {
      _ta_pad(1, @_);
  }
  
  sub _ta_trunc {
      my ($is_mb, $text, $width, $return_extra) = @_;
  
  
      my $w = $is_mb ? _ta_mbswidth0($text) : ta_length($text);
      if ($w <= $width) {
          return $return_extra ? [$text, $w, length($text), ''] : $text;
      }
      my @p = ta_split_codes($text);
      my @res;
      my $append = 1; 
      my $code4rest = '';
      my $rest = '';
      $w = 0;
      my $c = 0;
      while (my ($t, $ansi) = splice @p, 0, 2) {
          if ($append) {
              my $tw = $is_mb ? mbswidth($t) : length($t);
              if ($w+$tw <= $width) {
                  push @res, $t;
                  $w += $tw;
                  $c += length($t);
                  $append = 0 if $w == $width;
              } else {
                  my $tres = $is_mb ?
                      mbtrunc($t, $width-$w, 1) :
                          [substr($t, 0, $width-$w), $width-$w, $width-$w];
                  push @res, $tres->[0];
                  $w += $tres->[1];
                  $c += $tres->[2];
                  $rest = substr($t, $tres->[2]);
                  $append = 0;
              }
          } else {
              $rest .= $t;
          }
          if (defined $ansi) {
              push @res, $ansi;
              $c += length($ansi) if $append;
              $code4rest .= $ansi if $append;
              $rest .= $ansi unless $append;
          }
      }
  
      if ($return_extra) {
          return [join("", @res), $w, $c, $code4rest . $rest];
      } else {
          return join("", @res);
      }
  }
  
  sub ta_trunc {
      _ta_trunc(0, @_);
  }
  
  sub ta_mbtrunc {
      _ta_trunc(1, @_);
  }
  
  sub _ta_highlight {
      my ($is_all, $text, $needle, $color) = @_;
  
      my (@chptext, @chcode, @chsavedc); 
      my $sc = "";
      my $plaintext = "";
      my @ch = ta_split_codes_single($text);
      while (my ($pt, $c) = splice(@ch, 0, 2)) {
          push @chptext , $pt;
          push @chcode  , $c;
          push @chsavedc, $sc;
          $plaintext .= $pt;
          if (defined($c) && $c =~ /m\z/) {
              if ($c eq "\e[0m") {
                  $sc = "";
              } elsif ($c =~ /m\z/) {
                  $sc .= $c;
              }
          }
      }
  
      my (@needle, @npos);
      if (ref($needle) eq 'Regexp') {
          my @m = $plaintext =~ /$needle/g;
          return $text unless @m;
          my $pos = 0;
          while ($pos < length($plaintext)) {
              my @pt;
              for (@m) {
                  my $p = index($plaintext, $_, $pos);
                  push @pt, [$p, $_] if $p >= 0;
              }
              last unless @pt;
              my $pmin = $pt[0][0];
              my $t = $pt[0][1];
              for (@pt) {
                  if ($pmin > $_->[0] ||
                          $pmin==$_->[0] && length($t) < length($_->[1])) {
                      $pmin = $_->[0];
                      $t = $_->[1];
                  }
              }
              push @needle, $t;
              push @npos  , $pmin;
              last unless $is_all;
              $pos = $pmin + length($t);
          }
      } else {
          my $pos = 0;
          while (1) {
              my $p = index($plaintext, $needle, $pos);
              last if $p < 0;
              push @needle, $needle;
              push @npos  , $p;
              last unless $is_all;
              $pos = $p + length($needle);
              last if $pos >= length($plaintext);
          }
          return $text unless @needle;
      }
  
      my @res;
      my $found = 1;
      my $pos = 0;
      my $i = 0;
      my $curneed = shift @needle;
      my $npos    = shift @npos;
    CHUNK:
      while (1) {
          last if $i >= @chptext;
          my $pos2  = $pos+length($chptext[$i])-1;
          my $npos2 = $npos+length($curneed)-1;
          if ($pos > $npos2 || $pos2 < $npos || !$found) {
              push @res, $chptext[$i];
              push @res, $chcode[$i] if defined $chcode[$i];
              goto L1;
          }
  
          if ($pos < $npos) {
              my $pre = substr($chptext[$i], 0, $npos-$pos);
              push @res, $pre;
          }
  
          my $npart = substr($curneed,
                             max(0, $pos-$npos),
                             min($pos2, $npos2)-max($pos, $npos)+1);
          if (length($npart)) {
              push @res, $color, $npart;
              push @res, "\e[0m";
              push @res, $chsavedc[$i];
          }
  
          if ($npos2 <= $pos2) {
              my $post = substr($chptext[$i], $npos2-$pos+1);
  
              if (@needle) {
                  $curneed = shift @needle;
                  $npos    = shift @npos;
                  $pos     = $npos2+1;
                  $chptext[$i] = $post;
                  $found = 1;
                  redo CHUNK;
              } else {
                  $found = 0;
              }
  
              if (!$found) {
                  push @res, $post;
                  push @res, $chcode[$i] if defined $chcode[$i];
              }
          }
  
        L1:
          $pos = $pos2+1;
          $i++;
      }
  
      join "", @res;
  }
  
  sub ta_highlight {
      _ta_highlight(0, @_);
  }
  
  sub ta_highlight_all {
      _ta_highlight(1, @_);
  }
  
  sub ta_add_color_resets {
      my (@text) = @_;
  
      my @res;
      my $i = 0;
      my $savedc = "";
      for my $text (@text) {
          $i++;
          my $newt = $i > 1 && !$savedc ? "\e[0m" : $savedc;
  
          my @ch = ta_split_codes_single($text);
          while (my ($t, $c) = splice(@ch, 0, 2)) {
              $newt .= $t;
              if (defined($c) && $c =~ /m\z/) {
                  $newt .= $c;
                  if ($c eq "\e[0m") {
                      $savedc = "";
                  } elsif ($c =~ /m\z/) {
                      $savedc .= $c;
                  }
              }
          }
  
          $newt .= "\e[0m" if $savedc && $i < @text;
          push @res, $newt;
      }
  
      @res;
  }
  
  1;
  
  __END__
  
TEXT_ANSI_UTIL

$fatpacked{"Text/LineFold.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'TEXT_LINEFOLD';
  
  package Text::LineFold;
  require 5.008;
  
  
  use strict;
  use vars qw($VERSION @EXPORT_OK @ISA $Config);
  
  use Exporter;
  
  our @ISA = qw(Exporter Unicode::LineBreak);
  
  use Carp qw(croak carp);
  use Encode qw(is_utf8);
  use MIME::Charset;
  use Unicode::LineBreak qw(:all);
  
  
  our $VERSION = '2012.04';
  
  our $Config = {
      Charset => 'UTF-8',
      Language => 'XX',
      OutputCharset => undef,
      TabSize => 8,
  };
  
  
  my %FORMAT_FUNCS = (
      'FIXED' => sub {
  	my $self = shift;
  	my $action = shift;
  	my $str = shift;
  	if ($action =~ /^so[tp]/) {
  	    $self->{_} = {};
  	    $self->{_}->{'ColMax'} = $self->config('ColMax');
  	    $self->config('ColMax' => 0) if $str =~ /^>/;
  	} elsif ($action eq "") {
  	    $self->{_}->{line} = $str;
  	} elsif ($action eq "eol") {
  	    return $self->config('Newline');
  	} elsif ($action =~ /^eo/) {
  	    if (length $self->{_}->{line} and $self->config('ColMax')) {
  		$str = $self->config('Newline').$self->config('Newline');
  	    } else {
  		$str = $self->config('Newline');
  	    }
  	    $self->config('ColMax' => $self->{_}->{'ColMax'});
  	    delete $self->{_};
  	    return $str;
  	}
  	undef;
      },
      'FLOWED' => sub { 
  	my $self = shift;
  	my $action = shift;
  	my $str = shift;
  	if ($action eq 'sol') {
  	    if ($self->{_}->{prefix}) {
  		return $self->{_}->{prefix}.' '.$str;
  	    } elsif ($str =~ /^(?: |From |>)/) {
  		return ' '.$str;
  	    }
  	} elsif ($action =~ /^so/) {
  	    $self->{_} = {};
  	    if ($str =~ /^(>+)/) {
  		$self->{_}->{prefix} = $1;
  	    } else {
  		$self->{_}->{prefix} = '';
  		if ($str =~ /^(?: |From )/) {
  		    return ' '.$str;
  		}
  	    }
  	} elsif ($action eq "") {
  	    $self->{_}->{line} = $str;
  	} elsif ($action eq 'eol') {
  	    $str = ' ' if length $str;
  	    return $str.' '.$self->config('Newline');
  	} elsif ($action =~ /^eo/) {
  	    if (length $self->{_}->{line} and !length $self->{_}->{prefix}) {
  		$str = ' '.$self->config('Newline').$self->config('Newline');
  	    } else {
  		$str = $self->config('Newline');
  	    }
  	    delete $self->{_};
  	    return $str;
  	}
  	undef;
      },
      'PLAIN' => sub {
  	return $_[0]->config('Newline') if $_[1] =~ /^eo/;
  	undef;
      },
  );
  
  
  sub new {
      my $class = shift;
      my $self = bless __PACKAGE__->SUPER::new(), $class;
      $self->config(@_);
      $self;
  }
  
  
  sub config {
      my $self = shift;
      my @opts = qw{Charset Language OutputCharset TabSize};
      my %opts = map { (uc $_ => $_) } @opts;
      my $newline = undef;
  
      if (scalar @_ == 1) {
  	if ($opts{uc $_[0]}) {
  	    return $self->{$opts{uc $_[0]}};
  	}
  	return $self->SUPER::config($_[0]);
      }
  
      my @o = ();
      my %params = @_;
      foreach my $k (keys %params) {
          my $v = $params{$k};
  	if ($opts{uc $k}) {
  	    $self->{$opts{uc $k}} = $v;
  	} elsif (uc $k eq uc 'Newline') {
  	    $newline = $v;
  	} else {
  	    push @o, $k => $v;
  	}
      }
      $self->SUPER::config(@o) if scalar @o;
  
      if (ref $self->{Charset} eq 'MIME::Charset') {
          $self->{_charset} = $self->{Charset};
      } else {
          $self->{Charset} ||= $Config->{Charset};
          $self->{_charset} = MIME::Charset->new($self->{Charset});
      }
      $self->{Charset} = $self->{_charset}->as_string;
      my $ocharset = uc($self->{OutputCharset} || $self->{Charset});
      $ocharset = MIME::Charset->new($ocharset)
  	unless ref $ocharset eq 'MIME::Charset' or $ocharset eq '_UNICODE_';
      unless ($ocharset eq '_UNICODE_') {
  	$self->{_charset}->encoder($ocharset);
  	$self->{OutputCharset} = $ocharset->as_string;
      }
      $self->{Language} = uc($self->{Language} || $Config->{Language});
  
      $self->SUPER::config(Context =>
  			 context(Charset => $self->{Charset},
  				 Language => $self->{Language}));
  
      $self->SUPER::config(Sizing => sub {
  	my ($self, $cols, $pre, $spc, $str) = @_;
  
  	my $tabsize = $self->{TabSize};
  	my $spcstr = $spc.$str;
  	$spcstr->pos(0);
  	while (!$spcstr->eos and $spcstr->item->lbc == LB_SP) {
  	    my $c = $spcstr->next;
  	    if ($c eq "\t") {
  		$cols += $tabsize - $cols % $tabsize if $tabsize;
  	    } else {
  		$cols += $c->columns;
  	    }
  	}
  	return $cols + $spcstr->substr($spcstr->pos)->columns;
      });
  
      $self->SUPER::config(LBClass => [ord("\t") => LB_SP]);
      if (defined $self->{TabSize}) {
  	croak "Invalid TabSize option" unless $self->{TabSize} =~ /^\d+$/;
  	$self->{TabSize} += 0;
      } else {
  	$self->{TabSize} = $Config->{TabSize};
      }
  
      if (defined $newline) {
  	$newline = $self->{_charset}->decode($newline)
  	    unless is_utf8($newline);
  	$self->SUPER::config(Newline => $newline);
      }
  }
  
  
  my $special_break = qr/([\x{000B}\x{000C}\x{0085}\x{2028}\x{2029}])/os;
  
  sub fold {
      my $self = shift;
      my $str;
  
      if (2 < scalar @_) {
  	my $initial_tab = shift || '';
  	$initial_tab = $self->{_charset}->decode($initial_tab)
  	    unless is_utf8($initial_tab);
  	my $subsequent_tab = shift || '';
  	$subsequent_tab = $self->{_charset}->decode($subsequent_tab)
  	    unless is_utf8($subsequent_tab);
  	my @str = @_;
  
  	$str = shift @str;
  	$str = $self->{_charset}->decode($str) unless is_utf8($str);
  	foreach my $s (@str) {
  	    next unless defined $s and length $s;
  
  	    $s = $self->{_charset}->decode($s) unless is_utf8($s);
  	    unless (length $str) {
  		$str = $s;
  	    } elsif ($str =~ /(\s|$special_break)$/ or
  		     $s =~ /^(\s|$special_break)/) {
  		$str .= $s;
  	    } else {
  		$str .= ' ' if $self->breakingRule($str, $s) == INDIRECT;
  		$str .= $s;
  	    }
  	}
  
  	$self->SUPER::config(Format => sub {
  	    my $self = shift;
  	    my $event = shift;
  	    my $str = shift;
  	    if ($event =~ /^eo/) { return $self->config('Newline'); }
  	    if ($event =~ /^so[tp]/) { return $initial_tab.$str; }
  	    if ($event eq 'sol') { return $subsequent_tab.$str; }
  	    undef;
  	});
      } else {
  	$str = shift;
  	my $method = uc(shift || '');
  	return '' unless defined $str and length $str;
  
  	$str = $self->{_charset}->decode($str) unless is_utf8($str);
  
  	$self->SUPER::config(Format => $FORMAT_FUNCS{$method} ||
  			     $FORMAT_FUNCS{'PLAIN'});
      }
  
      my $result = '';
      foreach my $s (split $special_break, $str) {
  	if ($s =~ $special_break) {
  	    $result .= $s;
  	} else {
  	    $result .= $self->break($str);
  	}
      }
  
      if ($self->{OutputCharset} eq '_UNICODE_') {
          return $result;
      } else {
          return $self->{_charset}->encode($result);
      }
  }
  
  
  sub unfold {
      my $self = shift;
      my $str = shift;
      return '' unless defined $str and length $str;
  
      my $method = uc(shift || 'FIXED');
      $method = 'FIXED' unless $method =~ /^(?:FIXED|FLOWED|FLOWEDSP|OBSFLOWED)$/;
      my $delsp = $method eq 'FLOWED';
  
      $str = $self->{_charset}->decode($str) unless is_utf8($str);
      $str =~ s/\r\n|\r/\n/g;
  
      my $result = '';
      foreach my $s (split $special_break, $str) {
  	if ($s eq '') {
  	    next;
  	} elsif ($s =~ $special_break) {
  	    $result .= $s;
  	    next;
  	} elsif ($method eq 'FIXED') {
  	    pos($s) = 0;
  	    while ($s !~ /\G\z/cg) {
  		if ($s =~ /\G\n/cg) {
  		    $result .= $self->config('Newline');
  		} elsif ($s =~ /\G(.+)\n\n/cg) {
  		    $result .= $1.$self->config('Newline');
  		} elsif ($s =~ /\G(>.*)\n/cg) {
  		    $result .= $1.$self->config('Newline');
  		} elsif ($s =~ /\G(.+)\n(?=>)/cg) {
  		    $result .= $1.$self->config('Newline');
  		} elsif ($s =~ /\G(.+?)( *)\n(?=(.+))/cg) {
  		    my ($l, $s, $n) = ($1, $2, $3);
  		    $result .= $l;
  		    if ($n =~ /^ /) {
  			$result .= $self->config('Newline');
  		    } elsif (length $s) {
  			$result .= $s;
  		    } elsif (length $l) {
  			$result .= ' '
  			    if $self->breakingRule($l, $n) == INDIRECT;
  		    }
  		} elsif ($s =~ /\G(.+)\n/cg) {
  		    $result .= $1.$self->config('Newline');
  		} elsif ($s =~ /\G(.+)/cg) {
  		    $result .= $1.$self->config('Newline');
  		    last;
  		}
  	    }
  	} elsif ($method eq 'FLOWED' or $method eq 'FLOWEDSP' or
  		 $method eq 'OBSFLOWED') {
  	    my $prefix = undef;
  	    pos($s) = 0;
  	    while ($s !~ /\G\z/cg) {
  		if ($s =~ /\G(>+) ?(.*?)( ?)\n/cg) {
  		    my ($p, $l, $s) = ($1, $2, $3);
  		    unless (defined $prefix) {
  			$result .= $p.' '.$l;
  		    } elsif ($p ne $prefix) {
  			$result .= $self->config('Newline');
  			$result .= $p.' '.$l;
  		    } else {
  			$result .= $l;
  		    }
  		    unless (length $s) {
  			$result .= $self->config('Newline');
  			$prefix = undef;
  		    } else {
  			$prefix = $p;
  			$result .= $s unless $delsp;
  		    }
  		} elsif ($s =~ /\G ?(.*?)( ?)\n/cg) {
  		    my ($l, $s) = ($1, $2);
  		    unless (defined $prefix) {
  			$result .= $l;
  		    } elsif ('' ne $prefix) {
  			$result .= $self->config('Newline');
  			$result .= $l;
  		    } else {
  			$result .= $l;
  		    }
  		    unless (length $s) {
  			$result .= $self->config('Newline');
  			$prefix = undef;
  		    } else {
  			$result .= $s unless $delsp;
  			$prefix = '';
  		    }
  		} elsif ($s =~ /\G ?(.*)/cg) {
  		    $result .= $1.$self->config('Newline');
  		    last;
  		}
  	    }
  	}
      }
      if ($self->{OutputCharset} eq '_UNICODE_') {
          return $result;
      } else {
          return $self->{_charset}->encode($result);
      }
  }
  
  
  1;
TEXT_LINEFOLD

$fatpacked{"Text/Table/Tiny.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'TEXT_TABLE_TINY';
  use strict;
  use warnings;
  package Text::Table::Tiny;
  use List::Util qw();
  
  
  
  our $COLUMN_SEPARATOR = '|';
  our $ROW_SEPARATOR = '-';
  our $CORNER_MARKER = '+';
  our $HEADER_ROW_SEPARATOR = '=';
  our $HEADER_CORNER_MARKER = 'O';
  
  sub table {
  
      my %params = @_;
      my $rows = $params{rows} or die "Must provide rows!";
  
      my $widths = _maxwidths($rows);
      my $max_index = _max_array_index($rows);
  
      my $format = _get_format($widths);
      my $row_sep = _get_row_separator($widths);
      my $head_row_sep = _get_header_row_separator($widths);
  
      my @table;
      push @table, $row_sep;
  
      my $data_begins = 0;
      if ( $params{header_row} ) {
          my $header_row = $rows->[0];
  	$data_begins++;
          push @table, sprintf(
  	    $format, 
  	    map { defined($header_row->[$_]) ? $header_row->[$_] : '' } (0..$max_index)
  	);
          push @table, $params{separate_rows} ? $head_row_sep : $row_sep;
      }
  
      foreach my $row ( @{ $rows }[$data_begins..$#$rows] ) {
          push @table, sprintf(
  	    $format, 
  	    map { defined($row->[$_]) ? $row->[$_] : '' } (0..$max_index)
  	);
          push @table, $row_sep if $params{separate_rows};
      }
  
      push @table, $row_sep unless $params{separate_rows};
      return join("\n",grep {$_} @table);
  }
  
  sub _get_cols_and_rows ($) {
      my $rows = shift;
      return ( List::Util::max( map { scalar @$_ } @$rows), scalar @$rows);
  }
  
  sub _maxwidths {
      my $rows = shift;
      my $max_index = _max_array_index($rows);
      my $widths = [];
      for my $i (0..$max_index) {
          my $max = List::Util::max(map {defined $$_[$i] ? length($$_[$i]) : 0} @$rows);
          push @$widths, $max;
      }
      return $widths;
  }
  
  sub _max_array_index {
      my $rows = shift;
      return List::Util::max( map { $#$_ } @$rows );
  }
  
  sub _get_format {
      my $widths = shift;
      return "$COLUMN_SEPARATOR ".join(" $COLUMN_SEPARATOR ",map { "%-${_}s" } @$widths)." $COLUMN_SEPARATOR";
  }
  
  sub _get_row_separator {
      my $widths = shift;
      return "$CORNER_MARKER$ROW_SEPARATOR".join("$ROW_SEPARATOR$CORNER_MARKER$ROW_SEPARATOR",map { $ROW_SEPARATOR x $_ } @$widths)."$ROW_SEPARATOR$CORNER_MARKER";
  }
  
  sub _get_header_row_separator {
      my $widths = shift;
      return "$HEADER_CORNER_MARKER$HEADER_ROW_SEPARATOR".join("$HEADER_ROW_SEPARATOR$HEADER_CORNER_MARKER$HEADER_ROW_SEPARATOR",map { $HEADER_ROW_SEPARATOR x $_ } @$widths)."$HEADER_ROW_SEPARATOR$HEADER_CORNER_MARKER";
  }
  
  1;
  
  __END__
  
TEXT_TABLE_TINY

$fatpacked{"Text/WideChar/Util.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'TEXT_WIDECHAR_UTIL';
  package Text::WideChar::Util;
  
  our $DATE = '2015-01-03'; 
  our $VERSION = '0.14'; 
  
  use 5.010001;
  use locale;
  use strict;
  use utf8;
  use warnings;
  
  use Unicode::GCString;
  
  require Exporter;
  our @ISA       = qw(Exporter);
  our @EXPORT_OK = qw(
                         mbpad
                         pad
                         mbswidth
                         mbswidth_height
                         length_height
                         mbtrunc
                         trunc
                         mbwrap
                         wrap
                 );
  
  sub mbswidth {
      Unicode::GCString->new($_[0])->columns;
  }
  
  sub mbswidth_height {
      my $text = shift;
      my $num_lines = 0;
      my $len = 0;
      for my $e (split /(\r?\n)/, $text) {
          if ($e =~ /\n/) {
              $num_lines++;
              next;
          }
          $num_lines = 1 if $num_lines == 0;
          my $l = mbswidth($e);
          $len = $l if $len < $l;
      }
      [$len, $num_lines];
  }
  
  sub length_height {
      my $text = shift;
      my $num_lines = 0;
      my $len = 0;
      for my $e (split /(\r?\n)/, $text) {
          if ($e =~ /\n/) {
              $num_lines++;
              next;
          }
          $num_lines = 1 if $num_lines == 0;
          my $l = length($e);
          $len = $l if $len < $l;
      }
      [$len, $num_lines];
  }
  
  sub _get_indent_width {
      my ($is_mb, $indent, $tab_width) = @_;
      my $w = 0;
      for (split //, $indent) {
          if ($_ eq "\t") {
              $w = $tab_width * (int($w/$tab_width) + 1);
          } else {
              $w += $is_mb ? mbswidth($_) : 1;
          }
      }
      $w;
  }
  
  our $re_cjk = qr/(?:
                       \p{Block=CJK_Compatibility}
                   |   \p{Block=CJK_Compatibility_Forms}
                   |   \p{Block=CJK_Compatibility_Ideographs}
                   |   \p{Block=CJK_Compatibility_Ideographs_Supplement}
                   |   \p{Block=CJK_Radicals_Supplement}
                   |   \p{Block=CJK_Strokes}
                   |   \p{Block=CJK_Symbols_And_Punctuation}
                   |   \p{Block=CJK_Unified_Ideographs}
                   |   \p{Block=CJK_Unified_Ideographs_Extension_A}
                   |   \p{Block=CJK_Unified_Ideographs_Extension_B}
                       #|   \p{Block=CJK_Unified_Ideographs_Extension_C}
                       [ÃÂÃÂÃÂÃÂÃÂÃÂÃÂÃÂ¯ÃÂÃÂÃÂÃÂÃÂÃÂÃÂÃÂ¼ÃÂÃÂÃÂÃÂÃÂÃÂÃÂÃÂÃÂÃÂÃÂÃÂÃÂÃÂÃÂÃÂ£ÃÂÃÂÃÂÃÂÃÂÃÂÃÂÃÂÃÂÃÂÃÂÃÂÃÂÃÂÃÂÃÂ]
                   )/x;
  our $re_cjk_class = qr/[
                             \p{Block=CJK_Compatibility}
                             \p{Block=CJK_Compatibility_Forms}
                             \p{Block=CJK_Compatibility_Ideographs}
                             \p{Block=CJK_Compatibility_Ideographs_Supplement}
                             \p{Block=CJK_Radicals_Supplement}
                             \p{Block=CJK_Strokes}
                             \p{Block=CJK_Symbols_And_Punctuation}
                             \p{Block=CJK_Unified_Ideographs}
                             \p{Block=CJK_Unified_Ideographs_Extension_A}
                             \p{Block=CJK_Unified_Ideographs_Extension_B}
                             ÃÂÃÂÃÂÃÂÃÂÃÂÃÂÃÂ¯ÃÂÃÂÃÂÃÂÃÂÃÂÃÂÃÂ¼ÃÂÃÂÃÂÃÂÃÂÃÂÃÂÃÂÃÂÃÂÃÂÃÂÃÂÃÂÃÂÃÂ£ÃÂÃÂÃÂÃÂÃÂÃÂÃÂÃÂÃÂÃÂÃÂÃÂÃÂÃÂÃÂÃÂ
                        ]/x;
  our $re_cjk_negclass = qr/[^
                                \p{Block=CJK_Compatibility}
                                \p{Block=CJK_Compatibility_Forms}
                                \p{Block=CJK_Compatibility_Ideographs}
                                \p{Block=CJK_Compatibility_Ideographs_Supplement}
                                \p{Block=CJK_Radicals_Supplement}
                                \p{Block=CJK_Strokes}
                                \p{Block=CJK_Symbols_And_Punctuation}
                                \p{Block=CJK_Unified_Ideographs}
                                \p{Block=CJK_Unified_Ideographs_Extension_A}
                                \p{Block=CJK_Unified_Ideographs_Extension_B}
                                ÃÂÃÂÃÂÃÂÃÂÃÂÃÂÃÂ¯ÃÂÃÂÃÂÃÂÃÂÃÂÃÂÃÂ¼ÃÂÃÂÃÂÃÂÃÂÃÂÃÂÃÂÃÂÃÂÃÂÃÂÃÂÃÂÃÂÃÂ£ÃÂÃÂÃÂÃÂÃÂÃÂÃÂÃÂÃÂÃÂÃÂÃÂÃÂÃÂÃÂÃÂ
                        ]/x;
  
  sub _wrap {
      my ($is_mb, $text, $width, $opts) = @_;
      $width //= 80;
      $opts  //= {};
  
  
      my $tw = $opts->{tab_width} // 8;
      die "Please specify a positive tab width" unless $tw > 0;
      my $optfli  = $opts->{flindent};
      my $optfliw = _get_indent_width($is_mb, $optfli, $tw) if defined $optfli;
      my $optsli  = $opts->{slindent};
      my $optsliw = _get_indent_width($is_mb, $optsli, $tw) if defined $optsli;
      my @res;
  
      my @para = split /(\n(?:[ \t]*\n)+)/, $text;
  
      my ($maxww, $minww);
  
    PARA:
      while (my ($ptext, $pbreak) = splice @para, 0, 2) {
          my $x = 0;
          my $y = 0;
          my $line_has_word = 0;
  
          my ($fli, $sli, $fliw, $sliw);
          if (defined $optfli) {
              $fli  = $optfli;
              $fliw = $optfliw;
          } else {
              ($fli) = $ptext =~ /\A([ \t]*)\S/;
              if (defined $fli) {
                  $fliw = _get_indent_width($is_mb, $fli, $tw);
              } else {
                  $fli  = "";
                  $fliw = 0;
              }
          }
          if (defined $optsli) {
              $sli  = $optsli;
              $sliw = $optsliw;
          } else {
              ($sli) = $ptext =~ /\A[^\n]*\S[\n]([ \t+]*)\S/;
              if (defined $sli) {
                  $sliw = _get_indent_width($is_mb, $sli, $tw);
              } else {
                  $sli  = "";
                  $sliw = 0;
              }
          }
          die "Subsequent indent must be less than width" if $sliw >= $width;
  
          push @res, $fli;
          $x += $fliw;
  
          my @words0; 
          while ($ptext =~ /(?: ($re_cjk+)|(\S+) ) (\s*)/gox) {
              my $ws_after = $3 ? 1:0;
              if ($1) {
                  push @words0, $1, 1, $ws_after;
              } else {
                  my $ptext2 = $2;
                  while ($ptext2 =~ /($re_cjk_class+)|
                                     ($re_cjk_negclass+)/gox) {
                      if ($1) {
                          push @words0, $1, 1, 0;
                      } else {
                          push @words0, $2, 0, 0;
                      }
                  }
                  $words0[-1] = $ws_after;
              }
          }
  
          my $prev_ws_after;
          while (@words0) {
              my ($word0, $is_cjk, $ws_after) = splice @words0, 0, 3;
              my @words;
              my @wordsw;
              while (1) {
                  my $wordw = $is_mb ? mbswidth($word0) : length($word0);
  
                  if ($wordw <= $width-$sliw || $is_cjk) {
                      push @words , $word0;
                      push @wordsw, $wordw;
                      last;
                  }
                  if ($is_mb) {
                      my $res = mbtrunc($word0, $width-$sliw, 1);
                      push @words , $res->[0];
                      push @wordsw, $res->[1];
                      $word0 = substr($word0, length($res->[0]));
                  } else {
                      my $w2 = substr($word0, 0, $width-$sliw);
                      push @words , $w2;
                      push @wordsw, $width-$sliw;
                      $word0 = substr($word0, $width-$sliw);
                  }
              }
  
              for my $word (@words) {
                  my $wordw = shift @wordsw;
  
                  $maxww = $wordw if !defined($maxww) || $maxww < $wordw;
                  $minww = $wordw if !defined($minww) || $minww > $wordw;
  
                  my $x_after_word = $x + ($line_has_word ? 1:0) + $wordw;
                  if ($x_after_word <= $width) {
                      if ($line_has_word) {
                          if ($prev_ws_after) {
                              push @res, " ";
                              $x++;
                          }
                      }
                      push @res, $word;
                      $x += $wordw;
                  } else {
                      while (1) {
                          if ($is_cjk) {
                              my $res;
                              if ($prev_ws_after) {
                                  $res = mbtrunc($word, $width - $x - 1, 1);
                                  push @res, " ", $res->[0];
                              } else {
                                  $res = mbtrunc($word, $width - $x, 1);
                                  push @res, $res->[0];
                              }
                              my $word2 = substr($word, length($res->[0]));
                              $word = $word2;
                              $wordw = mbswidth($word);
                          }
  
                          push @res, "\n", $sli;
                          $y++;
  
                          if ($sliw + $wordw <= $width) {
                              push @res, $word;
                              $x = $sliw + $wordw;
                              last;
                          } else {
                              $x = $sliw;
                          }
                      }
                  }
                  $line_has_word++;
              }
              $prev_ws_after = $ws_after;
          }
  
          if (defined $pbreak) {
              push @res, $pbreak;
          } else {
              push @res, "\n" if $ptext =~ /\n[ \t]*\z/;
          }
      }
  
      if ($opts->{return_stats}) {
          return [join("", @res), {
              max_word_width => $maxww,
              min_word_width => $minww,
          }];
      } else {
          return join("", @res);
      }
  }
  
  sub mbwrap {
      _wrap(1, @_);
  }
  
  sub wrap {
      _wrap(0, @_);
  }
  
  sub _pad {
      my ($is_mb, $text, $width, $which, $padchar, $is_trunc) = @_;
      if ($which) {
          $which = substr($which, 0, 1);
      } else {
          $which = "r";
      }
      $padchar //= " ";
  
      my $w = $is_mb ? mbswidth($text) : length($text);
      if ($is_trunc && $w > $width) {
          my $res = mbtrunc($text, $width, 1);
          $text = $res->[0] . ($padchar x ($width-$res->[1]));
      } else {
          if ($which eq 'l') {
              $text = ($padchar x ($width-$w)) . $text;
          } elsif ($which eq 'c') {
              my $n = int(($width-$w)/2);
              $text = ($padchar x $n) . $text . ($padchar x ($width-$w-$n));
          } else {
              $text .= ($padchar x ($width-$w));
          }
      }
      $text;
  }
  
  sub mbpad {
      _pad(1, @_);
  }
  
  sub pad {
      _pad(0, @_);
  }
  
  sub _trunc {
      my ($is_mb, $text, $width, $return_width) = @_;
  
  
      my $w = $is_mb ? mbswidth($text) : length($text);
      die "Invalid argument, width must not be negative" unless $width >= 0;
      if ($w <= $width) {
          return $return_width ? [$text, $w, length($text)] : $text;
      }
  
      my $c = 0;
  
      my @res;
      my $wres = 0; 
      my $l = int($w/2); $l = 1 if $l == 0;
      my $end = 0;
      while (1) {
          my $left  = substr($text, 0, $l);
          my $right = $l > length($text) ? "" : substr($text, $l);
          my $wl = $is_mb ? mbswidth($left) : length($left);
          if ($wres + $wl > $width) {
              $text = $left;
          } else {
              push @res, $left;
              $wres += $wl;
              $c += length($left);
              $text = $right;
          }
          $l = int(($l+1)/2);
          last if $l==1 && $end>1;
          $end++ if $l==1;
      }
      if ($return_width) {
          return [join("", @res), $wres, $c];
      } else {
          return join("", @res);
      }
  }
  
  sub mbtrunc {
      _trunc(1, @_);
  }
  
  sub trunc {
      _trunc(0, @_);
  }
  
  1;
  
  __END__
  
TEXT_WIDECHAR_UTIL

$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{"Tie/IxHash.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'TIE_IXHASH';
  
  require 5.005;
  
  package Tie::IxHash;
  use strict;
  use integer;
  require Tie::Hash;
  use vars qw/@ISA $VERSION/;
  @ISA = qw(Tie::Hash);
  
  $VERSION = $VERSION = '1.23';
  
  
  sub TIEHASH {
    my($c) = shift;
    my($s) = [];
    $s->[0] = {};   
    $s->[1] = [];   
    $s->[2] = [];   
    $s->[3] = 0;    
  
    bless $s, $c;
  
    $s->Push(@_) if @_;
  
    return $s;
  }
  
  
  sub FETCH {
    my($s, $k) = (shift, shift);
    return exists( $s->[0]{$k} ) ? $s->[2][ $s->[0]{$k} ] : undef;
  }
  
  sub STORE {
    my($s, $k, $v) = (shift, shift, shift);
    
    if (exists $s->[0]{$k}) {
      my($i) = $s->[0]{$k};
      $s->[1][$i] = $k;
      $s->[2][$i] = $v;
      $s->[0]{$k} = $i;
    }
    else {
      push(@{$s->[1]}, $k);
      push(@{$s->[2]}, $v);
      $s->[0]{$k} = $#{$s->[1]};
    }
  }
  
  sub DELETE {
    my($s, $k) = (shift, shift);
  
    if (exists $s->[0]{$k}) {
      my($i) = $s->[0]{$k};
      for ($i+1..$#{$s->[1]}) {    
        $s->[0]{ $s->[1][$_] }--;    
      }
      if ( $i == $s->[3]-1 ) {
        $s->[3]--;
      }
      delete $s->[0]{$k};
      splice @{$s->[1]}, $i, 1;
      return (splice(@{$s->[2]}, $i, 1))[0];
    }
    return undef;
  }
  
  sub EXISTS {
    exists $_[0]->[0]{ $_[1] };
  }
  
  sub FIRSTKEY {
    $_[0][3] = 0;
    &NEXTKEY;
  }
  
  sub NEXTKEY {
    return $_[0][1][ $_[0][3]++ ] if ($_[0][3] <= $#{ $_[0][1] } );
    return undef;
  }
  
  
  
  
  sub new { TIEHASH(@_) }
  
  sub Clear {
    my $s = shift;
    $s->[0] = {};   
    $s->[1] = [];   
    $s->[2] = [];   
    $s->[3] = 0;    
    return;
  }
  
  sub Push {
    my($s) = shift;
    while (@_) {
      $s->STORE(shift, shift);
    }
    return scalar(@{$s->[1]});
  }
  
  sub Push2 {
    my($s) = shift;
    $s->Splice($#{$s->[1]}+1, 0, @_);
    return scalar(@{$s->[1]});
  }
  
  sub Pop {
    my($s) = shift;
    my($k, $v, $i);
    $k = pop(@{$s->[1]});
    $v = pop(@{$s->[2]});
    if (defined $k) {
      delete $s->[0]{$k};
      return ($k, $v);
    }
    return undef;
  }
  
  sub Pop2 {
    return $_[0]->Splice(-1);
  }
  
  sub Shift {
    my($s) = shift;
    my($k, $v, $i);
    $k = shift(@{$s->[1]});
    $v = shift(@{$s->[2]});
    if (defined $k) {
      delete $s->[0]{$k};
      for (keys %{$s->[0]}) {
        $s->[0]{$_}--;
      }
      return ($k, $v);
    }
    return undef;
  }
  
  sub Shift2 {
    return $_[0]->Splice(0, 1);
  }
  
  sub Unshift {
    my($s) = shift;
    my($k, $v, @k, @v, $len, $i);
  
    while (@_) {
      ($k, $v) = (shift, shift);
      if (exists $s->[0]{$k}) {
        $i = $s->[0]{$k};
        $s->[1][$i] = $k;
        $s->[2][$i] = $v;
        $s->[0]{$k} = $i;
      }
      else {
        push(@k, $k);
        push(@v, $v);
        $len++;
      }
    }
    if (defined $len) {
      for (keys %{$s->[0]}) {
        $s->[0]{$_} += $len;
      }
      $i = 0;
      for (@k) {
        $s->[0]{$_} = $i++;
      }
      unshift(@{$s->[1]}, @k);
      return unshift(@{$s->[2]}, @v);
    }
    return scalar(@{$s->[1]});
  }
  
  sub Unshift2 {
    my($s) = shift;
    $s->Splice(0,0,@_);
    return scalar(@{$s->[1]});
  }
  
  sub Splice {
    my($s, $start, $len) = (shift, shift, shift);
    my($k, $v, @k, @v, @r, $i, $siz);
    my($end);                   
  
    ($start, $end, $len) = $s->_lrange($start, $len);
  
    if (defined $start) {
      if ($len > 0) {
        my(@k) = splice(@{$s->[1]}, $start, $len);
        my(@v) = splice(@{$s->[2]}, $start, $len);
        while (@k) {
          $k = shift(@k);
          delete $s->[0]{$k};
          push(@r, $k, shift(@v));
        }
        for ($start..$#{$s->[1]}) {
          $s->[0]{$s->[1][$_]} -= $len;
        }
      }
      while (@_) {
        ($k, $v) = (shift, shift);
        if (exists $s->[0]{$k}) {
          $i = $s->[0]{$k};
          $s->[1][$i] = $k;
          $s->[2][$i] = $v;
          $s->[0]{$k} = $i;
        }
        else {
          push(@k, $k);
          push(@v, $v);
          $siz++;
        }
      }
      if (defined $siz) {
        for ($start..$#{$s->[1]}) {
          $s->[0]{$s->[1][$_]} += $siz;
        }
        $i = $start;
        for (@k) {
          $s->[0]{$_} = $i++;
        }
        splice(@{$s->[1]}, $start, 0, @k);
        splice(@{$s->[2]}, $start, 0, @v);
      }
    }
    return @r;
  }
  
  sub Delete {
    my($s) = shift;
  
    for (@_) {
      $s->DELETE($_);
    }
  }
  
  sub Replace {
    my($s) = shift;
    my($i, $v, $k) = (shift, shift, shift);
    if (defined $i and $i <= $#{$s->[1]} and $i >= 0) {
      if (defined $k) {
        delete $s->[0]{ $s->[1][$i] };
        $s->DELETE($k) ; 
        $s->[1][$i] = $k;
        $s->[2][$i] = $v;
        $s->[0]{$k} = $i;
        return $k;
      }
      else {
        $s->[2][$i] = $v;
        return $s->[1][$i];
      }
    }
    return undef;
  }
  
  sub _lrange {
    my($s) = shift;
    my($offset, $len) = @_;
    my($start, $end);         
    my($size) = $#{$s->[1]}+1;
  
    return undef unless defined $offset;
    if($offset < 0) {
      $start = $offset + $size;
      $start = 0 if $start < 0;
    }
    else {
      ($offset > $size) ? ($start = $size) : ($start = $offset);
    }
  
    if (defined $len) {
      $len = -$len if $len < 0;
      $len = $size - $start if $len > $size - $start;
    }
    else {
      $len = $size - $start;
    }
    $end = $start + $len - 1;
  
    return ($start, $end, $len);
  }
  
  sub Keys   { 
    my($s) = shift;
    return ( @_ == 1
  	 ? $s->[1][$_[0]]
  	 : ( @_
  	   ? @{$s->[1]}[@_]
  	   : @{$s->[1]} ) );
  }
  
  sub Values {
    my($s) = shift;
    return ( @_ == 1
  	 ? $s->[2][$_[0]]
  	 : ( @_
  	   ? @{$s->[2]}[@_]
  	   : @{$s->[2]} ) );
  }
  
  sub Indices { 
    my($s) = shift;
    return ( @_ == 1 ? $s->[0]{$_[0]} : @{$s->[0]}{@_} );
  }
  
  sub Length {
   return scalar @{$_[0]->[1]};
  }
  
  sub Reorder {
    my($s) = shift;
    my(@k, @v, %x, $i);
    return unless @_;
  
    $i = 0;
    for (@_) {
      if (exists $s->[0]{$_}) {
        push(@k, $_);
        push(@v, $s->[2][ $s->[0]{$_} ] );
        $x{$_} = $i++;
      }
    }
    $s->[1] = \@k;
    $s->[2] = \@v;
    $s->[0] = \%x;
    return $s;
  }
  
  sub SortByKey {
    my($s) = shift;
    $s->Reorder(sort $s->Keys);
  }
  
  sub SortByValue {
    my($s) = shift;
    $s->Reorder(sort { $s->FETCH($a) cmp $s->FETCH($b) } $s->Keys)
  }
  
  1;
  __END__
  
TIE_IXHASH

$fatpacked{"Time/Duration.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'TIME_DURATION';
  package Time::Duration;
  $Time::Duration::VERSION = '1.20';
  use 5.006;
  use strict;
  use warnings;
  use constant DEBUG => 0;
  
  require Exporter;
  
  our @ISA         = ('Exporter');
  our @EXPORT      = qw( later later_exact earlier earlier_exact
                         ago ago_exact from_now from_now_exact
                         duration duration_exact
                         concise
                       );
  our @EXPORT_OK   = ('interval', @EXPORT);
  our $MILLISECOND = 0;
  
  
  
  sub concise ($) {
    my $string = $_[0];
    DEBUG and print "in : $string\n";
    $string =~ tr/,//d;
    $string =~ s/\band\b//;
    $string =~ s/\b(year|day|hour|minute|second)s?\b/substr($1,0,1)/eg;
    $string =~ s/\b(millisecond)s?\b/ms/g;
    $string =~ s/\s*(\d+)\s*/$1/g;
    return $string;
  }
  
  sub later {
    interval(      $_[0], $_[1], ' earlier', ' later', 'right then'); }
  sub later_exact {
    interval_exact($_[0], $_[1], ' earlier', ' later', 'right then'); }
  sub earlier {
    interval(      $_[0], $_[1], ' later', ' earlier', 'right then'); }
  sub earlier_exact {
    interval_exact($_[0], $_[1], ' later', ' earlier', 'right then'); }
  sub ago {
    interval(      $_[0], $_[1], ' from now', ' ago', 'right now'); }
  sub ago_exact {
    interval_exact($_[0], $_[1], ' from now', ' ago', 'right now'); }
  sub from_now {
    interval(      $_[0], $_[1], ' ago', ' from now', 'right now'); }
  sub from_now_exact {
    interval_exact($_[0], $_[1], ' ago', ' from now', 'right now'); }
  
  sub duration_exact {
    my $span = $_[0];   
    my $precision = int($_[1] || 0) || 2;  
    return '0 seconds' unless $span;
    _render('',
            _separate(abs $span));
  }
  
  sub duration {
    my $span = $_[0];   
    my $precision = int($_[1] || 0) || 2;  
    return '0 seconds' unless $span;
    _render('',
            _approximate($precision,
                         _separate(abs $span)));
  }
  
  
  sub interval_exact {
    my $span = $_[0];                    
    my $direction = ($span < 0) ? $_[2]  
                  : ($span > 0) ? $_[3]  
                  : return        $_[4]; 
    _render($direction,
            _separate($span));
  }
  
  sub interval {
    my $span = $_[0];                     
    my $precision = int($_[1] || 0) || 2; 
    my $direction = ($span < 0) ? $_[2]   
                  : ($span > 0) ? $_[3]   
                  : return        $_[4];  
    _render($direction,
            _approximate($precision,
                         _separate($span)));
  }
  
  
  use constant MINUTE => 60;
  use constant HOUR => 3600;
  use constant DAY  => 24 * HOUR;
  use constant YEAR => 365 * DAY;
  
  sub _separate {
    
    my $remainder = abs $_[0]; 
    my $this; 
    my @wheel; 
    
    $this = int($remainder / (365 * 24 * 60 * 60));
    push @wheel, ['year', $this, 1_000_000_000];
    $remainder -= $this * (365 * 24 * 60 * 60);
      
    $this = int($remainder / (24 * 60 * 60));
    push @wheel, ['day', $this, 365];
    $remainder -= $this * (24 * 60 * 60);
      
    $this = int($remainder / (60 * 60));
    push @wheel, ['hour', $this, 24];
    $remainder -= $this * (60 * 60);
    
    $this = int($remainder / 60);
    push @wheel, ['minute', $this, 60];
    $remainder -= $this * 60;
    
    push @wheel, ['second', int($remainder), 60];
  
  	if ($MILLISECOND) {
  		$remainder -= int($remainder);
  		push @wheel, ['millisecond', sprintf("%0.f", $remainder * 1000), 1000];
  	}
  
    return @wheel;
  }
  
  sub _approximate {
    my($precision, @wheel) = @_;
  
   Fix:
    {
    
      my $nonzero_count = 0;
      my $improperly_expressed;
  
      DEBUG and print join ' ', '#', (map "${$_}[1] ${$_}[0]",  @wheel), "\n";
      for(my $i = 0; $i < @wheel; $i++) {
        my $this = $wheel[$i];
        next if $this->[1] == 0; 
        ++$nonzero_count;
        next if $i == 0; 
        
        if($nonzero_count > $precision) {
          DEBUG and print '', $this->[0], " is one nonzero too many!\n";
  
          if($this->[1] >= ($this->[-1] / 2)) {
            DEBUG and printf "incrementing %s from %s to %s\n",
             $wheel[$i-1][0], $wheel[$i-1][1], 1 + $wheel[$i-1][1], ;
            ++$wheel[$i-1][1];
          }
  
          for(my $j = $i; $j < @wheel; $j++) { $wheel[$j][1] = 0 }
          redo Fix; 
        } elsif($this->[1] >= $this->[-1]) {
          $improperly_expressed = $i;
          DEBUG and print '', $this->[0], ' (', $this->[1], 
             ") is improper!\n";
        }
      }
      
      if(defined $improperly_expressed) {
        DEBUG and printf "incrementing %s from %s to %s\n",
         $wheel[$improperly_expressed-1][0], $wheel[$improperly_expressed-1][1], 
          1 + $wheel[$improperly_expressed-1][1], ;
        ++$wheel[ $improperly_expressed - 1][1];
        $wheel[ $improperly_expressed][1] = 0;
        redo Fix; 
      }
      
    }
  
    return @wheel;
  }
  
  sub _render {
  
    my $direction = shift @_;
    my @wheel = map
          {;
              (  $_->[1] == 0) ? ()  
              : ($_->[1] == 1) ? "${$_}[1] ${$_}[0]"  
              :                  "${$_}[1] ${$_}[0]s" 
          }
          @_
    ;
    return "just now" unless @wheel; 
    $wheel[-1] .= $direction;
    return $wheel[0] if @wheel == 1;
    return "$wheel[0] and $wheel[1]" if @wheel == 2;
    $wheel[-1] = "and $wheel[-1]";
    return join q{, }, @wheel;
  }
  
  1;
  
  __END__
  
  so "1y 0d 1h 50m 50s", N=3, so you round at minutes to "1y 0d 1h 51m 0s",
  #That's okay, so fall thru.
  
  so "1y 1d 0h 59m 50s", N=3, so you round at minutes to "1y 1d 0h 60m 0s",
  but that's not improperly expressed, so you loop around and get
  "1y 1d 1h 0m 0s", which is short enough, and is properly expressed.
  
  
  
TIME_DURATION

$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{"Unicode/GCString.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'UNICODE_GCSTRING';
  
  package Unicode::GCString;
  require 5.008;
  
  
  use strict;
  use warnings;
  use vars qw($VERSION @EXPORT_OK @ISA);
  
  use Exporter;
  our @EXPORT_OK = qw();
  our %EXPORT_TAGS = ('all' => [@EXPORT_OK]);
  
  our @ISA = qw(Exporter);
  
  use Unicode::LineBreak;
  
  
  our $VERSION = '2013.10';
  
  use overload 
      '@{}' => \&as_arrayref,
      '${}' => \&as_scalarref,
      '""' => \&as_string,
      '.' => \&concat,
      'cmp' => \&cmp,
      '<>' => \&next,
      ;
  
  sub new {
      my $class = shift;
  
      my $self;
      if (scalar @_ <= 2) {
  	$self = __PACKAGE__->_new(@_);
      } else {
  	my $str = shift;
  	my $lb = Unicode::LineBreak->new(@_);
  	$self = __PACKAGE__->_new($str, $lb);
      }
      bless $self, $class;
  }
  
  sub as_arrayref {
      my @a = shift->as_array;
      return \@a;
  }
  
  1;
UNICODE_GCSTRING

$fatpacked{"Unicode/LineBreak.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'UNICODE_LINEBREAK';
  
  package Unicode::LineBreak;
  require 5.008;
  
  use strict;
  use warnings;
  use vars qw($VERSION @EXPORT_OK @ISA $Config @Config);
  
  use Exporter;
  our @EXPORT_OK = qw(UNICODE_VERSION SOMBOK_VERSION context);
  our %EXPORT_TAGS = ('all' => [@EXPORT_OK]);
  
  our @ISA = qw(Exporter);
  
  use Carp qw(croak carp);
  use Encode qw(is_utf8);
  use MIME::Charset;
  use Unicode::GCString;
  
  
  our $VERSION = '2014.06';
  
  our @Config = (
      BreakIndent => 'YES',
      CharMax => 998,
      ColMax => 76,
      ColMin => 0,
      ComplexBreaking => 'YES',
      Context => 'NONEASTASIAN',
      EAWidth => undef,
      Format => 'SIMPLE',
      HangulAsAL => 'NO',
      LBClass => undef,
      LegacyCM => 'YES',
      Newline => "\n",
      Prep => undef,
      Sizing => 'UAX11',
      Urgent => undef,
      ViramaAsJoiner => 'YES',
  );
  our $Config = {};
  eval { require Unicode::LineBreak::Defaults; };
  push @Config, (%$Config);
  
  use Unicode::LineBreak::Constants;
  use constant 1.01;
  my $package = __PACKAGE__;
  my @consts = grep { s/^${package}::(\w\w+)$/$1/ } keys %constant::declared;
  push @EXPORT_OK, @consts;
  push @{$EXPORT_TAGS{'all'}}, @consts;
  
  require XSLoader;
  XSLoader::load('Unicode::LineBreak', $VERSION);
  
  foreach my $p ((['EA', EAWidths()], ['LB', LBClasses()])) {
      my $prop = shift @{$p};
      my $idx = 0;
      foreach my $val (@{$p}) {
  	no strict;
  	my $const = "${prop}_${val}";
  	*{$const} = eval "sub { $idx }";
  	push @EXPORT_OK, $const;
  	push @{$EXPORT_TAGS{'all'}}, $const;
  	$idx++;
      }
  }
  
  my $EASTASIAN_CHARSETS = qr{
      ^BIG5 |
      ^CP9\d\d |
      ^EUC- |
      ^GB18030 | ^GB2312 | ^GBK |
      ^HZ |
      ^ISO-2022- |
      ^KS_C_5601 |
      ^SHIFT_JIS
  }ix;
  
  my $EASTASIAN_LANGUAGES = qr{
      ^AIN |
      ^JA\b | ^JPN |
      ^KO\b | ^KOR |
      ^ZH\b | ^CHI
  }ix;
  
  use overload
      '%{}' => \&as_hashref,
      '${}' => \&as_scalarref,
      '""' => \&as_string,
      ;
  
  sub new {
      my $class = shift;
  
      my $self = __PACKAGE__->_new();
      $self->config(@Config);
      $self->config(@_);
      bless $self, $class;
  }
  
  sub config ($@) {
      my $self = shift;
  
      if (scalar @_ == 1) {
  	my $k = shift;
  	my $ret;
  
  	if (uc $k eq uc 'CharactersMax') {
  	    return $self->_config('CharMax');
  	} elsif (uc $k eq uc 'ColumnsMax') {
  	    return $self->_config('ColMax');
  	} elsif (uc $k eq uc 'ColumnsMin') {
  	    return $self->_config('ColMin');
  	} elsif (uc $k eq uc 'SizingMethod') {
  	    return $self->_config('Sizing');
  	} elsif (uc $k eq uc 'TailorEA') {
  	    carp "$k is obsoleted.  Use EAWidth";
  	    $ret = $self->_config('EAWidth');
  	    if (! defined $ret) {
  		return [];
  	    } else {
  		return [map { ($_->[0] => $_->[1]) } @{$ret}];
  	    }
  	} elsif (uc $k eq uc 'TailorLB') {
  	    carp "$k is obsoleted.  Use LBClass";
  	    $ret = $self->_config('LBClass');
  	    if (! defined $ret) {
  		return [];
  	    } else {
  		return [map { ($_->[0] => $_->[1]) } @{$ret}];
  	    }
  	} elsif (uc $k eq uc 'UrgentBreaking') {
  	    return $self->_config('Urgent');
  	} elsif (uc $k eq uc 'UserBreaking') {
  	    carp "$k is obsoleted.  Use Prep";
  	    $ret = $self->_config('Prep');
  	    if (! defined $ret) {
  		return [];
  	    } else {
  		return $ret;
  	    }
  	} else {
  	    return $self->_config($k);
  	}
      }
  
      my @config = ();
      while (0 < scalar @_) {
  	my $k = shift;
  	my $v = shift;
  
          if (uc $k eq uc 'CharactersMax') {
  	    push @config, 'CharMax' => $v;
  	} elsif (uc $k eq uc 'ColumnsMax') {
  	    push @config, 'ColMax' => $v;
  	} elsif (uc $k eq uc 'ColumnsMin') {
  	    push @config, 'ColMin' => $v;
  	} elsif (uc $k eq uc 'SizingMethod') {
  	    push @config, 'Sizing' => $v;
  	} elsif (uc $k eq uc 'TailorLB') {
  	    carp "$k is obsoleted.  Use LBClass";
  	    push @config, 'LBClass' => undef;
  	    if (! defined $v) {
  		;
  	    } else {
  		my @v = @{$v};
  		while (scalar(@v)) {
  		    my $k = shift @v;
  		    my $v = shift @v;
  		    push @config, 'LBClass' => [ $k => $v ];
  		}
  	    }
  	} elsif (uc $k eq uc 'TailorEA') {
  	    carp "$k is obsoleted.  Use EAWidth";
  	    push @config, 'EAWidth' => undef;
  	    if (! defined $v) {
  		;
  	    } else {
  		my @v = @{$v};
  		while (scalar(@v)) {
  		    my $k = shift @v;
  		    my $v = shift @v;
  		    push @config, 'EAWidth' => [ $k => $v ];
  		}
  	    }
  	} elsif (uc $k eq uc 'UserBreaking') {
  	    carp "$k is obsoleted.  Use Prep";
  	    push @config, 'Prep' => undef;
  	    if (! defined $v) {
  		;
  	    } elsif (ref $v eq 'ARRAY') {
  		push @config, map { ('Prep' => $_) } @{$v};
  	    } else {
  		push @config, 'Prep' => $v;
  	    }
  	} elsif (uc $k eq uc 'UrgentBreaking') {
  	    push @config, 'Urgent' => $v;
  	} else {
  	    push @config, $k => $v;
  	}
      }
  
      $self->_config(@config) if scalar @config;
  }
  
  sub context (@) {
      my %opts = @_;
  
      my $charset;
      my $language;
      my $context;
      foreach my $k (keys %opts) {
  	if (uc $k eq 'CHARSET') {
  	    if (ref $opts{$k}) {
  		$charset = $opts{$k}->as_string;
  	    } else {
  		$charset = MIME::Charset->new($opts{$k})->as_string;
  	    }
  	} elsif (uc $k eq 'LANGUAGE') {
  	    $language = uc $opts{$k};
  	    $language =~ s/_/-/;
  	}
      }
      if ($charset and $charset =~ /$EASTASIAN_CHARSETS/) {
          $context = 'EASTASIAN';
      } elsif ($language and $language =~ /$EASTASIAN_LANGUAGES/) {
  	$context = 'EASTASIAN';
      } else {
  	$context = 'NONEASTASIAN';
      }
      $context;
  }
  
  1;
UNICODE_LINEBREAK

$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-06-14'; 
  our $VERSION = '0.22'; 
  
  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 => '',
          },
          delay => {
              summary => 'Pause a number of seconds between files',
              schema => ['int*', min=>0],
              description => <<'_',
  
  If you upload a lot of files (e.g. 7-10 or more) at a time, the PAUSE indexer
  currently might choke with SQLite database locking problem and thus fail to
  index your releases. Giving a delay of say 2-3 minutes (120-180 seconds) between
  files will alleviate this problem.
  
  _
          },
      },
  };
  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();
  
      my $i = 0;
      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]);
  
          if ($args{delay} && ++$i < @$files) {
              $log->tracef("Sleeping between flies for %d second(s) ...", $args{delay});
              sleep $args{delay};
          }
      }
      $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{"YAML/Old.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'YAML_OLD';
  use strict; use warnings;
  package YAML::Old;
  our $VERSION = '1.07';
  
  use YAML::Old::Mo;
  
  use Exporter;
  push @YAML::Old::ISA, 'Exporter';
  our @EXPORT = qw{ Dump Load };
  our @EXPORT_OK = qw{ freeze thaw DumpFile LoadFile Bless Blessed };
  
  use YAML::Old::Node; 
  
  {
      package
      YAML;
      use constant VALUE => "\x07YAML\x07VALUE\x07";
  }
  
  has dumper_class => default => sub {'YAML::Old::Dumper'};
  has loader_class => default => sub {'YAML::Old::Loader'};
  has dumper_object => default => sub {$_[0]->init_action_object("dumper")};
  has loader_object => default => sub {$_[0]->init_action_object("loader")};
  
  sub Dump {
      my $yaml = YAML::Old->new;
      $yaml->dumper_class($YAML::Old::DumperClass)
          if $YAML::Old::DumperClass;
      return $yaml->dumper_object->dump(@_);
  }
  
  sub Load {
      my $yaml = YAML::Old->new;
      $yaml->loader_class($YAML::Old::LoaderClass)
          if $YAML::Old::LoaderClass;
      return $yaml->loader_object->load(@_);
  }
  
  {
      no warnings 'once';
      *freeze = \ &Dump;
      *thaw   = \ &Load;
  }
  
  sub DumpFile {
      my $OUT;
      my $filename = shift;
      if (ref $filename eq 'GLOB') {
          $OUT = $filename;
      }
      else {
          my $mode = '>';
          if ($filename =~ /^\s*(>{1,2})\s*(.*)$/) {
              ($mode, $filename) = ($1, $2);
          }
          open $OUT, $mode, $filename
            or YAML::Old::Mo::Object->die('YAML_DUMP_ERR_FILE_OUTPUT', $filename, $!);
      }
      binmode $OUT, ':utf8';  
      local $/ = "\n"; 
      print $OUT Dump(@_);
  }
  
  sub LoadFile {
      my $IN;
      my $filename = shift;
      if (ref $filename eq 'GLOB') {
          $IN = $filename;
      }
      else {
          open $IN, '<', $filename
            or YAML::Old::Mo::Object->die('YAML_LOAD_ERR_FILE_INPUT', $filename, $!);
      }
      binmode $IN, ':utf8';  
      return Load(do { local $/; <$IN> });
  }
  
  sub init_action_object {
      my $self = shift;
      my $object_class = (shift) . '_class';
      my $module_name = $self->$object_class;
      eval "require $module_name";
      $self->die("Error in require $module_name - $@")
          if $@ and "$@" !~ /Can't locate/;
      my $object = $self->$object_class->new;
      $object->set_global_options;
      return $object;
  }
  
  my $global = {};
  sub Bless {
      require YAML::Old::Dumper::Base;
      YAML::Old::Dumper::Base::bless($global, @_)
  }
  sub Blessed {
      require YAML::Old::Dumper::Base;
      YAML::Old::Dumper::Base::blessed($global, @_)
  }
  sub global_object { $global }
  
  1;
YAML_OLD

$fatpacked{"YAML/Old/Dumper.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'YAML_OLD_DUMPER';
  package YAML::Old::Dumper;
  
  use YAML::Old::Mo;
  extends 'YAML::Old::Dumper::Base';
  
  use YAML::Old::Dumper::Base;
  use YAML::Old::Node;
  use YAML::Old::Types;
  
  use constant KEY       => 3;
  use constant BLESSED   => 4;
  use constant FROMARRAY => 5;
  use constant VALUE     => "\x07YAML\x07VALUE\x07";
  
  my $ESCAPE_CHAR = '[\\x00-\\x08\\x0b-\\x0d\\x0e-\\x1f]';
  my $LIT_CHAR    = '|';
  
  sub dump {
      my $self = shift;
      $self->stream('');
      $self->document(0);
      for my $document (@_) {
          $self->{document}++;
          $self->transferred({});
          $self->id_refcnt({});
          $self->id_anchor({});
          $self->anchor(1);
          $self->level(0);
          $self->offset->[0] = 0 - $self->indent_width;
          $self->_prewalk($document);
          $self->_emit_header($document);
          $self->_emit_node($document);
      }
      return $self->stream;
  }
  
  sub _emit_header {
      my $self = shift;
      my ($node) = @_;
      if (not $self->use_header and
          $self->document == 1
         ) {
          $self->die('YAML_DUMP_ERR_NO_HEADER')
            unless ref($node) =~ /^(HASH|ARRAY)$/;
          $self->die('YAML_DUMP_ERR_NO_HEADER')
            if ref($node) eq 'HASH' and keys(%$node) == 0;
          $self->die('YAML_DUMP_ERR_NO_HEADER')
            if ref($node) eq 'ARRAY' and @$node == 0;
          $self->headless(1);
          return;
      }
      $self->{stream} .= '---';
      if ($self->use_version) {
      }
  }
  
  sub _prewalk {
      my $self = shift;
      my $stringify = $self->stringify;
      my ($class, $type, $node_id) = $self->node_info(\$_[0], $stringify);
  
      if ($type eq 'GLOB') {
          $self->transferred->{$node_id} =
            YAML::Old::Type::glob->yaml_dump($_[0]);
          $self->_prewalk($self->transferred->{$node_id});
          return;
      }
  
      if (ref($_[0]) eq 'Regexp') {
          return;
      }
  
      if (not ref $_[0]) {
          $self->{id_refcnt}{$node_id}++ if $self->purity;
          return;
      }
  
      my $value = $_[0];
      ($class, $type, $node_id) = $self->node_info($value, $stringify);
  
      return if (ref($value) and not $type);
  
      if ($self->transferred->{$node_id}) {
          (undef, undef, $node_id) = (ref $self->transferred->{$node_id})
            ? $self->node_info($self->transferred->{$node_id}, $stringify)
            : $self->node_info(\ $self->transferred->{$node_id}, $stringify);
          $self->{id_refcnt}{$node_id}++;
          return;
      }
  
      if ($type eq 'CODE') {
          $self->transferred->{$node_id} = 'placeholder';
          YAML::Old::Type::code->yaml_dump(
              $self->dump_code,
              $_[0],
              $self->transferred->{$node_id}
          );
          ($class, $type, $node_id) =
            $self->node_info(\ $self->transferred->{$node_id}, $stringify);
          $self->{id_refcnt}{$node_id}++;
          return;
      }
  
      if (defined $class) {
          if ($value->can('yaml_dump')) {
              $value = $value->yaml_dump;
          }
          elsif ($type eq 'SCALAR') {
              $self->transferred->{$node_id} = 'placeholder';
              YAML::Old::Type::blessed->yaml_dump
                ($_[0], $self->transferred->{$node_id});
              ($class, $type, $node_id) =
                $self->node_info(\ $self->transferred->{$node_id}, $stringify);
              $self->{id_refcnt}{$node_id}++;
              return;
          }
          else {
              $value = YAML::Old::Type::blessed->yaml_dump($value);
          }
          $self->transferred->{$node_id} = $value;
          (undef, $type, $node_id) = $self->node_info($value, $stringify);
      }
  
      require YAML::Old;
      if (defined YAML::Old->global_object()->{blessed_map}{$node_id}) {
          $value = YAML::Old->global_object()->{blessed_map}{$node_id};
          $self->transferred->{$node_id} = $value;
          ($class, $type, $node_id) = $self->node_info($value, $stringify);
          $self->_prewalk($value);
          return;
      }
  
      if ($type eq 'REF' or $type eq 'SCALAR') {
          $value = YAML::Old::Type::ref->yaml_dump($value);
          $self->transferred->{$node_id} = $value;
          (undef, $type, $node_id) = $self->node_info($value, $stringify);
      }
  
      elsif ($type eq 'GLOB') {
          my $ref_ynode = $self->transferred->{$node_id} =
            YAML::Old::Type::ref->yaml_dump($value);
  
          my $glob_ynode = $ref_ynode->{&VALUE} =
            YAML::Old::Type::glob->yaml_dump($$value);
  
          (undef, undef, $node_id) = $self->node_info($glob_ynode, $stringify);
          $self->transferred->{$node_id} = $glob_ynode;
          $self->_prewalk($glob_ynode);
          return;
      }
  
      return if ++($self->{id_refcnt}{$node_id}) > 1;
  
      if ($type eq 'HASH') {
          $self->_prewalk($value->{$_})
              for keys %{$value};
          return;
      }
      elsif ($type eq 'ARRAY') {
          $self->_prewalk($_)
              for @{$value};
          return;
      }
  
      $self->warn(<<"...");
  YAML::Old::Dumper can't handle dumping this type of data.
  Please report this to the author.
  
  id:    $node_id
  type:  $type
  class: $class
  value: $value
  
  ...
  
      return;
  }
  
  sub _emit_node {
      my $self = shift;
      my ($type, $node_id);
      my $ref = ref($_[0]);
      if ($ref) {
          if ($ref eq 'Regexp') {
              $self->_emit(' !!perl/regexp');
              $self->_emit_str("$_[0]");
              return;
          }
          (undef, $type, $node_id) = $self->node_info($_[0], $self->stringify);
      }
      else {
          $type = $ref || 'SCALAR';
          (undef, undef, $node_id) = $self->node_info(\$_[0], $self->stringify);
      }
  
      my ($ynode, $tag) = ('') x 2;
      my ($value, $context) = (@_, 0);
  
      if (defined $self->transferred->{$node_id}) {
          $value = $self->transferred->{$node_id};
          $ynode = ynode($value);
          if (ref $value) {
              $tag = defined $ynode ? $ynode->tag->short : '';
              (undef, $type, $node_id) =
                $self->node_info($value, $self->stringify);
          }
          else {
              $ynode = ynode($self->transferred->{$node_id});
              $tag = defined $ynode ? $ynode->tag->short : '';
              $type = 'SCALAR';
              (undef, undef, $node_id) =
                $self->node_info(
                    \ $self->transferred->{$node_id},
                    $self->stringify
                );
          }
      }
      elsif ($ynode = ynode($value)) {
          $tag = $ynode->tag->short;
      }
  
      if ($self->use_aliases) {
          $self->{id_refcnt}{$node_id} ||= 0;
          if ($self->{id_refcnt}{$node_id} > 1) {
              if (defined $self->{id_anchor}{$node_id}) {
                  $self->{stream} .= ' *' . $self->{id_anchor}{$node_id} . "\n";
                  return;
              }
              my $anchor = $self->anchor_prefix . $self->{anchor}++;
              $self->{stream} .= ' &' . $anchor;
              $self->{id_anchor}{$node_id} = $anchor;
          }
      }
  
      return $self->_emit_str("$value")   
        if ref($value) and not $type;
      return $self->_emit_scalar($value, $tag)
        if $type eq 'SCALAR' and $tag;
      return $self->_emit_str($value)
        if $type eq 'SCALAR';
      return $self->_emit_mapping($value, $tag, $node_id, $context)
        if $type eq 'HASH';
      return $self->_emit_sequence($value, $tag)
        if $type eq 'ARRAY';
      $self->warn('YAML_DUMP_WARN_BAD_NODE_TYPE', $type);
      return $self->_emit_str("$value");
  }
  
  sub _emit_mapping {
      my $self = shift;
      my ($value, $tag, $node_id, $context) = @_;
      $self->{stream} .= " !$tag" if $tag;
  
      my $empty_hash = not(eval {keys %$value});
      $self->warn('YAML_EMIT_WARN_KEYS', $@) if $@;
      return ($self->{stream} .= " {}\n") if $empty_hash;
  
      if ($context == FROMARRAY and
          $self->compress_series and
          not (defined $self->{id_anchor}{$node_id} or $tag or $empty_hash)
         ) {
          $self->{stream} .= ' ';
          $self->offset->[$self->level+1] = $self->offset->[$self->level] + 2;
      }
      else {
          $context = 0;
          $self->{stream} .= "\n"
            unless $self->headless && not($self->headless(0));
          $self->offset->[$self->level+1] =
            $self->offset->[$self->level] + $self->indent_width;
      }
  
      $self->{level}++;
      my @keys;
      if ($self->sort_keys == 1) {
          if (ynode($value)) {
              @keys = keys %$value;
          }
          else {
              @keys = sort keys %$value;
          }
      }
      elsif ($self->sort_keys == 2) {
          @keys = sort keys %$value;
      }
      elsif (ref($self->sort_keys) eq 'ARRAY') {
          my $i = 1;
          my %order = map { ($_, $i++) } @{$self->sort_keys};
          @keys = sort {
              (defined $order{$a} and defined $order{$b})
                ? ($order{$a} <=> $order{$b})
                : ($a cmp $b);
          } keys %$value;
      }
      else {
          @keys = keys %$value;
      }
      if (exists $value->{&VALUE}) {
          for (my $i = 0; $i < @keys; $i++) {
              if ($keys[$i] eq &VALUE) {
                  splice(@keys, $i, 1);
                  push @keys, &VALUE;
                  last;
              }
          }
      }
  
      for my $key (@keys) {
          $self->_emit_key($key, $context);
          $context = 0;
          $self->{stream} .= ':';
          $self->_emit_node($value->{$key});
      }
      $self->{level}--;
  }
  
  sub _emit_sequence {
      my $self = shift;
      my ($value, $tag) = @_;
      $self->{stream} .= " !$tag" if $tag;
  
      return ($self->{stream} .= " []\n") if @$value == 0;
  
      $self->{stream} .= "\n"
        unless $self->headless && not($self->headless(0));
  
      if ($self->inline_series and
          @$value <= $self->inline_series and
          not (scalar grep {ref or /\n/} @$value)
         ) {
          $self->{stream} =~ s/\n\Z/ /;
          $self->{stream} .= '[';
          for (my $i = 0; $i < @$value; $i++) {
              $self->_emit_str($value->[$i], KEY);
              last if $i == $#{$value};
              $self->{stream} .= ', ';
          }
          $self->{stream} .= "]\n";
          return;
      }
  
      $self->offset->[$self->level + 1] =
        $self->offset->[$self->level] + $self->indent_width;
      $self->{level}++;
      for my $val (@$value) {
          $self->{stream} .= ' ' x $self->offset->[$self->level];
          $self->{stream} .= '-';
          $self->_emit_node($val, FROMARRAY);
      }
      $self->{level}--;
  }
  
  sub _emit_key {
      my $self = shift;
      my ($value, $context) = @_;
      $self->{stream} .= ' ' x $self->offset->[$self->level]
        unless $context == FROMARRAY;
      $self->_emit_str($value, KEY);
  }
  
  sub _emit_scalar {
      my $self = shift;
      my ($value, $tag) = @_;
      $self->{stream} .= " !$tag";
      $self->_emit_str($value, BLESSED);
  }
  
  sub _emit {
      my $self = shift;
      $self->{stream} .= join '', @_;
  }
  
  sub _emit_str {
      my $self = shift;
      my $type = $_[1] || 0;
  
      $self->offset->[$self->level + 1] =
        $self->offset->[$self->level] + $self->indent_width;
      $self->{level}++;
  
      my $sf = $type == KEY ? '' : ' ';
      my $sb = $type == KEY ? '? ' : ' ';
      my $ef = $type == KEY ? '' : "\n";
      my $eb = "\n";
  
      while (1) {
          $self->_emit($sf),
          $self->_emit_plain($_[0]),
          $self->_emit($ef), last
            if not defined $_[0];
          $self->_emit($sf, '=', $ef), last
            if $_[0] eq VALUE;
          $self->_emit($sf),
          $self->_emit_double($_[0]),
          $self->_emit($ef), last
            if $_[0] =~ /$ESCAPE_CHAR/;
          if ($_[0] =~ /\n/) {
              $self->_emit($sb),
              $self->_emit_block($LIT_CHAR, $_[0]),
              $self->_emit($eb), last
                if $self->use_block;
                Carp::cluck "[YAML] \$UseFold is no longer supported"
                if $self->use_fold;
              $self->_emit($sf),
              $self->_emit_double($_[0]),
              $self->_emit($ef), last
                if length $_[0] <= 30;
              $self->_emit($sf),
              $self->_emit_double($_[0]),
              $self->_emit($ef), last
                if $_[0] !~ /\n\s*\S/;
              $self->_emit($sb),
              $self->_emit_block($LIT_CHAR, $_[0]),
              $self->_emit($eb), last;
          }
          $self->_emit($sf),
          $self->_emit_plain($_[0]),
          $self->_emit($ef), last
            if $self->is_valid_plain($_[0]);
          $self->_emit($sf),
          $self->_emit_double($_[0]),
          $self->_emit($ef), last
            if $_[0] =~ /'/;
          $self->_emit($sf),
          $self->_emit_single($_[0]),
          $self->_emit($ef);
          last;
      }
  
      $self->{level}--;
  
      return;
  }
  
  sub is_valid_plain {
      my $self = shift;
      return 0 unless length $_[0];
      return 0 if $_[0] =~ /^[\s\{\[\~\`\'\"\!\@\#\>\|\%\&\?\*\^]/;
      return 0 if $_[0] =~ /[\{\[\]\},]/;
      return 0 if $_[0] =~ /[:\-\?]\s/;
      return 0 if $_[0] =~ /\s#/;
      return 0 if $_[0] =~ /\:(\s|$)/;
      return 0 if $_[0] =~ /[\s\|\>]$/;
      return 0 if $_[0] eq '-';
      return 1;
  }
  
  sub _emit_block {
      my $self = shift;
      my ($indicator, $value) = @_;
      $self->{stream} .= $indicator;
      $value =~ /(\n*)\Z/;
      my $chomp = length $1 ? (length $1 > 1) ? '+' : '' : '-';
      $value = '~' if not defined $value;
      $self->{stream} .= $chomp;
      $self->{stream} .= $self->indent_width if $value =~ /^\s/;
      $self->{stream} .= $self->indent($value);
  }
  
  sub _emit_plain {
      my $self = shift;
      $self->{stream} .= defined $_[0] ? $_[0] : '~';
  }
  
  sub _emit_double {
      my $self = shift;
      (my $escaped = $self->escape($_[0])) =~ s/"/\\"/g;
      $self->{stream} .= qq{"$escaped"};
  }
  
  sub _emit_single {
      my $self = shift;
      my $item = shift;
      $item =~ s{'}{''}g;
      $self->{stream} .= "'$item'";
  }
  
  
  sub indent {
      my $self = shift;
      my ($text) = @_;
      return $text unless length $text;
      $text =~ s/\n\Z//;
      my $indent = ' ' x $self->offset->[$self->level];
      $text =~ s/^/$indent/gm;
      $text = "\n$text";
      return $text;
  }
  
  my @escapes = qw(\0   \x01 \x02 \x03 \x04 \x05 \x06 \a
                   \x08 \t   \n   \v   \f   \r   \x0e \x0f
                   \x10 \x11 \x12 \x13 \x14 \x15 \x16 \x17
                   \x18 \x19 \x1a \e   \x1c \x1d \x1e \x1f
                  );
  
  sub escape {
      my $self = shift;
      my ($text) = @_;
      $text =~ s/\\/\\\\/g;
      $text =~ s/([\x00-\x1f])/$escapes[ord($1)]/ge;
      return $text;
  }
  
  1;
YAML_OLD_DUMPER

$fatpacked{"YAML/Old/Dumper/Base.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'YAML_OLD_DUMPER_BASE';
  package YAML::Old::Dumper::Base;
  
  use YAML::Old::Mo;
  
  use YAML::Old::Node;
  
  has spec_version    => default => sub {'1.0'};
  has indent_width    => default => sub {2};
  has use_header      => default => sub {1};
  has use_version     => default => sub {0};
  has sort_keys       => default => sub {1};
  has anchor_prefix   => default => sub {''};
  has dump_code       => default => sub {0};
  has use_block       => default => sub {0};
  has use_fold        => default => sub {0};
  has compress_series => default => sub {1};
  has inline_series   => default => sub {0};
  has use_aliases     => default => sub {1};
  has purity          => default => sub {0};
  has stringify       => default => sub {0};
  
  has stream      => default => sub {''};
  has document    => default => sub {0};
  has transferred => default => sub {{}};
  has id_refcnt   => default => sub {{}};
  has id_anchor   => default => sub {{}};
  has anchor      => default => sub {1};
  has level       => default => sub {0};
  has offset      => default => sub {[]};
  has headless    => default => sub {0};
  has blessed_map => default => sub {{}};
  
  sub set_global_options {
      my $self = shift;
      $self->spec_version($YAML::SpecVersion)
        if defined $YAML::SpecVersion;
      $self->indent_width($YAML::Indent)
        if defined $YAML::Indent;
      $self->use_header($YAML::UseHeader)
        if defined $YAML::UseHeader;
      $self->use_version($YAML::UseVersion)
        if defined $YAML::UseVersion;
      $self->sort_keys($YAML::SortKeys)
        if defined $YAML::SortKeys;
      $self->anchor_prefix($YAML::AnchorPrefix)
        if defined $YAML::AnchorPrefix;
      $self->dump_code($YAML::DumpCode || $YAML::UseCode)
        if defined $YAML::DumpCode or defined $YAML::UseCode;
      $self->use_block($YAML::UseBlock)
        if defined $YAML::UseBlock;
      $self->use_fold($YAML::UseFold)
        if defined $YAML::UseFold;
      $self->compress_series($YAML::CompressSeries)
        if defined $YAML::CompressSeries;
      $self->inline_series($YAML::InlineSeries)
        if defined $YAML::InlineSeries;
      $self->use_aliases($YAML::UseAliases)
        if defined $YAML::UseAliases;
      $self->purity($YAML::Purity)
        if defined $YAML::Purity;
      $self->stringify($YAML::Stringify)
        if defined $YAML::Stringify;
  }
  
  sub dump {
      my $self = shift;
      $self->die('dump() not implemented in this class.');
  }
  
  sub blessed {
      my $self = shift;
      my ($ref) = @_;
      $ref = \$_[0] unless ref $ref;
      my (undef, undef, $node_id) = YAML::Old::Mo::Object->node_info($ref);
      $self->{blessed_map}->{$node_id};
  }
  
  sub bless {
      my $self = shift;
      my ($ref, $blessing) = @_;
      my $ynode;
      $ref = \$_[0] unless ref $ref;
      my (undef, undef, $node_id) = YAML::Old::Mo::Object->node_info($ref);
      if (not defined $blessing) {
          $ynode = YAML::Old::Node->new($ref);
      }
      elsif (ref $blessing) {
          $self->die() unless ynode($blessing);
          $ynode = $blessing;
      }
      else {
          no strict 'refs';
          my $transfer = $blessing . "::yaml_dump";
          $self->die() unless defined &{$transfer};
          $ynode = &{$transfer}($ref);
          $self->die() unless ynode($ynode);
      }
      $self->{blessed_map}->{$node_id} = $ynode;
      my $object = ynode($ynode) or $self->die();
      return $object;
  }
  
  1;
YAML_OLD_DUMPER_BASE

$fatpacked{"YAML/Old/Error.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'YAML_OLD_ERROR';
  package YAML::Old::Error;
  
  use YAML::Old::Mo;
  
  has 'code';
  has 'type' => default => sub {'Error'};
  has 'line';
  has 'document';
  has 'arguments' => default => sub {[]};
  
  my ($error_messages, %line_adjust);
  
  sub format_message {
      my $self = shift;
      my $output = 'YAML ' . $self->type . ': ';
      my $code = $self->code;
      if ($error_messages->{$code}) {
          $code = sprintf($error_messages->{$code}, @{$self->arguments});
      }
      $output .= $code . "\n";
  
      $output .= '   Code: ' . $self->code . "\n"
          if defined $self->code;
      $output .= '   Line: ' . $self->line . "\n"
          if defined $self->line;
      $output .= '   Document: ' . $self->document . "\n"
          if defined $self->document;
      return $output;
  }
  
  sub error_messages {
      $error_messages;
  }
  
  %$error_messages = map {s/^\s+//;$_} split "\n", <<'...';
  YAML_PARSE_ERR_BAD_CHARS
    Invalid characters in stream. This parser only supports printable ASCII
  YAML_PARSE_ERR_NO_FINAL_NEWLINE
    Stream does not end with newline character
  YAML_PARSE_ERR_BAD_MAJOR_VERSION
    Can't parse a %s document with a 1.0 parser
  YAML_PARSE_WARN_BAD_MINOR_VERSION
    Parsing a %s document with a 1.0 parser
  YAML_PARSE_WARN_MULTIPLE_DIRECTIVES
    '%s directive used more than once'
  YAML_PARSE_ERR_TEXT_AFTER_INDICATOR
    No text allowed after indicator
  YAML_PARSE_ERR_NO_ANCHOR
    No anchor for alias '*%s'
  YAML_PARSE_ERR_NO_SEPARATOR
    Expected separator '---'
  YAML_PARSE_ERR_SINGLE_LINE
    Couldn't parse single line value
  YAML_PARSE_ERR_BAD_ANCHOR
    Invalid anchor
  YAML_DUMP_ERR_INVALID_INDENT
    Invalid Indent width specified: '%s'
  YAML_LOAD_USAGE
    usage: YAML::Old::Load($yaml_stream_scalar)
  YAML_PARSE_ERR_BAD_NODE
    Can't parse node
  YAML_PARSE_ERR_BAD_EXPLICIT
    Unsupported explicit transfer: '%s'
  YAML_DUMP_USAGE_DUMPCODE
    Invalid value for DumpCode: '%s'
  YAML_LOAD_ERR_FILE_INPUT
    Couldn't open %s for input:\n%s
  YAML_DUMP_ERR_FILE_CONCATENATE
    Can't concatenate to YAML file %s
  YAML_DUMP_ERR_FILE_OUTPUT
    Couldn't open %s for output:\n%s
  YAML_DUMP_ERR_NO_HEADER
    With UseHeader=0, the node must be a plain hash or array
  YAML_DUMP_WARN_BAD_NODE_TYPE
    Can't perform serialization for node type: '%s'
  YAML_EMIT_WARN_KEYS
    Encountered a problem with 'keys':\n%s
  YAML_DUMP_WARN_DEPARSE_FAILED
    Deparse failed for CODE reference
  YAML_DUMP_WARN_CODE_DUMMY
    Emitting dummy subroutine for CODE reference
  YAML_PARSE_ERR_MANY_EXPLICIT
    More than one explicit transfer
  YAML_PARSE_ERR_MANY_IMPLICIT
    More than one implicit request
  YAML_PARSE_ERR_MANY_ANCHOR
    More than one anchor
  YAML_PARSE_ERR_ANCHOR_ALIAS
    Can't define both an anchor and an alias
  YAML_PARSE_ERR_BAD_ALIAS
    Invalid alias
  YAML_PARSE_ERR_MANY_ALIAS
    More than one alias
  YAML_LOAD_ERR_NO_CONVERT
    Can't convert implicit '%s' node to explicit '%s' node
  YAML_LOAD_ERR_NO_DEFAULT_VALUE
    No default value for '%s' explicit transfer
  YAML_LOAD_ERR_NON_EMPTY_STRING
    Only the empty string can be converted to a '%s'
  YAML_LOAD_ERR_BAD_MAP_TO_SEQ
    Can't transfer map as sequence. Non numeric key '%s' encountered.
  YAML_DUMP_ERR_BAD_GLOB
    '%s' is an invalid value for Perl glob
  YAML_DUMP_ERR_BAD_REGEXP
    '%s' is an invalid value for Perl Regexp
  YAML_LOAD_ERR_BAD_MAP_ELEMENT
    Invalid element in map
  YAML_LOAD_WARN_DUPLICATE_KEY
    Duplicate map key found. Ignoring.
  YAML_LOAD_ERR_BAD_SEQ_ELEMENT
    Invalid element in sequence
  YAML_PARSE_ERR_INLINE_MAP
    Can't parse inline map
  YAML_PARSE_ERR_INLINE_SEQUENCE
    Can't parse inline sequence
  YAML_PARSE_ERR_BAD_DOUBLE
    Can't parse double quoted string
  YAML_PARSE_ERR_BAD_SINGLE
    Can't parse single quoted string
  YAML_PARSE_ERR_BAD_INLINE_IMPLICIT
    Can't parse inline implicit value '%s'
  YAML_PARSE_ERR_BAD_IMPLICIT
    Unrecognized implicit value '%s'
  YAML_PARSE_ERR_INDENTATION
    Error. Invalid indentation level
  YAML_PARSE_ERR_INCONSISTENT_INDENTATION
    Inconsistent indentation level
  YAML_LOAD_WARN_UNRESOLVED_ALIAS
    Can't resolve alias *%s
  YAML_LOAD_WARN_NO_REGEXP_IN_REGEXP
    No 'REGEXP' element for Perl regexp
  YAML_LOAD_WARN_BAD_REGEXP_ELEM
    Unknown element '%s' in Perl regexp
  YAML_LOAD_WARN_GLOB_NAME
    No 'NAME' element for Perl glob
  YAML_LOAD_WARN_PARSE_CODE
    Couldn't parse Perl code scalar: %s
  YAML_LOAD_WARN_CODE_DEPARSE
    Won't parse Perl code unless $YAML::LoadCode is set
  YAML_EMIT_ERR_BAD_LEVEL
    Internal Error: Bad level detected
  YAML_PARSE_WARN_AMBIGUOUS_TAB
    Amibiguous tab converted to spaces
  YAML_LOAD_WARN_BAD_GLOB_ELEM
    Unknown element '%s' in Perl glob
  YAML_PARSE_ERR_ZERO_INDENT
    Can't use zero as an indentation width
  YAML_LOAD_WARN_GLOB_IO
    Can't load an IO filehandle. Yet!!!
  ...
  
  %line_adjust = map {($_, 1)}
    qw(YAML_PARSE_ERR_BAD_MAJOR_VERSION
       YAML_PARSE_WARN_BAD_MINOR_VERSION
       YAML_PARSE_ERR_TEXT_AFTER_INDICATOR
       YAML_PARSE_ERR_NO_ANCHOR
       YAML_PARSE_ERR_MANY_EXPLICIT
       YAML_PARSE_ERR_MANY_IMPLICIT
       YAML_PARSE_ERR_MANY_ANCHOR
       YAML_PARSE_ERR_ANCHOR_ALIAS
       YAML_PARSE_ERR_BAD_ALIAS
       YAML_PARSE_ERR_MANY_ALIAS
       YAML_LOAD_ERR_NO_CONVERT
       YAML_LOAD_ERR_NO_DEFAULT_VALUE
       YAML_LOAD_ERR_NON_EMPTY_STRING
       YAML_LOAD_ERR_BAD_MAP_TO_SEQ
       YAML_LOAD_ERR_BAD_STR_TO_INT
       YAML_LOAD_ERR_BAD_STR_TO_DATE
       YAML_LOAD_ERR_BAD_STR_TO_TIME
       YAML_LOAD_WARN_DUPLICATE_KEY
       YAML_PARSE_ERR_INLINE_MAP
       YAML_PARSE_ERR_INLINE_SEQUENCE
       YAML_PARSE_ERR_BAD_DOUBLE
       YAML_PARSE_ERR_BAD_SINGLE
       YAML_PARSE_ERR_BAD_INLINE_IMPLICIT
       YAML_PARSE_ERR_BAD_IMPLICIT
       YAML_LOAD_WARN_NO_REGEXP_IN_REGEXP
       YAML_LOAD_WARN_BAD_REGEXP_ELEM
       YAML_LOAD_WARN_REGEXP_CREATE
       YAML_LOAD_WARN_GLOB_NAME
       YAML_LOAD_WARN_PARSE_CODE
       YAML_LOAD_WARN_CODE_DEPARSE
       YAML_LOAD_WARN_BAD_GLOB_ELEM
       YAML_PARSE_ERR_ZERO_INDENT
      );
  
  package YAML::Old::Warning;
  
  our @ISA = 'YAML::Old::Error';
  
  1;
YAML_OLD_ERROR

$fatpacked{"YAML/Old/Loader.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'YAML_OLD_LOADER';
  package YAML::Old::Loader;
  
  use YAML::Old::Mo;
  extends 'YAML::Old::Loader::Base';
  
  use YAML::Old::Loader::Base;
  use YAML::Old::Types;
  
  use constant LEAF       => 1;
  use constant COLLECTION => 2;
  use constant VALUE      => "\x07YAML\x07VALUE\x07";
  use constant COMMENT    => "\x07YAML\x07COMMENT\x07";
  
  my $ESCAPE_CHAR = '[\\x00-\\x08\\x0b-\\x0d\\x0e-\\x1f]';
  my $FOLD_CHAR   = '>';
  my $LIT_CHAR    = '|';
  my $LIT_CHAR_RX = "\\$LIT_CHAR";
  
  sub load {
      my $self = shift;
      $self->stream($_[0] || '');
      return $self->_parse();
  }
  
  sub _parse {
      my $self = shift;
      my (%directives, $preface);
      $self->{stream} =~ s|\015\012|\012|g;
      $self->{stream} =~ s|\015|\012|g;
      $self->line(0);
      $self->die('YAML_PARSE_ERR_BAD_CHARS')
        if $self->stream =~ /$ESCAPE_CHAR/;
      $self->die('YAML_PARSE_ERR_NO_FINAL_NEWLINE')
        if length($self->stream) and
           $self->{stream} !~ s/(.)\n\Z/$1/s;
      $self->lines([split /\x0a/, $self->stream, -1]);
      $self->line(1);
      $self->_parse_throwaway_comments();
      $self->document(0);
      $self->documents([]);
      if (not $self->eos) {
          if ($self->lines->[0] !~ /^---(\s|$)/) {
              unshift @{$self->lines}, '---';
              $self->{line}--;
          }
      }
  
      while (not $self->eos) {
          $self->anchor2node({});
          $self->{document}++;
          $self->done(0);
          $self->level(0);
          $self->offset->[0] = -1;
  
          if ($self->lines->[0] =~ /^---\s*(.*)$/) {
              my @words = split /\s+/, $1;
              %directives = ();
              while (@words && $words[0] =~ /^#(\w+):(\S.*)$/) {
                  my ($key, $value) = ($1, $2);
                  shift(@words);
                  if (defined $directives{$key}) {
                      $self->warn('YAML_PARSE_WARN_MULTIPLE_DIRECTIVES',
                        $key, $self->document);
                      next;
                  }
                  $directives{$key} = $value;
              }
              $self->preface(join ' ', @words);
          }
          else {
              $self->die('YAML_PARSE_ERR_NO_SEPARATOR');
          }
  
          if (not $self->done) {
              $self->_parse_next_line(COLLECTION);
          }
          if ($self->done) {
              $self->{indent} = -1;
              $self->content('');
          }
  
          $directives{YAML} ||= '1.0';
          $directives{TAB} ||= 'NONE';
          ($self->{major_version}, $self->{minor_version}) =
            split /\./, $directives{YAML}, 2;
          $self->die('YAML_PARSE_ERR_BAD_MAJOR_VERSION', $directives{YAML})
            if $self->major_version ne '1';
          $self->warn('YAML_PARSE_WARN_BAD_MINOR_VERSION', $directives{YAML})
            if $self->minor_version ne '0';
          $self->die('Unrecognized TAB policy')
            unless $directives{TAB} =~ /^(NONE|\d+)(:HARD)?$/;
  
          push @{$self->documents}, $self->_parse_node();
      }
      return wantarray ? @{$self->documents} : $self->documents->[-1];
  }
  
  sub _parse_node {
      my $self = shift;
      my $preface = $self->preface;
      $self->preface('');
      my ($node, $type, $indicator, $escape, $chomp) = ('') x 5;
      my ($anchor, $alias, $explicit, $implicit, $class) = ('') x 5;
      ($anchor, $alias, $explicit, $implicit, $preface) =
        $self->_parse_qualifiers($preface);
      if ($anchor) {
          $self->anchor2node->{$anchor} = CORE::bless [], 'YAML-anchor2node';
      }
      $self->inline('');
      while (length $preface) {
          my $line = $self->line - 1;
          if ($preface =~ s/^($FOLD_CHAR|$LIT_CHAR_RX)(-|\+)?\d*\s*//) {
              $indicator = $1;
              $chomp = $2 if defined($2);
          }
          else {
              $self->die('YAML_PARSE_ERR_TEXT_AFTER_INDICATOR') if $indicator;
              $self->inline($preface);
              $preface = '';
          }
      }
      if ($alias) {
          $self->die('YAML_PARSE_ERR_NO_ANCHOR', $alias)
            unless defined $self->anchor2node->{$alias};
          if (ref($self->anchor2node->{$alias}) ne 'YAML-anchor2node') {
              $node = $self->anchor2node->{$alias};
          }
          else {
              $node = do {my $sv = "*$alias"};
              push @{$self->anchor2node->{$alias}}, [\$node, $self->line];
          }
      }
      elsif (length $self->inline) {
          $node = $self->_parse_inline(1, $implicit, $explicit);
          if (length $self->inline) {
              $self->die('YAML_PARSE_ERR_SINGLE_LINE');
          }
      }
      elsif ($indicator eq $LIT_CHAR) {
          $self->{level}++;
          $node = $self->_parse_block($chomp);
          $node = $self->_parse_implicit($node) if $implicit;
          $self->{level}--;
      }
      elsif ($indicator eq $FOLD_CHAR) {
          $self->{level}++;
          $node = $self->_parse_unfold($chomp);
          $node = $self->_parse_implicit($node) if $implicit;
          $self->{level}--;
      }
      else {
          $self->{level}++;
          $self->offset->[$self->level] ||= 0;
          if ($self->indent == $self->offset->[$self->level]) {
              if ($self->content =~ /^-( |$)/) {
                  $node = $self->_parse_seq($anchor);
              }
              elsif ($self->content =~ /(^\?|\:( |$))/) {
                  $node = $self->_parse_mapping($anchor);
              }
              elsif ($preface =~ /^\s*$/) {
                  $node = $self->_parse_implicit('');
              }
              else {
                  $self->die('YAML_PARSE_ERR_BAD_NODE');
              }
          }
          else {
              $node = undef;
          }
          $self->{level}--;
      }
      $#{$self->offset} = $self->level;
  
      if ($explicit) {
          if ($class) {
              if (not ref $node) {
                  my $copy = $node;
                  undef $node;
                  $node = \$copy;
              }
              CORE::bless $node, $class;
          }
          else {
              $node = $self->_parse_explicit($node, $explicit);
          }
      }
      if ($anchor) {
          if (ref($self->anchor2node->{$anchor}) eq 'YAML-anchor2node') {
              for my $ref (@{$self->anchor2node->{$anchor}}) {
                  ${$ref->[0]} = $node;
                  $self->warn('YAML_LOAD_WARN_UNRESOLVED_ALIAS',
                      $anchor, $ref->[1]);
              }
          }
          $self->anchor2node->{$anchor} = $node;
      }
      return $node;
  }
  
  sub _parse_qualifiers {
      my $self = shift;
      my ($preface) = @_;
      my ($anchor, $alias, $explicit, $implicit, $token) = ('') x 5;
      $self->inline('');
      while ($preface =~ /^[&*!]/) {
          my $line = $self->line - 1;
          if ($preface =~ s/^\!(\S+)\s*//) {
              $self->die('YAML_PARSE_ERR_MANY_EXPLICIT') if $explicit;
              $explicit = $1;
          }
          elsif ($preface =~ s/^\!\s*//) {
              $self->die('YAML_PARSE_ERR_MANY_IMPLICIT') if $implicit;
              $implicit = 1;
          }
          elsif ($preface =~ s/^\&([^ ,:]+)\s*//) {
              $token = $1;
              $self->die('YAML_PARSE_ERR_BAD_ANCHOR')
                unless $token =~ /^[a-zA-Z0-9]+$/;
              $self->die('YAML_PARSE_ERR_MANY_ANCHOR') if $anchor;
              $self->die('YAML_PARSE_ERR_ANCHOR_ALIAS') if $alias;
              $anchor = $token;
          }
          elsif ($preface =~ s/^\*([^ ,:]+)\s*//) {
              $token = $1;
              $self->die('YAML_PARSE_ERR_BAD_ALIAS')
                unless $token =~ /^[a-zA-Z0-9]+$/;
              $self->die('YAML_PARSE_ERR_MANY_ALIAS') if $alias;
              $self->die('YAML_PARSE_ERR_ANCHOR_ALIAS') if $anchor;
              $alias = $token;
          }
      }
      return ($anchor, $alias, $explicit, $implicit, $preface);
  }
  
  sub _parse_explicit {
      my $self = shift;
      my ($node, $explicit) = @_;
      my ($type, $class);
      if ($explicit =~ /^\!?perl\/(hash|array|ref|scalar)(?:\:(\w(\w|\:\:)*)?)?$/) {
          ($type, $class) = (($1 || ''), ($2 || ''));
  
  
          if ( $type eq "ref" ) {
              $self->die('YAML_LOAD_ERR_NO_DEFAULT_VALUE', 'XXX', $explicit)
              unless exists $node->{VALUE()} and scalar(keys %$node) == 1;
  
              my $value = $node->{VALUE()};
              $node = \$value;
          }
  
          if ( $type eq "scalar" and length($class) and !ref($node) ) {
              my $value = $node;
              $node = \$value;
          }
  
          if ( length($class) ) {
              CORE::bless($node, $class);
          }
  
          return $node;
      }
      if ($explicit =~ m{^!?perl/(glob|regexp|code)(?:\:(\w(\w|\:\:)*)?)?$}) {
          ($type, $class) = (($1 || ''), ($2 || ''));
          my $type_class = "YAML::Old::Type::$type";
          no strict 'refs';
          if ($type_class->can('yaml_load')) {
              return $type_class->yaml_load($node, $class, $self);
          }
          else {
              $self->die('YAML_LOAD_ERR_NO_CONVERT', 'XXX', $explicit);
          }
      }
      elsif ($YAML::Old::TagClass->{$explicit} ||
             $explicit =~ m{^perl/(\@|\$)?([a-zA-Z](\w|::)+)$}
            ) {
          $class = $YAML::Old::TagClass->{$explicit} || $2;
          if ($class->can('yaml_load')) {
              require YAML::Old::Node;
              return $class->yaml_load(YAML::Old::Node->new($node, $explicit));
          }
          else {
              if (ref $node) {
                  return CORE::bless $node, $class;
              }
              else {
                  return CORE::bless \$node, $class;
              }
          }
      }
      elsif (ref $node) {
          require YAML::Old::Node;
          return YAML::Old::Node->new($node, $explicit);
      }
      else {
          return $node;
      }
  }
  
  sub _parse_mapping {
      my $self = shift;
      my ($anchor) = @_;
      my $mapping = {};
      $self->anchor2node->{$anchor} = $mapping;
      my $key;
      while (not $self->done and $self->indent == $self->offset->[$self->level]) {
          if ($self->{content} =~ s/^\?\s*//) {
              $self->preface($self->content);
              $self->_parse_next_line(COLLECTION);
              $key = $self->_parse_node();
              $key = "$key";
          }
          elsif ($self->{content} =~ s/^\=\s*//) {
              $key = VALUE;
          }
          elsif ($self->{content} =~ s/^\=\s*//) {
              $key = COMMENT;
          }
          else {
              $self->inline($self->content);
              $key = $self->_parse_inline();
              $key = "$key";
              $self->content($self->inline);
              $self->inline('');
          }
  
          unless ($self->{content} =~ s/^:\s*//) {
              $self->die('YAML_LOAD_ERR_BAD_MAP_ELEMENT');
          }
          $self->preface($self->content);
          my $line = $self->line;
          $self->_parse_next_line(COLLECTION);
          my $value = $self->_parse_node();
          if (exists $mapping->{$key}) {
              $self->warn('YAML_LOAD_WARN_DUPLICATE_KEY');
          }
          else {
              $mapping->{$key} = $value;
          }
      }
      return $mapping;
  }
  
  sub _parse_seq {
      my $self = shift;
      my ($anchor) = @_;
      my $seq = [];
      $self->anchor2node->{$anchor} = $seq;
      while (not $self->done and $self->indent == $self->offset->[$self->level]) {
          if ($self->content =~ /^-(?: (.*))?$/) {
              $self->preface(defined($1) ? $1 : '');
          }
          else {
              $self->die('YAML_LOAD_ERR_BAD_SEQ_ELEMENT');
          }
          if ($self->preface =~ /^(\s*)(\w.*\:(?: |$).*)$/) {
              $self->indent($self->offset->[$self->level] + 2 + length($1));
              $self->content($2);
              $self->level($self->level + 1);
              $self->offset->[$self->level] = $self->indent;
              $self->preface('');
              push @$seq, $self->_parse_mapping('');
              $self->{level}--;
              $#{$self->offset} = $self->level;
          }
          else {
              $self->_parse_next_line(COLLECTION);
              push @$seq, $self->_parse_node();
          }
      }
      return $seq;
  }
  
  sub _parse_inline {
      my $self = shift;
      my ($top, $top_implicit, $top_explicit) = (@_, '', '', '');
      $self->{inline} =~ s/^\s*(.*)\s*$/$1/; 
      my ($node, $anchor, $alias, $explicit, $implicit) = ('') x 5;
      ($anchor, $alias, $explicit, $implicit, $self->{inline}) =
        $self->_parse_qualifiers($self->inline);
      if ($anchor) {
          $self->anchor2node->{$anchor} = CORE::bless [], 'YAML-anchor2node';
      }
      $implicit ||= $top_implicit;
      $explicit ||= $top_explicit;
      ($top_implicit, $top_explicit) = ('', '');
      if ($alias) {
          $self->die('YAML_PARSE_ERR_NO_ANCHOR', $alias)
            unless defined $self->anchor2node->{$alias};
          if (ref($self->anchor2node->{$alias}) ne 'YAML-anchor2node') {
              $node = $self->anchor2node->{$alias};
          }
          else {
              $node = do {my $sv = "*$alias"};
              push @{$self->anchor2node->{$alias}}, [\$node, $self->line];
          }
      }
      elsif ($self->inline =~ /^\{/) {
          $node = $self->_parse_inline_mapping($anchor);
      }
      elsif ($self->inline =~ /^\[/) {
          $node = $self->_parse_inline_seq($anchor);
      }
      elsif ($self->inline =~ /^"/) {
          $node = $self->_parse_inline_double_quoted();
          $node = $self->_unescape($node);
          $node = $self->_parse_implicit($node) if $implicit;
      }
      elsif ($self->inline =~ /^'/) {
          $node = $self->_parse_inline_single_quoted();
          $node = $self->_parse_implicit($node) if $implicit;
      }
      else {
          if ($top) {
              $node = $self->inline;
              $self->inline('');
          }
          else {
              $node = $self->_parse_inline_simple();
          }
          $node = $self->_parse_implicit($node) unless $explicit;
      }
      if ($explicit) {
          $node = $self->_parse_explicit($node, $explicit);
      }
      if ($anchor) {
          if (ref($self->anchor2node->{$anchor}) eq 'YAML-anchor2node') {
              for my $ref (@{$self->anchor2node->{$anchor}}) {
                  ${$ref->[0]} = $node;
                  $self->warn('YAML_LOAD_WARN_UNRESOLVED_ALIAS',
                      $anchor, $ref->[1]);
              }
          }
          $self->anchor2node->{$anchor} = $node;
      }
      return $node;
  }
  
  sub _parse_inline_mapping {
      my $self = shift;
      my ($anchor) = @_;
      my $node = {};
      $self->anchor2node->{$anchor} = $node;
  
      $self->die('YAML_PARSE_ERR_INLINE_MAP')
        unless $self->{inline} =~ s/^\{\s*//;
      while (not $self->{inline} =~ s/^\s*\}//) {
          my $key = $self->_parse_inline();
          $self->die('YAML_PARSE_ERR_INLINE_MAP')
            unless $self->{inline} =~ s/^\: \s*//;
          my $value = $self->_parse_inline();
          if (exists $node->{$key}) {
              $self->warn('YAML_LOAD_WARN_DUPLICATE_KEY');
          }
          else {
              $node->{$key} = $value;
          }
          next if $self->inline =~ /^\s*\}/;
          $self->die('YAML_PARSE_ERR_INLINE_MAP')
            unless $self->{inline} =~ s/^\,\s*//;
      }
      return $node;
  }
  
  sub _parse_inline_seq {
      my $self = shift;
      my ($anchor) = @_;
      my $node = [];
      $self->anchor2node->{$anchor} = $node;
  
      $self->die('YAML_PARSE_ERR_INLINE_SEQUENCE')
        unless $self->{inline} =~ s/^\[\s*//;
      while (not $self->{inline} =~ s/^\s*\]//) {
          my $value = $self->_parse_inline();
          push @$node, $value;
          next if $self->inline =~ /^\s*\]/;
          $self->die('YAML_PARSE_ERR_INLINE_SEQUENCE')
            unless $self->{inline} =~ s/^\,\s*//;
      }
      return $node;
  }
  
  sub _parse_inline_double_quoted {
      my $self = shift;
      my $node;
      if ($self->inline =~ /^"((?:(?:\\"|[^"]){0,32766}){0,32766})"\s*(.*)$/) {
          $node = $1;
          $self->inline($2);
          $node =~ s/\\"/"/g;
      }
      else {
          $self->die('YAML_PARSE_ERR_BAD_DOUBLE');
      }
      return $node;
  }
  
  
  sub _parse_inline_single_quoted {
      my $self = shift;
      my $node;
      if ($self->inline =~ /^'((?:(?:''|[^']){0,32766}){0,32766})'\s*(.*)$/) {
          $node = $1;
          $self->inline($2);
          $node =~ s/''/'/g;
      }
      else {
          $self->die('YAML_PARSE_ERR_BAD_SINGLE');
      }
      return $node;
  }
  
  sub _parse_inline_simple {
      my $self = shift;
      my $value;
      if ($self->inline =~ /^(|[^!@#%^&*].*?)(?=[\[\]\{\},]|, |: |- |:\s*$|$)/) {
          $value = $1;
          substr($self->{inline}, 0, length($1)) = '';
      }
      else {
          $self->die('YAML_PARSE_ERR_BAD_INLINE_IMPLICIT', $value);
      }
      return $value;
  }
  
  sub _parse_implicit {
      my $self = shift;
      my ($value) = @_;
      $value =~ s/\s*$//;
      return $value if $value eq '';
      return undef if $value =~ /^~$/;
      return $value
        unless $value =~ /^[\@\`\^]/ or
               $value =~ /^[\-\?]\s/;
      $self->die('YAML_PARSE_ERR_BAD_IMPLICIT', $value);
  }
  
  sub _parse_unfold {
      my $self = shift;
      my ($chomp) = @_;
      my $node = '';
      my $space = 0;
      while (not $self->done and $self->indent == $self->offset->[$self->level]) {
          $node .= $self->content. "\n";
          $self->_parse_next_line(LEAF);
      }
      $node =~ s/^(\S.*)\n(?=\S)/$1 /gm;
      $node =~ s/^(\S.*)\n(\n+\S)/$1$2/gm;
      $node =~ s/\n*\Z// unless $chomp eq '+';
      $node .= "\n" unless $chomp;
      return $node;
  }
  
  sub _parse_block {
      my $self = shift;
      my ($chomp) = @_;
      my $node = '';
      while (not $self->done and $self->indent == $self->offset->[$self->level]) {
          $node .= $self->content . "\n";
          $self->_parse_next_line(LEAF);
      }
      return $node if '+' eq $chomp;
      $node =~ s/\n*\Z/\n/;
      $node =~ s/\n\Z// if $chomp eq '-';
      return $node;
  }
  
  sub _parse_throwaway_comments {
      my $self = shift;
      while (@{$self->lines} and
             $self->lines->[0] =~ m{^\s*(\#|$)}
            ) {
          shift @{$self->lines};
          $self->{line}++;
      }
      $self->eos($self->{done} = not @{$self->lines});
  }
  
  sub _parse_next_line {
      my $self = shift;
      my ($type) = @_;
      my $level = $self->level;
      my $offset = $self->offset->[$level];
      $self->die('YAML_EMIT_ERR_BAD_LEVEL') unless defined $offset;
      shift @{$self->lines};
      $self->eos($self->{done} = not @{$self->lines});
      return if $self->eos;
      $self->{line}++;
  
      if ($self->preface =~
          qr/(?:^|\s)(?:$FOLD_CHAR|$LIT_CHAR_RX)(?:-|\+)?(\d*)\s*$/
         ) {
          $self->die('YAML_PARSE_ERR_ZERO_INDENT')
            if length($1) and $1 == 0;
          $type = LEAF;
          if (length($1)) {
              $self->offset->[$level + 1] = $offset + $1;
          }
          else {
              while (@{$self->lines} && ($self->lines->[0] =~ /^\s*#/)) {
                  $self->lines->[0] =~ /^( *)/ or die;
                  last unless length($1) <= $offset;
                  shift @{$self->lines};
                  $self->{line}++;
              }
              $self->eos($self->{done} = not @{$self->lines});
              return if $self->eos;
              if ($self->lines->[0] =~ /^( *)\S/ and length($1) > $offset) {
                  $self->offset->[$level+1] = length($1);
              }
              else {
                  $self->offset->[$level+1] = $offset + 1;
              }
          }
          $offset = $self->offset->[++$level];
      }
      elsif ($type == COLLECTION and
             $self->preface =~ /^(\s*(\!\S*|\&\S+))*\s*$/) {
          $self->_parse_throwaway_comments();
          if ($self->eos) {
              $self->offset->[$level+1] = $offset + 1;
              return;
          }
          else {
              $self->lines->[0] =~ /^( *)\S/ or die;
              if (length($1) > $offset) {
                  $self->offset->[$level+1] = length($1);
              }
              else {
                  $self->offset->[$level+1] = $offset + 1;
              }
          }
          $offset = $self->offset->[++$level];
      }
  
      if ($type == LEAF) {
          while (@{$self->lines} and
                 $self->lines->[0] =~ m{^( *)(\#)} and
                 length($1) < $offset
                ) {
              shift @{$self->lines};
              $self->{line}++;
          }
          $self->eos($self->{done} = not @{$self->lines});
      }
      else {
          $self->_parse_throwaway_comments();
      }
      return if $self->eos;
  
      if ($self->lines->[0] =~ /^---(\s|$)/) {
          $self->done(1);
          return;
      }
      if ($type == LEAF and
          $self->lines->[0] =~ /^ {$offset}(.*)$/
         ) {
          $self->indent($offset);
          $self->content($1);
      }
      elsif ($self->lines->[0] =~ /^\s*$/) {
          $self->indent($offset);
          $self->content('');
      }
      else {
          $self->lines->[0] =~ /^( *)(\S.*)$/;
          while ($self->offset->[$level] > length($1)) {
              $level--;
          }
          $self->die('YAML_PARSE_ERR_INCONSISTENT_INDENTATION')
            if $self->offset->[$level] != length($1);
          $self->indent(length($1));
          $self->content($2);
      }
      $self->die('YAML_PARSE_ERR_INDENTATION')
        if $self->indent - $offset > 1;
  }
  
  
  my %unescapes = (
     0 => "\x00",
     a => "\x07",
     t => "\x09",
     n => "\x0a",
     'v' => "\x0b", 
     f => "\x0c",
     r => "\x0d",
     e => "\x1b",
     '\\' => '\\',
    );
  
  sub _unescape {
      my $self = shift;
      my ($node) = @_;
      $node =~ s/\\([never\\fart0]|x([0-9a-fA-F]{2}))/
                (length($1)>1)?pack("H2",$2):$unescapes{$1}/gex;
      return $node;
  }
  
  1;
YAML_OLD_LOADER

$fatpacked{"YAML/Old/Loader/Base.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'YAML_OLD_LOADER_BASE';
  package YAML::Old::Loader::Base;
  
  use YAML::Old::Mo;
  
  has load_code     => default => sub {0};
  has stream        => default => sub {''};
  has document      => default => sub {0};
  has line          => default => sub {0};
  has documents     => default => sub {[]};
  has lines         => default => sub {[]};
  has eos           => default => sub {0};
  has done          => default => sub {0};
  has anchor2node   => default => sub {{}};
  has level         => default => sub {0};
  has offset        => default => sub {[]};
  has preface       => default => sub {''};
  has content       => default => sub {''};
  has indent        => default => sub {0};
  has major_version => default => sub {0};
  has minor_version => default => sub {0};
  has inline        => default => sub {''};
  
  sub set_global_options {
      my $self = shift;
      $self->load_code($YAML::LoadCode || $YAML::UseCode)
        if defined $YAML::LoadCode or defined $YAML::UseCode;
  }
  
  sub load {
      die 'load() not implemented in this class.';
  }
  
  1;
YAML_OLD_LOADER_BASE

$fatpacked{"YAML/Old/Marshall.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'YAML_OLD_MARSHALL';
  use strict; use warnings;
  package YAML::Old::Marshall;
  
  use YAML::Old::Node ();
  
  sub import {
      my $class = shift;
      no strict 'refs';
      my $package = caller;
      unless (grep { $_ eq $class} @{$package . '::ISA'}) {
          push @{$package . '::ISA'}, $class;
      }
  
      my $tag = shift;
      if ( $tag ) {
          no warnings 'once';
          $YAML::Old::TagClass->{$tag} = $package;
          ${$package . "::YamlTag"} = $tag;
      }
  }
  
  sub yaml_dump {
      my $self = shift;
      no strict 'refs';
      my $tag = ${ref($self) . "::YamlTag"} || 'perl/' . ref($self);
      $self->yaml_node($self, $tag);
  }
  
  sub yaml_load {
      my ($class, $node) = @_;
      if (my $ynode = $class->yaml_ynode($node)) {
          $node = $ynode->{NODE};
      }
      bless $node, $class;
  }
  
  sub yaml_node {
      shift;
      YAML::Old::Node->new(@_);
  }
  
  sub yaml_ynode {
      shift;
      YAML::Old::Node::ynode(@_);
  }
  
  1;
YAML_OLD_MARSHALL

$fatpacked{"YAML/Old/Mo.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'YAML_OLD_MO';
  package YAML::Old::Mo;
  
  no warnings;my$M=__PACKAGE__.'::';*{$M.Object::new}=sub{bless{@_[1..$#_]},$_[0]};*{$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}};$m=$o{$_}->($m,$n,@_)for sort keys%o;*{$P.$n}=$m},%e,);*{$P.$_}=$e{$_}for keys%e;@{$P.ISA}=$M.Object};*{$M.'builder::e'}=sub{my($P,$e,$o)=@_;$o->{builder}=sub{my($m,$n,%a)=@_;my$b=$a{builder}or return$m;sub{$#_?$m->(@_):!exists$_[0]{$n}?$_[0]{$n}=$_[0]->$b:$m->(@_)}}};*{$M.'default::e'}=sub{my($P,$e,$o)=@_;$o->{default}=sub{my($m,$n,%a)=@_;$a{default}or return$m;sub{$#_?$m->(@_):!exists$_[0]{$n}?$_[0]{$n}=$a{default}->(@_):$m->(@_)}}};my$i=\&import;*{$M.import}=sub{(@_==2 and not $_[1])?pop@_:@_==1?push@_,grep!/import/,@f:();goto&$i};@f=qw[builder default import];use strict;use warnings;
  
  our $DumperModule = 'Data::Dumper';
  
  my ($_new_error, $_info, $_scalar_info);
  
  no strict 'refs';
  *{$M.'Object::die'} = sub {
      my $self = shift;
      my $error = $self->$_new_error(@_);
      $error->type('Error');
      Carp::croak($error->format_message);
  };
  
  *{$M.'Object::warn'} = sub {
      my $self = shift;
      return unless $^W;
      my $error = $self->$_new_error(@_);
      $error->type('Warning');
      Carp::cluck($error->format_message);
  };
  
  *{$M.'Object::node_info'} = sub {
      my $self = shift;
      my $stringify = $_[1] || 0;
      my ($class, $type, $id) =
          ref($_[0])
          ? $stringify
            ? &$_info("$_[0]")
            : do {
                require overload;
                my @info = &$_info(overload::StrVal($_[0]));
                if (ref($_[0]) eq 'Regexp') {
                    @info[0, 1] = (undef, 'REGEXP');
                }
                @info;
            }
          : &$_scalar_info($_[0]);
      ($class, $type, $id) = &$_scalar_info("$_[0]")
          unless $id;
      return wantarray ? ($class, $type, $id) : $id;
  };
  
  $_info = sub {
      return (($_[0]) =~ qr{^(?:(.*)\=)?([^=]*)\(([^\(]*)\)$}o);
  };
  
  $_scalar_info = sub {
      my $id = 'undef';
      if (defined $_[0]) {
          \$_[0] =~ /\((\w+)\)$/o or CORE::die();
          $id = "$1-S";
      }
      return (undef, undef, $id);
  };
  
  $_new_error = sub {
      require Carp;
      my $self = shift;
      require YAML::Old::Error;
  
      my $code = shift || 'unknown error';
      my $error = YAML::Old::Error->new(code => $code);
      $error->line($self->line) if $self->can('line');
      $error->document($self->document) if $self->can('document');
      $error->arguments([@_]);
      return $error;
  };
  
  1;
YAML_OLD_MO

$fatpacked{"YAML/Old/Node.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'YAML_OLD_NODE';
  use strict; use warnings;
  package YAML::Old::Node;
  
  use YAML::Old::Tag;
  require YAML::Old::Mo;
  
  use Exporter;
  our @ISA     = qw(Exporter YAML::Old::Mo::Object);
  our @EXPORT  = qw(ynode);
  
  sub ynode {
      my $self;
      if (ref($_[0]) eq 'HASH') {
          $self = tied(%{$_[0]});
      }
      elsif (ref($_[0]) eq 'ARRAY') {
          $self = tied(@{$_[0]});
      }
      elsif (ref(\$_[0]) eq 'GLOB') {
          $self = tied(*{$_[0]});
      }
      else {
          $self = tied($_[0]);
      }
      return (ref($self) =~ /^yaml_/) ? $self : undef;
  }
  
  sub new {
      my ($class, $node, $tag) = @_;
      my $self;
      $self->{NODE} = $node;
      my (undef, $type) = YAML::Old::Mo::Object->node_info($node);
      $self->{KIND} = (not defined $type) ? 'scalar' :
                      ($type eq 'ARRAY') ? 'sequence' :
                      ($type eq 'HASH') ? 'mapping' :
                      $class->die("Can't create YAML::Old::Node from '$type'");
      tag($self, ($tag || ''));
      if ($self->{KIND} eq 'scalar') {
          yaml_scalar->new($self, $_[1]);
          return \ $_[1];
      }
      my $package = "yaml_" . $self->{KIND};
      $package->new($self)
  }
  
  sub node { $_->{NODE} }
  sub kind { $_->{KIND} }
  sub tag {
      my ($self, $value) = @_;
      if (defined $value) {
                 $self->{TAG} = YAML::Old::Tag->new($value);
          return $self;
      }
      else {
         return $self->{TAG};
      }
  }
  sub keys {
      my ($self, $value) = @_;
      if (defined $value) {
                 $self->{KEYS} = $value;
          return $self;
      }
      else {
         return $self->{KEYS};
      }
  }
  
  package
  yaml_scalar;
  
  @yaml_scalar::ISA = qw(YAML::Old::Node);
  
  sub new {
      my ($class, $self) = @_;
      tie $_[2], $class, $self;
  }
  
  sub TIESCALAR {
      my ($class, $self) = @_;
      bless $self, $class;
      $self
  }
  
  sub FETCH {
      my ($self) = @_;
      $self->{NODE}
  }
  
  sub STORE {
      my ($self, $value) = @_;
      $self->{NODE} = $value
  }
  
  package
  yaml_sequence;
  
  @yaml_sequence::ISA = qw(YAML::Old::Node);
  
  sub new {
      my ($class, $self) = @_;
      my $new;
      tie @$new, $class, $self;
      $new
  }
  
  sub TIEARRAY {
      my ($class, $self) = @_;
      bless $self, $class
  }
  
  sub FETCHSIZE {
      my ($self) = @_;
      scalar @{$self->{NODE}};
  }
  
  sub FETCH {
      my ($self, $index) = @_;
      $self->{NODE}[$index]
  }
  
  sub STORE {
      my ($self, $index, $value) = @_;
      $self->{NODE}[$index] = $value
  }
  
  sub undone {
      die "Not implemented yet"; 
  }
  
  *STORESIZE = *POP = *PUSH = *SHIFT = *UNSHIFT = *SPLICE = *DELETE = *EXISTS =
  *STORESIZE = *POP = *PUSH = *SHIFT = *UNSHIFT = *SPLICE = *DELETE = *EXISTS =
  *undone; 
  
  package
  yaml_mapping;
  
  @yaml_mapping::ISA = qw(YAML::Old::Node);
  
  sub new {
      my ($class, $self) = @_;
      @{$self->{KEYS}} = sort keys %{$self->{NODE}};
      my $new;
      tie %$new, $class, $self;
      $new
  }
  
  sub TIEHASH {
      my ($class, $self) = @_;
      bless $self, $class
  }
  
  sub FETCH {
      my ($self, $key) = @_;
      if (exists $self->{NODE}{$key}) {
          return (grep {$_ eq $key} @{$self->{KEYS}})
                 ? $self->{NODE}{$key} : undef;
      }
      return $self->{HASH}{$key};
  }
  
  sub STORE {
      my ($self, $key, $value) = @_;
      if (exists $self->{NODE}{$key}) {
          $self->{NODE}{$key} = $value;
      }
      elsif (exists $self->{HASH}{$key}) {
          $self->{HASH}{$key} = $value;
      }
      else {
          if (not grep {$_ eq $key} @{$self->{KEYS}}) {
              push(@{$self->{KEYS}}, $key);
          }
          $self->{HASH}{$key} = $value;
      }
      $value
  }
  
  sub DELETE {
      my ($self, $key) = @_;
      my $return;
      if (exists $self->{NODE}{$key}) {
          $return = $self->{NODE}{$key};
      }
      elsif (exists $self->{HASH}{$key}) {
          $return = delete $self->{NODE}{$key};
      }
      for (my $i = 0; $i < @{$self->{KEYS}}; $i++) {
          if ($self->{KEYS}[$i] eq $key) {
              splice(@{$self->{KEYS}}, $i, 1);
          }
      }
      return $return;
  }
  
  sub CLEAR {
      my ($self) = @_;
      @{$self->{KEYS}} = ();
      %{$self->{HASH}} = ();
  }
  
  sub FIRSTKEY {
      my ($self) = @_;
      $self->{ITER} = 0;
      $self->{KEYS}[0]
  }
  
  sub NEXTKEY {
      my ($self) = @_;
      $self->{KEYS}[++$self->{ITER}]
  }
  
  sub EXISTS {
      my ($self, $key) = @_;
      exists $self->{NODE}{$key}
  }
  
  1;
YAML_OLD_NODE

$fatpacked{"YAML/Old/Tag.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'YAML_OLD_TAG';
  use strict; use warnings;
  package YAML::Old::Tag;
  
  use overload '""' => sub { ${$_[0]} };
  
  sub new {
      my ($class, $self) = @_;
      bless \$self, $class
  }
  
  sub short {
      ${$_[0]}
  }
  
  sub canonical {
      ${$_[0]}
  }
  
  1;
YAML_OLD_TAG

$fatpacked{"YAML/Old/Types.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'YAML_OLD_TYPES';
  package YAML::Old::Types;
  
  use YAML::Old::Mo;
  use YAML::Old::Node;
  
  package YAML::Old::Type::blessed;
  
  use YAML::Old::Mo; 
  
  sub yaml_dump {
      my $self = shift;
      my ($value) = @_;
      my ($class, $type) = YAML::Old::Mo::Object->node_info($value);
      no strict 'refs';
      my $kind = lc($type) . ':';
      my $tag = ${$class . '::ClassTag'} ||
                "!perl/$kind$class";
      if ($type eq 'REF') {
          YAML::Old::Node->new(
              {(&YAML::VALUE, ${$_[0]})}, $tag
          );
      }
      elsif ($type eq 'SCALAR') {
          $_[1] = $$value;
          YAML::Old::Node->new($_[1], $tag);
      } else {
          YAML::Old::Node->new($value, $tag);
      }
  }
  
  package YAML::Old::Type::undef;
  
  sub yaml_dump {
      my $self = shift;
  }
  
  sub yaml_load {
      my $self = shift;
  }
  
  package YAML::Old::Type::glob;
  
  sub yaml_dump {
      my $self = shift;
      my $ynode = YAML::Old::Node->new({}, '!perl/glob:');
      for my $type (qw(PACKAGE NAME SCALAR ARRAY HASH CODE IO)) {
          my $value = *{$_[0]}{$type};
          $value = $$value if $type eq 'SCALAR';
          if (defined $value) {
              if ($type eq 'IO') {
                  my @stats = qw(device inode mode links uid gid rdev size
                                 atime mtime ctime blksize blocks);
                  undef $value;
                  $value->{stat} = YAML::Old::Node->new({});
                  if ($value->{fileno} = fileno(*{$_[0]})) {
                      local $^W;
                      map {$value->{stat}{shift @stats} = $_} stat(*{$_[0]});
                      $value->{tell} = tell(*{$_[0]});
                  }
              }
              $ynode->{$type} = $value;
          }
      }
      return $ynode;
  }
  
  sub yaml_load {
      my $self = shift;
      my ($node, $class, $loader) = @_;
      my ($name, $package);
      if (defined $node->{NAME}) {
          $name = $node->{NAME};
          delete $node->{NAME};
      }
      else {
          $loader->warn('YAML_LOAD_WARN_GLOB_NAME');
          return undef;
      }
      if (defined $node->{PACKAGE}) {
          $package = $node->{PACKAGE};
          delete $node->{PACKAGE};
      }
      else {
          $package = 'main';
      }
      no strict 'refs';
      if (exists $node->{SCALAR}) {
          *{"${package}::$name"} = \$node->{SCALAR};
          delete $node->{SCALAR};
      }
      for my $elem (qw(ARRAY HASH CODE IO)) {
          if (exists $node->{$elem}) {
              if ($elem eq 'IO') {
                  $loader->warn('YAML_LOAD_WARN_GLOB_IO');
                  delete $node->{IO};
                  next;
              }
              *{"${package}::$name"} = $node->{$elem};
              delete $node->{$elem};
          }
      }
      for my $elem (sort keys %$node) {
          $loader->warn('YAML_LOAD_WARN_BAD_GLOB_ELEM', $elem);
      }
      return *{"${package}::$name"};
  }
  
  package YAML::Old::Type::code;
  
  my $dummy_warned = 0;
  my $default = '{ "DUMMY" }';
  
  sub yaml_dump {
      my $self = shift;
      my $code;
      my ($dumpflag, $value) = @_;
      my ($class, $type) = YAML::Old::Mo::Object->node_info($value);
      my $tag = "!perl/code";
      $tag .= ":$class" if defined $class;
      if (not $dumpflag) {
          $code = $default;
      }
      else {
          bless $value, "CODE" if $class;
          eval { use B::Deparse };
          return if $@;
          my $deparse = B::Deparse->new();
          eval {
              local $^W = 0;
              $code = $deparse->coderef2text($value);
          };
          if ($@) {
              warn YAML::YAML_DUMP_WARN_DEPARSE_FAILED() if $^W;
              $code = $default;
          }
          bless $value, $class if $class;
          chomp $code;
          $code .= "\n";
      }
      $_[2] = $code;
      YAML::Old::Node->new($_[2], $tag);
  }
  
  sub yaml_load {
      my $self = shift;
      my ($node, $class, $loader) = @_;
      if ($loader->load_code) {
          my $code = eval "package main; sub $node";
          if ($@) {
              $loader->warn('YAML_LOAD_WARN_PARSE_CODE', $@);
              return sub {};
          }
          else {
              CORE::bless $code, $class if $class;
              return $code;
          }
      }
      else {
          return CORE::bless sub {}, $class if $class;
          return sub {};
      }
  }
  
  package YAML::Old::Type::ref;
  
  sub yaml_dump {
      my $self = shift;
      YAML::Old::Node->new({(&YAML::VALUE, ${$_[0]})}, '!perl/ref')
  }
  
  sub yaml_load {
      my $self = shift;
      my ($node, $class, $loader) = @_;
      $loader->die('YAML_LOAD_ERR_NO_DEFAULT_VALUE', 'ptr')
        unless exists $node->{&YAML::VALUE};
      return \$node->{&YAML::VALUE};
  }
  
  package YAML::Old::Type::regexp;
  
  sub yaml_dump {
      die "YAML::Old::Type::regexp::yaml_dump not currently implemented";
  }
  
  use constant _QR_TYPES => {
      '' => sub { qr{$_[0]} },
      x => sub { qr{$_[0]}x },
      i => sub { qr{$_[0]}i },
      s => sub { qr{$_[0]}s },
      m => sub { qr{$_[0]}m },
      ix => sub { qr{$_[0]}ix },
      sx => sub { qr{$_[0]}sx },
      mx => sub { qr{$_[0]}mx },
      si => sub { qr{$_[0]}si },
      mi => sub { qr{$_[0]}mi },
      ms => sub { qr{$_[0]}sm },
      six => sub { qr{$_[0]}six },
      mix => sub { qr{$_[0]}mix },
      msx => sub { qr{$_[0]}msx },
      msi => sub { qr{$_[0]}msi },
      msix => sub { qr{$_[0]}msix },
  };
  
  sub yaml_load {
      my $self = shift;
      my ($node, $class) = @_;
      return qr{$node} unless $node =~ /^\(\?([\^\-xism]*):(.*)\)\z/s;
      my ($flags, $re) = ($1, $2);
      $flags =~ s/-.*//;
      $flags =~ s/^\^//;
      my $sub = _QR_TYPES->{$flags} || sub { qr{$_[0]} };
      my $qr = &$sub($re);
      bless $qr, $class if length $class;
      return $qr;
  }
  
  1;
YAML_OLD_TYPES

$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

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-07-02'; # DATE
our $DIST = 'App-pause'; # DIST
our $VERSION = '0.38'; # VERSION

use 5.010001;
use strict;
use warnings;

use Perinci::CmdLine::pause;

BEGIN { $ENV{DATA_SAH_CORE_OR_PP} = 1 }

my $prefix = '/WWW/PAUSE/Simple/';
Perinci::CmdLine::pause->new(
    summary => 'A CLI for PAUSE',
    url => $prefix,
    extra_urls_for_version => ['/App/pause/'],
    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: A CLI for PAUSE
# PODNAME: pause

__END__

=pod

=encoding UTF-8

=head1 NAME

pause - A CLI for PAUSE

=head1 VERSION

This document describes version 0.38 of pause (from Perl distribution App-pause), released on 2015-07-02.

=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<--delay>=I<i>

Pause a number of seconds between files.

If you upload a lot of files (e.g. 7-10 or more) at a time, the PAUSE indexer
currently might choke with SQLite database locking problem and thus fail to
index your releases. Giving a delay of say 2-3 minutes (120-180 seconds) between
files will alleviate this problem.


=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'

 delay (see --delay)
 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
