#!/usr/bin/perl
###!/usr/bin/env perl # We need a perl > 5.10

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

$fatpacked{"FileMerger.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'FILEMERGER';
  package FileMerger;
  
  use Moo;
  use FileMerger::FS::FileOperator;
  use FileMerger::FS::HardLinks;
  
  # Instance variables
  
  has 'src_dirs' => (    # arrayref
      is       => 'ro',
      required => 1,
  );
  
  has 'target_dir' => (    # string
      is       => 'ro',
      required => 1,
  );
  
  has 'excl_lit' => (      # arrayref
      is   => 'rw',
      lazy => 1,
  );
  
  has 'excl_rx' => (       # arrayref
      is   => 'rw',
      lazy => 1,
  );
  
  has 'ren_rx' => (        # hashref
      is   => 'rw',
      lazy => 1,
  );
  
  has 'conflicts' => (     # arrayref
      is      => 'rwp',
      default => sub { [] }
      ,                    # so we don't need to test for undef, only to elements
      init => undef,
  );
  
  has 'skipped' => (       # arrayref
      is      => 'rwp',
      default => sub { [] }
      ,                    # so we don't need to test for undef, only to elements
      init => undef,
  );
  
  has '_hardlinks_obj' => (
  	is => 'ro',
  	builder => '_build__hardlinks_obj',
  	lazy =>  1, # we need the rest of $self first
  );
  
  
  # Instance related
  sub _build__hardlinks_obj {
      my $self = shift;
      my $hl = FileMerger::FS::HardLinks->new( src_dirs => $self->src_dirs );
      return $hl;
  }
  
  # Methods
  
  sub merge_dirs {
      my $self = shift;
      my $fs = FileMerger::FS::FileOperator->new(
      	src_dirs    => $self->src_dirs,
          target_dir => $self->target_dir,
  		hardlinks_obj => $self->_hardlinks_obj,
      );
      $fs->excl_lit( $self->excl_lit ) if (defined $self->excl_lit);
      $fs->excl_rx( $self->excl_rx ) if (defined $self->excl_rx);
      $fs->ren_rx( $self->ren_rx ) if (defined $self->ren_rx);
      eval { $fs->walk_tree() };
      return $@ if $@;    # Return inmedialtely when fs problems encountered
  
      # give unique errors
      my %unique_conflicts = map { $_, 1 } @{ $fs->conflicts };
      my %unique_skipped   = map { $_, 1 } @{ $fs->skipped };
      my @unique_conflicts = keys %unique_conflicts;
      my @unique_skipped   = keys %unique_skipped;
  
      $self->_set_conflicts( \@unique_conflicts );
      $self->_set_skipped( \@unique_skipped );
      return undef;
  }
  
  sub merge_headers {
  
      # TODO: to be implemented
      return;
  }
  
  
  1;
FILEMERGER

$fatpacked{"FileMerger/FS/FileOperator.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'FILEMERGER_FS_FILEOPERATOR';
  package FileMerger::FS::FileOperator;
  
  #use Data::Printer;    ## DEBUG
  
  use Moo;
  with 'FileMerger::FS::Transversable';
  
  use File::Basename;
  use File::Copy qw/cp/;
  use File::Path qw(make_path);
  use File::Compare;
  use File::Spec;
  use File::stat;
  use POSIX qw(mkfifo);
  
  # Instance variables
  has 'hardlinks_obj' => (    # is an FileMerger::FS::HardLinks obj
      is       => 'rw',
      required => 1,
  );
  
  has 'target_dir' => (       # dir must exist, calling class must make sure
      is       => 'ro',
      required => 1,
      trigger  => 1,          # Create dir if not present
  );
  
  has 'conflicts' => (
      is      => 'rwp',
      default => sub { [] },
      lazy    => 1,
  );
  
  has '_src_rx' => (          # is a quoted regex }
      is      => 'ro',
      builder => '_build__src_rx',
      lazy    => 1,
  );
  
  has 'ren_rx' => (           # hashref: rx -> replacement
      is => 'rw',
  
      #    default => sub { {} },
  );
  
  ### Methods
  
  # Instance related
  
  sub _build__src_rx {
      my $self     = shift;
      my $src_str  = "";
      my $id_count = scalar @{ $self->src_dirs } - 1;
      for my $id ( 0 .. $id_count ) {
          $src_str .= $self->src_dirs->[$id];
          $src_str .= '|' if ( $id < $id_count );
      }
      return qr{$src_str};
  }
  
  sub _trigger_target_dir {
      my ( $self, $target_dir ) = @_;
      if ( !-d $target_dir ) {
          print 'INFO: creating the supplied target directory '
            . $target_dir . ".\n";
          make_path($target_dir) or die($!);
      }
  }
  
  # Overrides
  
  sub _wanted() {
      my $self = shift;
      return if ( $_ eq '.' );                        # skip top directory
      return if $self->_to_skip($File::Find::name);
      my $newpath = $self->_get_newpath($File::Find::name);
  
      # Let handle the different expected filetypes
      if ( -d $File::Find::name ) {                   # directory
          $self->_create_dir( $File::Find::name, $newpath );
      }
      elsif ( -p $File::Find::name ) {                # FIFO
          $self->_create_fifo( $File::Find::name, $newpath );
      }
      elsif ( -l $File::Find::name ) {                # syslink
          $self->_create_softlink( $File::Find::name, $newpath );
      }
      else {
          # We treat everything else as a file
          # We need to check if it's a hardlink, we create the related hardlinks
          if ( $self->_is_hardlink($File::Find::name) ) {
              $self->_create_hardlink( $File::Find::name, $newpath );
          }
          else { $self->_copy_file( $File::Find::name, $newpath ); }
      }
  }
  
  # Internal
  
  # plink.pl forces 0755 / 0644 modes
  # Method left here in case this changes
  # sub _check_perms {
  # my ( $self, $lpath, $rpath ) = @_;
  # my $st_l = stat($lpath) or die($!);
  # my $st_r = stat($rpath) or die($!);
  # my $perms_ok = 1;
  # for my $method ( 'mode', 'uid', 'gid' ) {
  # if ( $st_l->$method != $st_r->$method ) {    # different permissions
  # $perms_ok = 0;
  # }
  # }
  # return $perms_ok;
  # }
  
  sub _copy_file {
      my ( $self, $lfile, $rfile ) = @_;
      print "Copying " . $lfile . " to " . $rfile . ".\n";
      $self->_create_dir( dirname($rfile) );
      if ( !-e $rfile ) {
          cp( $lfile, $rfile ) or die($!);
      }
      else {
          if ( compare( $lfile, $rfile ) != 0 ) {
              push @{ $self->conflicts }, "$lfile (conflicting content)";
              print STDERR "WARNING: $lfile conflicts with file at target.\n";
          }
          else {
              print "INFO: $lfile is already at target directory. Skipping.\n";
          }
      }
  }
  
  sub _create_dir {
      my ( $self, $dir ) = @_;
  
      if ( -d $dir ) {
  
          # my $perms_ok = $self->_check_perms( $lpath, $rpath );
          # if ( !$perms_ok ) {
          # push @{ $self->conflicts }, $lpath . ' (directory permissions)';
          # print STDERR
          # "WARNING: directory $lpath has conflicting permissions.\n";
          # }
          chmod( 0755, $dir ) or die($!);
          return;
      }
  
      my $error;
      print "Creating directory $dir.\n";
      make_path(
          $dir,
          {
              verbose => 0,
              mode    => 0755,
  
              #uid     => $st_l->uid,
              #group   => $st_l->gid,
              error => \$error
          }
      );
      if (@$error) {
          die("Directory $dir can not be created: @$error");
      }
  }
  
  sub _create_fifo {
      my ( $self, $lfifo, $rfifo ) = @_;
      $self->_create_dir( dirname($rfifo) );
      mkfifo( $rfifo, ( stat($lfifo) )[2] ) or die($!);
  }
  
  sub _create_softlink {
      my ( $self, $llink, $rlink ) = @_;
      $self->_create_dir( dirname($rlink) );
  
      # Find out where we should point to in new target directory
      my $llink_source = readlink($llink);    # get the link target
  
  # Sadly, syslinks are also relative:
  #claudio@adelaide:~/Code/FileMerger/lib$ ls -la /var/tmp/src/f3softlink /var/tmp/src/d1lalasoft
  #lrwxrwxrwx 1 claudio claudio 22 mei 20 13:35 /var/tmp/src/d1lalasoft -> /var/tmp/src/d1/dilala
  #lrwxrwxrwx 1 claudio claudio  2 mei 20 13:28 /var/tmp/src/f3softlink -> f3
  
      if ( !File::Spec->file_name_is_absolute($llink_source) ) {
          $llink_source = File::Spec->rel2abs($llink_source);
      }
      my $rlink_source =
        $self->_get_newpath($llink_source);    # redirect to new path
  
      # Create the link
      if ( !-e -f $rlink ) {
          print "Creating symlink $rlink -> $rlink_source.\n";
          symlink( $rlink_source, $rlink )
            or die("Could create link $rlink -> $rlink_source ($!)");
      }
      elsif ( -e $rlink && readlink($rlink) eq $rlink_source ) {
          print "INFO: symlink $rlink -> $rlink_source already present.\n";
      }
      else {
          die("Could not link $rlink to $rlink_source: a file is already there");
      }
  }
  
  sub _create_hardlink {
  
      # Inspiration from pcopy.pl, kudos to dam@opencsw.org
      my ( $self, $llink, $rlink ) = @_;
      $self->_create_dir( dirname($rlink) );
  
      my @all_hardlinks = @{ $self->hardlinks_obj->related_hardlinks($llink) };
      if ( !-f $rlink ) {
  
          # Copy the first file
          $self->_copy_file( $llink, $rlink );
          $self->hardlinks_obj->add_newlink($rlink);
  
          # Create related hardlinks
          for my $hardlink (@all_hardlinks) {
              next if ( $hardlink eq $llink );    # We created it above
  
              # Create the link
              my $rlink_related = $self->_get_newpath($hardlink);
              if ( !-e $rlink_related ) {
                  print "Creating hardlink $rlink <-> $rlink_related.\n";
                  $self->_create_dir( dirname($rlink_related) );
                  link( $rlink, $rlink_related )
                    or
                    die("Could not create link $rlink <-> $rlink_related ($!)");
                  $self->hardlinks_obj->add_newlink($rlink_related);
              }
              else {
                  my $st_l = stat($rlink);
                  my $st_r = stat($rlink_related);
                  if ( $st_l->ino == $st_r->ino ) {
                      print
  "INFO: hardlink $rlink <-> $rlink_related already in place. Skipping.\n";
                  }
                  else {
                      die(
  "Could not link $rlink to $rlink_related: a file is already there"
                      );
                  }
              }
          }
      }
      else {    # newlink is already in place
          if ( $self->hardlinks_obj->is_created($rlink) ) {
              print "INFO: hardlink $rlink already in place. Skipping.\n";
          }
          else {
              die("Could not create hardlink $rlink: a file is already there");
          }
      }
  }
  
  sub _is_hardlink {
      my ( $self, $file ) = @_;
      my $related_hardlinks = $self->hardlinks_obj->related_hardlinks($file);
      return scalar @{$related_hardlinks};
  }
  
  sub _get_newpath {
      my ( $self, $path ) = @_;
      my $newpath;
  
      # We check for renaming rx
      if ( defined $self->ren_rx ) {
          $newpath = $self->_get_newpath_rename($path);
      }
  
      # If no rx or it doesn't match, we construct the new path src -> target
      if ( !defined $newpath ) {
          $newpath = $self->_get_newpath_copy($path);
      }
      return $newpath;
  }
  
  sub _get_newpath_copy {
      my ( $self, $path ) = @_;
      my $target  = $self->target_dir;
      my $src_rx  = $self->_src_rx;
      my $newpath = $path;
      if ( $newpath =~ s@^$src_rx(/.+)@$target$1@ ) {
          return $newpath;
      }
      else {
          die(
  "Can not construct the name for the new target path (info:$path,$newpath)"
          );
      }
  }
  
  sub _get_newpath_rename {
      my ( $self, $path ) = @_;
      my $path_renamed;
      for my $rx ( sort keys %{ $self->ren_rx } ) {
          my $newpath = $path;
          if ( $newpath =~ m@$rx@ ) { 
          	my $repl = $self->ren_rx->{$rx}; ## TODO split $\d
  			$newpath =~ s@$rx@$repl@;
  			my %memories = ( #we only support 9 memory parentheses
      			'$1' => $1, 
      			'$2' => $2, 
      			'$3' => $3, 
      			'$4' => $4, 
      			'$5' => $5, 
      			'$6' => $6, 
      			'$7' => $7, 
      			'$8' => $8, 
      			'$9' => $9, 
  			);
  			for my $key (sort keys %memories) {
      			$newpath =~ s@\Q$key\E@$memories{$key}@ 
  					if (defined $memories{$key});
  			}
              $newpath = File::Spec->canonpath($newpath);
              my $target = $self->target_dir;
              if ( $newpath !~ m@^$target/@ ) {
                  die(
  "Renaming regex \'$rx,$repl\' will result in files outside $target: $newpath."
                  );
              }
  
              print "INFO: renaming $path to $newpath.\n";
              $path_renamed = $newpath;
              last;
  
          }
      }
      return $path_renamed;    # return undef if no rx matches
  }
  1;
FILEMERGER_FS_FILEOPERATOR

$fatpacked{"FileMerger/FS/HardLinks.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'FILEMERGER_FS_HARDLINKS';
  package FileMerger::FS::HardLinks;
  
  use Moo;
  with('FileMerger::FS::Transversable');
  
  use File::stat;
  
  # Instance variables
  has '_hardlinks_by_file' => (
      is      => 'ro',
      default => sub { {} },
  );
  
  has '_hardlinks_by_inode' => (
      is      => 'ro',
      default => sub { {} },
  );
  
  has '_newlinks' => (
      is      => 'ro',
      default => sub { [] },
  );
  
  has 'is_run' => (
      is      => 'ro',
      builder => '_init',
      lazy    => 1,
  );
  
  # Methods
  
  # Instance related
  sub _init {
      my $self = shift;
      $self->walk_tree;
      return 1;
  }
  
  # Overrides
  
  sub _wanted() {
      my $self = shift;
      return if ( $_ eq '.' );                        # skip top directory
      return if $self->_to_skip($File::Find::name);
  
      # Let handle the different expected filetypes
      if ( -f $File::Find::name && !-l ) {
          my $st = stat($File::Find::name) or die($!);
  
          #print "$File::Find::name " . $st->ino . " \n";
          if ( $st->nlink > 1 ) {                     # only hardlinked files
              push @{ $self->_hardlinks_by_inode->{ $st->ino } },
                $File::Find::name;
              push @{ $self->_hardlinks_by_file->{$File::Find::name} }, $st->ino;
          }
      }
      else {
          return;                                     # we only care about files
      }
  }
  
  # Methods
  
  sub add_newlink {
      my ( $self, $newlink ) = @_;
      push @{ $self->_newlinks }, $newlink;
  }
  
  sub is_created {
      my ( $self, $link ) = @_;
      $self->is_run;    # make sure we run walk_tree once
      local $_;         # File::Find conflict
      return grep { $_ eq $link } @{ $self->_newlinks };
  }
  
  sub related_hardlinks {
      my ( $self, $file ) = @_;
      $self->is_run;    # make sure we run walk_tree once
      my @hardlinks;
      my $st_l          = stat($file) or die($!);
      my $ino           = $st_l->ino;
      my $hardlinks_ref = $self->_hardlinks_by_inode->{$ino};
      my $inodes_ref    = $self->_hardlinks_by_file->{$file};
      for my $inode ( @{ $self->_hardlinks_by_file->{$file} } ) {
          push @hardlinks, @{ $self->_hardlinks_by_inode->{$inode} };
      }
      return \@hardlinks;
  }
  
  1;
FILEMERGER_FS_HARDLINKS

$fatpacked{"FileMerger/FS/HeadersUnifier.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'FILEMERGER_FS_HEADERSUNIFIER';
  package FileMerger::FS::HeadersUnifier;
  
  use Moo;
  
  
  1;
  
FILEMERGER_FS_HEADERSUNIFIER

$fatpacked{"FileMerger/FS/Transversable.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'FILEMERGER_FS_TRANSVERSABLE';
  package FileMerger::FS::Transversable;
  # An OO wrapper for File::Find
  
  use Moo::Role;
  
  use File::Find;
  no warnings 'File::Find';
  
  #use Data::Printer; ## DEBUG
  
  # Instance variables
  has 'src_dirs' => (    # dirs must exist, calling class must make sure
      is       => 'ro',  # is arrayref 
      required => 1,
  );
  
  has 'excl_lit' => (
      is      => 'rw',
  #    default => sub { [] },
      lazy    => 1,
  );
  
  has 'excl_rx' => (
      is      => 'rw',
  #    default => sub { [] },
      lazy    => 1,
  );
  
  has 'skipped' => (
      is      => 'rwp',
      default => sub { [] },
      lazy    => 1,
  );
  
  ### Methods
  
  sub walk_tree() {
      my $self = shift;
  
      # Walk the src tree
      # find( \&_wanted, $self->src_dir );
      find( sub { $self->_wanted(); }, @{ $self->src_dirs } ); # Let's play nice with OO
  }
  
  sub _to_skip {
      my ( $self, $path ) = @_;
      my $skip = 0;
  
      # we need to localize File::Find's $_ to allow grep's use of it
      local ($_);
      if ( defined $self->excl_lit ) { # Calling class must clean trailing slashes
          if ( grep { $path =~ m@^$_($|/)@ } @{ $self->excl_lit } ) { 
              $skip = 1;
          }
      }
  
      if ( defined $self->excl_rx ) {    # Calling class must supply valid regex)
          $skip = 1 if ( grep { $path =~ /$_/ } @{ $self->excl_rx } );
      }
      push @{ $self->skipped }, $path if ($skip);
      print "INFO: skipping $path as requested...\n" if ($skip);
      return $skip;
  }
  
  
  sub _wanted() {
  	# A basic _wanted to be overwritten
      my $self = shift;
      return if ( $_ eq '.' );                        # skip top directory
      return if $self->_to_skip($File::Find::name);
      print "You forgot to override _wanted()?\n";
  	print $_ . "\n";
  }
  
  1;
FILEMERGER_FS_TRANSVERSABLE

$fatpacked{"FileMerger/Params.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'FILEMERGER_PARAMS';
  package FileMerger::Params;
  our $VERSION = "0.1";
  use Moo;
  
  use Getopt::Long;
  use File::Basename;
  use File::Spec;
  use Text::CSV;
  
  has 'args' => (
  
      # source: arrayref
      # target: string
      # exclude-literal: arrayref
      # exclude-regex: arrayref
      # rename-regex: hashref
      is       => 'ro',
      default  => sub { {} },
      init_arg => undef,
  );
  
  has 'messages' => (
      is       => 'ro',
      default  => sub { [] },
      lazy     => 1,
      init_arg => undef,
  );
  
  sub read_params {
      my $self = shift;
      GetOptions( $self->args, 'help|h|?', 'version|v', 'exclude-literal|l=s@',
          'exclude-rx|e=s@', 'rename-rx|r=s@', 'source|s=s@', 'target|t=s' )
        or die "\nInvalid switch. Please read the help page: "
        . basename $0
        . " -?\n\n";
  
      # Help and version status
      if ( defined $self->args->{help}
          or ( !@ARGV and !( grep { defined $_ } values %{ $self->args } ) ) )
      {
          $self->_show_help(0);
          exit 0;
      }
      if ( defined $self->args->{version} ) {
          $self->args->_show_help(1);
          exit 0;
      }
  
      # Check parameters
  
      if ( !$self->_check_params() ) {
          for my $msg ( @{ $self->messages } ) {
              print STDERR $msg . "\n";
          }
          print "Bailing out...\n";
          exit 1;
      }
  
      return %{ $self->args };
  }
  
  sub _check_params {
      my $self   = shift;
      my $status = 1;
  
      # Verify required parameters
      $status = 0 unless ( $self->_check_req(qw/source target/) );
  
      # Verify that the source exists and no doubles are present
      $status = 0 unless ( $self->_check_src() );
  
      # Verify that the target is a directory or does not exist
      $status = 0 unless ( $self->_check_target() );
  
      # Split the renaming regexes
      my @regexes;    # used to exclude after renaming
      if ( defined $self->args->{'rename-rx'} ) {
  		# Use newstyle regexps
  		s,\\(\d),\$$1,g foreach(@{ $self->args->{'rename-rx'} });
  		# Split the regex
          my $ren_rx_ref = $self->_split_rx( $self->args->{'rename-rx'} );
          if ( defined $ren_rx_ref ) {
              $self->args->{'rename-rx'} = $ren_rx_ref;    # We want a % in args
              @regexes = keys %{$ren_rx_ref};
  
          }
          else { $status = 0 }
      }
  
      # Check for valid regexes
      if ( defined $self->args->{'exclude-rx'} ) {
          push @regexes, @{ $self->args->{'exclude-rx'} };
      }
  
      if (@regexes) {
          my $rx_status = _validate_rx( \@regexes );
          if ( !$rx_status ) {
              $status = 0;
          }
      }
  
      # Canonize the literal paths of exclude-literal
      ## TODO and make sure they are absolute
      if ( $self->args->{'exclude-literal'} ) {
          for my $path ( @{ $self->args->{'exclude-literal'} } ) {
              $path = $self->_canonize($path);
          }
      }
  
      return $status;
  }
  
  sub _canonize {
      my ( $self, $path ) = @_;
      my $cpath =
        File::Spec->canonpath($path);    # Remove trailing slashes, portable
      return $cpath;
  }
  
  sub _check_req {
      my ( $self, @required ) = @_;
      my $ok = 1;
      for my $param (@required) {
          if ( !defined $self->args->{$param} ) {
              push @{ $self->messages }, "Parameter $param is required.";
              $ok = 0;
          }
      }
      return $ok;
  }
  
  sub _check_src {
      my $self = shift;
      my $ok   = 1;
      for my $src ( @{ $self->args->{source} } ) {
  
          if ( !-d $src ) {
              push @{ $self->messages },
                "Source " . $src . " is not a valid directory.";
              $ok = 0;
          }
          else {
              $src = $self->_canonize($src);
  
          }
      }
      if ($ok) {
  
          # remove double entries
          my %uniq_hash = map { $_, 1 } @{ $self->args->{'source'} };
          $self->args->{'source'} = [ sort keys %uniq_hash ]
            ;    # Sort to have reproducible search path order later
      }
      return $ok;
  }
  
  sub _check_target {
      my $self = shift;
      my $ok   = 1;
      if ( -e $self->args->{target} && !-d $self->args->{target} ) {
          push @{ $self->messages },
            "Target " . $self->args->{target} . " exists but is not a directory.";
          $ok = 0;
      }
      elsif ( -d $self->args->{target} ) {
          $self->args->{target} = $self->_canonize( $self->args->{target} );
      }
      return $ok;
  }
  
  sub _split_rx {
      my ( $self, $rx_param_ref ) = @_;
      my %rx       = ();
      my $split_ok = 1;
  
      for my $rx_param ( @{$rx_param_ref} ) {
          my $csv = Text::CSV->new();
          if ( $csv->parse($rx_param) ) {
              my @fields = $csv->fields();
              if ( scalar @fields == 2 ) {
                  if ( !exists $rx{ $fields[0] } ) {
                      $rx{ $fields[0] } = $fields[1];
                  }
                  else {
                      push @{ $self->messages },
                        "'$fields[0]' must be unique for a rename-regex.";
                      $split_ok = 0;
                  }
              }
              else {
                  push @{ $self->messages },
  "'$rx_param' can not be decomposed into a valid Perl regex and replacement.";
                  $split_ok = 0;
              }
          }
          else {
              push @{ $self->messages },
  "'$rx_param' can not be decomposed into a valid Perl regex and replacement.";
              $split_ok = 0;
          }
      }
      return ($split_ok) ? \%rx : undef;
  }
  
  sub _validate_rx {
      my ( $self, $rx_ref ) = @_;
      my $status = 1;
      for my $rx ( @{$rx_ref} ) {
          my $eval_rx = eval { qr{$rx} };
          if ($@) {
              $status = 0;
              push @{ $self->messages }, "'$rx' is an invalid Perl regex.";
          }
      }
      return $status;
  }
  
  sub _show_help {
      my ( $self, $version_bool ) = @_;
      require File::Basename;
      my $program = File::Basename::basename($0);
      print "\nOpenCSW FileMerger, version $VERSION. Bugs to claudio\@opencsw.org.\n";
      return if $version_bool;
      print <<"EOL";
  
  usage:\t$program [-s <source directory>] [-t <target directory>]
  \t\t      [-l <full pathname>] [-e <regex>] [-r <regex>]
  
  Available parameters:
  
   -h,--help\t\t\t\tdisplay a help message
   -v,--version\t\t\t\tdisplay the version of the
  \t\t\t\t\tprogram
   -s,--source <source directory> \tsource directory*
   -t,--target <target directory> \ttarget directory
  
   -l,--exclude-literal <file pathname>\texclude files by literal
  \t\t\t\t\tfilename*
   -e,--exclude-rx <regex>\t\tPerl regular expression to
  \t\t\t\t\texclude files by name*
   -r,--rename-rx <regex,text>\t\tRegex and replacement for
  \t\t\t\t\trenaming files*
  
  *: multiple usage allowed.
  All the excludeliterals and regexes work on the full path.
  Slashes (/) don't need to be escaped.
  
  EOL
  
  }
  
  
  1;
FILEMERGER_PARAMS

$fatpacked{"FileMerger/Reporter.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'FILEMERGER_REPORTER';
  package FileMerger::Reporter;
  
  use Moo;
  
  sub run {
      my ( $self, $conflicts_ref, $skipped_ref ) = @_;
      my $ok = 1;
      print "\n\n". '_' x 34 . 'STATUS REPORT' . '_' x 33 . "\n";
      if ( @{$conflicts_ref} ) {
          print "\nThe following conflicts were encountered:\n";
          print "$_\n" for ( sort @{$conflicts_ref} );
          $ok = 0;
      }
      if ( @{$skipped_ref} ) {
          print "\nThe following files and directories were skipped:\n";
          print "$_\n" for ( sort @{$skipped_ref} );
      }
      print "\nDirectories merged without warnings.\n\n" if $ok;
      print "\nDone.\n\n";
  }
  
  1;
FILEMERGER_REPORTER

$fatpacked{"Import/Into.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'IMPORT_INTO';
  package Import::Into;
  
  use strict;
  use warnings FATAL => 'all';
  
  our $VERSION = '1.002002'; # 1.2.2
  
  sub _prelude {
    my $target = shift;
    my ($package, $file, $line, $level)
      = ref $target         ? @{$target}{qw(package filename line)}
      : $target =~ /[^0-9]/ ? ($target)
                            : (undef, undef, undef, $target);
    if (defined $level) {
      my ($p, $fn, $ln) = caller($level + 2);
      $package ||= $p;
      $file    ||= $fn;
      $line    ||= $ln;
    }
    qq{package $package;\n}
      . ($file ? "#line $line \"$file\"\n" : '')
  }
  
  sub _make_action {
    my ($action, $target) = @_;
    my $version = ref $target && $target->{version};
    my $ver_check = $version ? '$_[0]->VERSION($version);' : '';
    eval _prelude($target).qq{sub { $ver_check shift->$action(\@_) }}
      or die "Failed to build action sub to ${action} for ${target}: $@";
  }
  
  sub import::into {
    my ($class, $target, @args) = @_;
    _make_action(import => $target)->($class, @args);
  }
  
  sub unimport::out_of {
    my ($class, $target, @args) = @_;
    _make_action(unimport => $target)->($class, @args);
  }
  
  1;
  
  __END__
  
  =head1 NAME
  
  Import::Into - import packages into other packages
  
  =head1 SYNOPSIS
  
    package My::MultiExporter;
  
    use Import::Into;
  
    use Thing1 ();
    use Thing2 ();
  
    # simple
    sub import {
      Thing1->import::into(scalar caller);
    }
  
    # multiple
    sub import {
      my $target = caller;
      Thing1->import::into($target);
      Thing2->import::into($target, qw(import arguments));
    }
  
    # by level
    sub import {
      Thing1->import::into(1);
    }
  
    # with exporter
    use base qw(Exporter);
    sub import {
      shift->export_to_level(1);
      Thing1->import::into(1);
    }
  
    # no My::MultiExporter == no Thing1
    sub unimport {
      Thing1->unimport::out_of(scalar caller);
    }
  
  People wanting to re-export your module should also be using L<Import::Into>.
  Any exporter or pragma will work seamlessly.
  
  Note: You do B<not> need to make any changes to Thing1 to be able to call
  C<import::into> on it. This is a global method, and is callable on any
  package (and in fact on any object as well, although it's rarer that you'd
  want to do that).
  
  =head1 DESCRIPTION
  
  Writing exporters is a pain. Some use L<Exporter>, some use L<Sub::Exporter>,
  some use L<Moose::Exporter>, some use L<Exporter::Declare> ... and some things
  are pragmas.
  
  Exporting on someone else's behalf is harder.  The exporters don't provide a
  consistent API for this, and pragmas need to have their import method called
  directly, since they effect the current unit of compilation.
  
  C<Import::Into> provides global methods to make this painless.
  
  =head1 METHODS
  
  =head2 $package->import::into( $target, @arguments );
  
  A global method, callable on any package.  Imports the given package into
  C<$target>.  C<@arguments> are passed along to the package's import method.
  
  C<$target> can be an package name to export to, an integer for the
  caller level to export to, or a hashref with the following options:
  
  =over 4
  
  =item package
  
  The target package to export to.
  
  =item filename
  
  The apparent filename to export to.  Some exporting modules, such as
  L<autodie> or L<strictures>, care about the filename they are being imported
  to.
  
  =item line
  
  The apparent line number to export to.  To be combined with the C<filename>
  option.
  
  =item level
  
  The caller level to export to.  This will automatically populate the
  C<package>, C<filename>, and C<line> options, making it the easiest most
  constent option.
  
  =item version
  
  A version number to check for the module.  The equivalent of specifying the
  version number on a C<use> line.
  
  =back
  
  =head2 $package->unimport::out_of( $target, @arguments );
  
  Equivalent to C<import::into>, but dispatches to C<$package>'s C<unimport>
  method instead of C<import>.
  
  =head1 WHY USE THIS MODULE
  
  The APIs for exporting modules aren't consistent.  L<Exporter> subclasses
  provide export_to_level, but if they overrode their import method all bets
  are off.  L<Sub::Exporter> provides an into parameter but figuring out
  something used it isn't trivial. Pragmas need to have their C<import> method
  called directly since they affect the current unit of compilation.
  
  It's ... annoying.
  
  However, there is an approach that actually works for all of these types.
  
    eval "package $target; use $thing;"
  
  will work for anything checking caller, which is everything except pragmas.
  But it doesn't work for pragmas - pragmas need:
  
    $thing->import;
  
  because they're designed to affect the code currently being compiled - so
  within an eval, that's the scope of the eval itself, not the module that
  just C<use>d you - so
  
    sub import {
      eval "use strict;"
    }
  
  doesn't do what you wanted, but
  
    sub import {
      strict->import;
    }
  
  will apply L<strict> to the calling file correctly.
  
  Of course, now you have two new problems - first, that you still need to
  know if something's a pragma, and second that you can't use either of
  these approaches alone on something like L<Moose> or L<Moo> that's both
  an exporter and a pragma.
  
  So, a solution for that is:
  
    my $sub = eval "package $target; sub { shift->import(\@_) }";
    $sub->($thing, @import_args);
  
  which means that import is called from the right place for pragmas to take
  effect, and from the right package for caller checking to work - and so
  behaves correctly for all types of exporter, for pragmas, and for hybrids.
  
  Additionally, some import routines check the filename they are being imported
  to.  This can be dealt with by generating a L<#line directive|perlsyn/Plain
  Old Comments (Not!)> in the eval, which will change what C<caller> reports for
  the filename when called in the importer. The filename and line number to use
  in the directive then need to be fetched using C<caller>:
  
    my ($target, $file, $line) = caller(1);
    my $sub = eval qq{
      package $target;
    #line $line "$file"
      sub { shift->import(\@_) }
    };
    $sub->($thing, @import_args);
  
  And you need to switch between these implementations depending on if you are
  targeting a specific package, or something in your call stack.
  
  Remembering all this, however, is excessively irritating. So I wrote a module
  so I didn't have to anymore. Loading L<Import::Into> creates a global method
  C<import::into> which you can call on any package to import it into another
  package. So now you can simply write:
  
    use Import::Into;
  
    $thing->import::into($target, @import_args);
  
  This works because of how perl resolves method calls - a call to a simple
  method name is resolved against the package of the class or object, so
  
    $thing->method_name(@args);
  
  is roughly equivalent to:
  
    my $code_ref = $thing->can('method_name');
    $code_ref->($thing, @args);
  
  while if a C<::> is found, the lookup is made relative to the package name
  (i.e. everything before the last C<::>) so
  
    $thing->Package::Name::method_name(@args);
  
  is roughly equivalent to:
  
    my $code_ref = Package::Name->can('method_name');
    $code_ref->($thing, @args);
  
  So since L<Import::Into> defines a method C<into> in package C<import>
  the syntax reliably calls that.
  
  For more craziness of this order, have a look at the article I wrote at
  L<http://shadow.cat/blog/matt-s-trout/madness-with-methods> which covers
  coderef abuse and the C<${\...}> syntax.
  
  Final note: You do still need to ensure that you already loaded C<$thing> - if
  you're receiving this from a parameter, I recommend using L<Module::Runtime>:
  
    use Import::Into;
    use Module::Runtime qw(use_module);
  
    use_module($thing)->import::into($target, @import_args);
  
  And that's it.
  
  =head1 SEE ALSO
  
  I gave a lightning talk on this module (and L<curry> and L<Safe::Isa>) at
  L<YAPC::NA 2013|https://www.youtube.com/watch?v=wFXWV2yY7gE&t=46m05s>.
  
  =head1 ACKNOWLEDGEMENTS
  
  Thanks to Getty for asking "how can I get C<< use strict; use warnings; >>
  turned on for all consumers of my code?" and then "why is this not a
  module?!".
  
  =head1 AUTHOR
  
  mst - Matt S. Trout (cpan:MSTROUT) <mst@shadowcat.co.uk>
  
  =head1 CONTRIBUTORS
  
  haarg - Graham Knop (cpan:HAARG) <haarg@haarg.org>
  
  =head1 COPYRIGHT
  
  Copyright (c) 2012 the Import::Into L</AUTHOR> and L</CONTRIBUTORS>
  as listed above.
  
  =head1 LICENSE
  
  This library is free software and may be distributed under the same terms
  as perl itself.
  
  =cut
IMPORT_INTO

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

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

$fatpacked{"Method/Generate/Constructor.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'METHOD_GENERATE_CONSTRUCTOR';
  package Method::Generate::Constructor;
  
  use strictures 1;
  use Sub::Quote;
  use base qw(Moo::Object);
  use Sub::Defer;
  use B 'perlstring';
  use Moo::_Utils qw(_getstash);
  
  sub register_attribute_specs {
    my ($self, @new_specs) = @_;
    my $specs = $self->{attribute_specs}||={};
    while (my ($name, $new_spec) = splice @new_specs, 0, 2) {
      if ($name =~ s/^\+//) {
        die "has '+${name}' given but no ${name} attribute already exists"
          unless my $old_spec = $specs->{$name};
        foreach my $key (keys %$old_spec) {
          if (!exists $new_spec->{$key}) {
            $new_spec->{$key} = $old_spec->{$key}
              unless $key eq 'handles';
          }
          elsif ($key eq 'moosify') {
            $new_spec->{$key} = [
              map { ref $_ eq 'ARRAY' ? @$_ : $_ }
                ($old_spec->{$key}, $new_spec->{$key})
            ];
          }
        }
      }
      if (exists $new_spec->{init_arg} && !defined $new_spec->{init_arg}
          && $new_spec->{required}) {
        die "${name} attribute can't be required with init_arg => undef";
      }
      $new_spec->{index} = scalar keys %$specs
        unless defined $new_spec->{index};
      $specs->{$name} = $new_spec;
    }
    $self;
  }
  
  sub all_attribute_specs {
    $_[0]->{attribute_specs}
  }
  
  sub accessor_generator {
    $_[0]->{accessor_generator}
  }
  
  sub construction_string {
    my ($self) = @_;
    $self->{construction_string}
      ||= $self->_build_construction_string;
  }
  
  sub buildall_generator {
    require Method::Generate::BuildAll;
    Method::Generate::BuildAll->new;
  }
  
  sub _build_construction_string {
    my ($self) = @_;
    my $builder = $self->{construction_builder};
    $builder ? $self->$builder
      : 'bless('
      .$self->accessor_generator->default_construction_string
      .', $class);'
  }
  
  sub install_delayed {
    my ($self) = @_;
    my $package = $self->{package};
    defer_sub "${package}::new" => sub {
      unquote_sub $self->generate_method(
        $package, 'new', $self->{attribute_specs}, { no_install => 1 }
      )
    };
    $self;
  }
  
  sub generate_method {
    my ($self, $into, $name, $spec, $quote_opts) = @_;
    foreach my $no_init (grep !exists($spec->{$_}{init_arg}), keys %$spec) {
      $spec->{$no_init}{init_arg} = $no_init;
    }
    local $self->{captures} = {};
    my $body = '    my $class = shift;'."\n"
              .'    $class = ref($class) if ref($class);'."\n";
    $body .= $self->_handle_subconstructor($into, $name);
    my $into_buildargs = $into->can('BUILDARGS');
    if ( $into_buildargs && $into_buildargs != \&Moo::Object::BUILDARGS ) {
        $body .= $self->_generate_args_via_buildargs;
    } else {
        $body .= $self->_generate_args;
    }
    $body .= $self->_check_required($spec);
    $body .= '    my $new = '.$self->construction_string.";\n";
    $body .= $self->_assign_new($spec);
    if ($into->can('BUILD')) {
      $body .= $self->buildall_generator->buildall_body_for(
        $into, '$new', '$args'
      );
    }
    $body .= '    return $new;'."\n";
    if ($into->can('DEMOLISH')) {
      require Method::Generate::DemolishAll;
      Method::Generate::DemolishAll->new->generate_method($into);
    }
    quote_sub
      "${into}::${name}" => $body,
      $self->{captures}, $quote_opts||{}
    ;
  }
  
  sub _handle_subconstructor {
    my ($self, $into, $name) = @_;
    if (my $gen = $self->{subconstructor_handler}) {
      '    if ($class ne '.perlstring($into).') {'."\n".
      $gen.
      '    }'."\n";
    } else {
      ''
    }
  }
  
  sub _cap_call {
    my ($self, $code, $captures) = @_;
    @{$self->{captures}}{keys %$captures} = values %$captures if $captures;
    $code;
  }
  
  sub _generate_args_via_buildargs {
    my ($self) = @_;
    q{    my $args = $class->BUILDARGS(@_);}."\n"
    .q{    die "BUILDARGS did not return a hashref" unless ref($args) eq 'HASH';}
    ."\n";
  }
  
  # inlined from Moo::Object - update that first.
  sub _generate_args {
    my ($self) = @_;
    return <<'_EOA';
      my $args;
      if ( scalar @_ == 1 ) {
          unless ( defined $_[0] && ref $_[0] eq 'HASH' ) {
              die "Single parameters to new() must be a HASH ref"
                  ." data => ". $_[0] ."\n";
          }
          $args = { %{ $_[0] } };
      }
      elsif ( @_ % 2 ) {
          die "The new() method for $class expects a hash reference or a key/value list."
                  . " You passed an odd number of arguments\n";
      }
      else {
          $args = {@_};
      }
  _EOA
  
  }
  
  sub _assign_new {
    my ($self, $spec) = @_;
    my $ag = $self->accessor_generator;
    my %test;
    NAME: foreach my $name (sort keys %$spec) {
      my $attr_spec = $spec->{$name};
      next NAME unless defined($attr_spec->{init_arg})
                         or $ag->has_eager_default($name, $attr_spec);
      $test{$name} = $attr_spec->{init_arg};
    }
    join '', map {
      my $arg_key = perlstring($test{$_});
      my $test = "exists \$args->{$arg_key}";
      my $source = "\$args->{$arg_key}";
      my $attr_spec = $spec->{$_};
      $self->_cap_call($ag->generate_populate_set(
        '$new', $_, $attr_spec, $source, $test, $test{$_},
      ));
    } sort keys %test;
  }
  
  sub _check_required {
    my ($self, $spec) = @_;
    my @required_init =
      map $spec->{$_}{init_arg},
        grep {
          my %s = %{$spec->{$_}}; # ignore required if default or builder set
          $s{required} and not($s{builder} or $s{default})
        } sort keys %$spec;
    return '' unless @required_init;
    '    if (my @missing = grep !exists $args->{$_}, qw('
      .join(' ',@required_init).')) {'."\n"
      .q{      die "Missing required arguments: ".join(', ', sort @missing);}."\n"
      ."    }\n";
  }
  
  use Moo;
  Moo->_constructor_maker_for(__PACKAGE__)->register_attribute_specs(
    attribute_specs => {
      is => 'ro',
      reader => 'all_attribute_specs',
    },
    accessor_generator => { is => 'ro' },
    construction_string => { is => 'lazy' },
    construction_builder => { is => 'lazy' },
    subconstructor_handler => { is => 'ro' },
    package => { is => 'ro' },
  );
  
  1;
METHOD_GENERATE_CONSTRUCTOR

$fatpacked{"Method/Generate/DemolishAll.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'METHOD_GENERATE_DEMOLISHALL';
  package Method::Generate::DemolishAll;
  
  use strictures 1;
  use base qw(Moo::Object);
  use Sub::Quote;
  use Moo::_Utils;
  use B qw(perlstring);
  
  sub generate_method {
    my ($self, $into) = @_;
    quote_sub "${into}::DEMOLISHALL", join '',
      $self->_handle_subdemolish($into),
      qq{    my \$self = shift;\n},
      $self->demolishall_body_for($into, '$self', '@_'),
      qq{    return \$self\n};
    quote_sub "${into}::DESTROY", join '',
      q!    my $self = shift;
      my $e = do {
        local $?;
        local $@;
        require Moo::_Utils;
        eval {
          $self->DEMOLISHALL(Moo::_Utils::_in_global_destruction);
        };
        $@;
      };
    
      no warnings 'misc';
      die $e if $e; # rethrow
    !;
  }
  
  sub demolishall_body_for {
    my ($self, $into, $me, $args) = @_;
    my @demolishers =
      grep *{_getglob($_)}{CODE},
      map "${_}::DEMOLISH",
      @{Moo::_Utils::_get_linear_isa($into)};
    join '', map qq{    ${me}->${_}(${args});\n}, @demolishers;
  }
  
  sub _handle_subdemolish {
    my ($self, $into) = @_;
    '    if (ref($_[0]) ne '.perlstring($into).') {'."\n".
    '      return shift->Moo::Object::DEMOLISHALL(@_)'.";\n".
    '    }'."\n";
  }
  
  1;
METHOD_GENERATE_DEMOLISHALL

$fatpacked{"Method/Inliner.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'METHOD_INLINER';
  package Method::Inliner;
  
  use strictures 1;
  use Text::Balanced qw(extract_bracketed);
  use Sub::Quote ();
  
  sub slurp { do { local (@ARGV, $/) = $_[0]; <> } }
  sub splat {
    open my $out, '>', $_[1] or die "can't open $_[1]: $!";
    print $out $_[0] or die "couldn't write to $_[1]: $!";
  }
  
  sub inlinify {
    my $file = $_[0];
    my @chunks = split /(^sub.*?^}$)/sm, slurp $file;
    warn join "\n--\n", @chunks;
    my %code;
    foreach my $chunk (@chunks) {
      if (my ($name, $body) =
        $chunk =~ /^sub (\S+) {\n(.*)\n}$/s
      ) {
        $code{$name} = $body;
      }
    }
    foreach my $chunk (@chunks) {
      my ($me) = $chunk =~ /^sub.*{\n  my \((\$\w+).*\) = \@_;\n/ or next;
      my $meq = quotemeta $me;
      #warn $meq, $chunk;
      my $copy = $chunk;
      my ($fixed, $rest);
      while ($copy =~ s/^(.*?)${meq}->(\S+)(?=\()//s) {
        my ($front, $name) = ($1, $2);
        ((my $body), $rest) = extract_bracketed($copy, '()');
        warn "spotted ${name} - ${body}";
        if ($code{$name}) {
        warn "replacing";
          s/^\(//, s/\)$// for $body;
          $body = "${me}, ".$body;
          $fixed .= $front.Sub::Quote::inlinify($code{$name}, $body);
        } else {
  	$fixed .= $front.$me.'->'.$name.$body;
        }
        #warn $fixed; warn $rest;
        $copy = $rest;
      }
      $fixed .= $rest if $fixed;
      warn $fixed if $fixed;
      $chunk = $fixed if $fixed;
    }
    print join '', @chunks;
  }
  
  1;
METHOD_INLINER

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

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

$fatpacked{"Moo/Conflicts.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'MOO_CONFLICTS';
  package # hide from PAUSE
      Moo::Conflicts;
  
  use strict;
  use warnings;
  
  use Dist::CheckConflicts
      -dist      => 'Moo',
      -conflicts => {
          # enter conflicting downstream deps here, with the version indicating
          # the last *broken* version that *does not work*.
          'HTML::Restrict' => '2.1.5',
      },
  
      # these dists' ::Conflicts modules (if they exist) are also checked for
      # more incompatibilities -- should include all runtime prereqs here.
      -also => [ qw(
          Carp
          Class::Method::Modifiers
          strictures
          Module::Runtime
          Role::Tiny
          Devel::GlobalDestruction
      ) ],
  ;
  
  1;
MOO_CONFLICTS

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

$fatpacked{"Moo/HandleMoose/FakeMetaClass.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'MOO_HANDLEMOOSE_FAKEMETACLASS';
  package Moo::HandleMoose::FakeMetaClass;
  
  sub DESTROY { }
  
  sub AUTOLOAD {
    my ($meth) = (our $AUTOLOAD =~ /([^:]+)$/);
    require Moo::HandleMoose;
    Moo::HandleMoose::inject_real_metaclass_for((shift)->{name})->$meth(@_)
  }
  sub can {
    require Moo::HandleMoose;
    Moo::HandleMoose::inject_real_metaclass_for((shift)->{name})->can(@_)
  }
  sub isa {
    require Moo::HandleMoose;
    Moo::HandleMoose::inject_real_metaclass_for((shift)->{name})->isa(@_)
  }
  sub make_immutable { $_[0] }
  
  1;
MOO_HANDLEMOOSE_FAKEMETACLASS

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

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

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

$fatpacked{"Moo/_Utils.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'MOO__UTILS';
  package Moo::_Utils;
  
  no warnings 'once'; # guard against -w
  
  sub _getglob { \*{$_[0]} }
  sub _getstash { \%{"$_[0]::"} }
  
  use constant lt_5_8_3 => ( $] < 5.008003 or $ENV{MOO_TEST_PRE_583} ) ? 1 : 0;
  use constant can_haz_subname => eval { require Sub::Name };
  
  use strictures 1;
  use Module::Runtime qw(use_package_optimistically module_notional_filename);
  
  use Devel::GlobalDestruction ();
  use base qw(Exporter);
  use Moo::_mro;
  use Config;
  
  our @EXPORT = qw(
      _getglob _install_modifier _load_module _maybe_load_module
      _get_linear_isa _getstash _install_coderef _name_coderef
      _unimport_coderefs _in_global_destruction _set_loaded
  );
  
  sub _in_global_destruction ();
  *_in_global_destruction = \&Devel::GlobalDestruction::in_global_destruction;
  
  sub _install_modifier {
    my ($into, $type, $name, $code) = @_;
  
    if (my $to_modify = $into->can($name)) { # CMM will throw for us if not
      require Sub::Defer;
      Sub::Defer::undefer_sub($to_modify);
    }
  
    Class::Method::Modifiers::install_modifier(@_);
  }
  
  our %MAYBE_LOADED;
  
  sub _load_module {
    my $module = $_[0];
    my $file = module_notional_filename($module);
    use_package_optimistically($module);
    return 1
      if $INC{$file};
    my $error = $@ || "Can't locate $file";
  
    # can't just ->can('can') because a sub-package Foo::Bar::Baz
    # creates a 'Baz::' key in Foo::Bar's symbol table
    my $stash = _getstash($module)||{};
    return 1 if grep +(!ref($_) and *$_{CODE}), values %$stash;
    return 1
      if $INC{"Moose.pm"} && Class::MOP::class_of($module)
      or Mouse::Util->can('find_meta') && Mouse::Util::find_meta($module);
    die $error;
  }
  
  sub _maybe_load_module {
    return $MAYBE_LOADED{$_[0]} if exists $MAYBE_LOADED{$_[0]};
    (my $proto = $_[0]) =~ s/::/\//g;
    local $@;
    if (eval { require "${proto}.pm"; 1 }) {
      $MAYBE_LOADED{$_[0]} = 1;
    } else {
      if (exists $INC{"${proto}.pm"}) {
        warn "$_[0] exists but failed to load with error: $@";
      }
      $MAYBE_LOADED{$_[0]} = 0;
    }
    return $MAYBE_LOADED{$_[0]};
  }
  
  sub _set_loaded {
    $INC{Module::Runtime::module_notional_filename($_[0])} ||= $_[1];
  }
  
  sub _get_linear_isa {
    return mro::get_linear_isa($_[0]);
  }
  
  sub _install_coderef {
    no warnings 'redefine';
    *{_getglob($_[0])} = _name_coderef(@_);
  }
  
  sub _name_coderef {
    shift if @_ > 2; # three args is (target, name, sub)
    can_haz_subname ? Sub::Name::subname(@_) : $_[1];
  }
  
  sub _unimport_coderefs {
    my ($target, $info) = @_;
    return unless $info and my $exports = $info->{exports};
    my %rev = reverse %$exports;
    my $stash = _getstash($target);
    foreach my $name (keys %$exports) {
      if ($stash->{$name} and defined(&{$stash->{$name}})) {
        if ($rev{$target->can($name)}) {
          my $old = delete $stash->{$name};
          my $full_name = join('::',$target,$name);
          # Copy everything except the code slot back into place (e.g. $has)
          foreach my $type (qw(SCALAR HASH ARRAY IO)) {
            next unless defined(*{$old}{$type});
            no strict 'refs';
            *$full_name = *{$old}{$type};
          }
        }
      }
    }
  }
  
  if ($Config{useithreads}) {
    require Moo::HandleMoose::_TypeMap;
  }
  
  1;
MOO__UTILS

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

$fatpacked{"Moo/sification.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'MOO_SIFICATION';
  package Moo::sification;
  
  use strictures 1;
  use Moo::_Utils ();
  
  sub unimport { our $disarmed = 1 }
  
  sub Moo::HandleMoose::AuthorityHack::DESTROY {
    unless (our $disarmed or Moo::_Utils::_in_global_destruction) {
      require Moo::HandleMoose;
      Moo::HandleMoose->import;
    }
  }
  
  if ($INC{"Moose.pm"}) {
    require Moo::HandleMoose;
    Moo::HandleMoose->import;
  } else {
    $Moose::AUTHORITY = bless({}, 'Moo::HandleMoose::AuthorityHack');
  }
  
  1;
MOO_SIFICATION

$fatpacked{"Role/Tiny.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'ROLE_TINY';
  package Role::Tiny;
  
  sub _getglob { \*{$_[0]} }
  sub _getstash { \%{"$_[0]::"} }
  
  use strict;
  use warnings FATAL => 'all';
  
  our $VERSION = '1.003003';
  $VERSION = eval $VERSION;
  
  our %INFO;
  our %APPLIED_TO;
  our %COMPOSED;
  our %COMPOSITE_INFO;
  our @ON_ROLE_CREATE;
  
  # Module state workaround totally stolen from Zefram's Module::Runtime.
  
  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};
    # can't just ->can('can') because a sub-package Foo::Bar::Baz
    # creates a 'Baz::' key in Foo::Bar's symbol table
    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(FATAL => 'all');
    return if $me->is_role($target); # already exported into this package
    $INFO{$target}{is_role} = 1;
    # get symbol table reference
    my $stash = _getstash($target);
    # install before/after/around subs
    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;
    };
    # grab all *non-constant* (stash slot is not a scalarref) subs present
    # in the symbol table and store their refaddrs (no need to forcibly
    # inflate constant subs into real subs) with a map to the coderefs in
    # case of copying or re-use
    my @not_methods = (map { *$_{CODE}||() } grep !ref($_), values %$stash);
    @{$INFO{$target}{not_methods}={}}{@not_methods} = @not_methods;
    # a role does itself
    $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) = @_;
    # copy our role list into the target's
    @{$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);
    # on perl < 5.8.9, magic isn't copied to all ref copies. bless the parameter
    # directly, so at least the variable passed to us will get any magic applied
    bless($_[1], $me->create_class_with_roles($class, @roles));
  }
  
  my $role_suffix = 'A000';
  sub _composite_name {
    my ($me, $superclass, @roles) = @_;
  
    my $new_name = join(
      '__WITH__', $superclass, my $compose_name = join '__AND__', @roles
    );
  
    if (length($new_name) > 252) {
      $new_name = $COMPOSED{abbrev}{$new_name}
        ||= substr($new_name, 0, 250 - length $role_suffix).'__'.$role_suffix++;
    }
    return wantarray ? ($new_name, $compose_name) : $new_name;
  }
  
  sub create_class_with_roles {
    my ($me, $superclass, @roles) = @_;
  
    die "No roles supplied!" unless @roles;
  
    _load_module($superclass);
    {
      my %seen;
      $seen{$_}++ for @roles;
      if (my @dupes = grep $seen{$_} > 1, @roles) {
        die "Duplicated roles: ".join(', ', @dupes);
      }
    }
  
    my ($new_name, $compose_name) = $me->_composite_name($superclass, @roles);
  
    return $new_name if $COMPOSED{class}{$new_name};
  
    foreach my $role (@roles) {
      _load_module($role);
      die "${role} is not a Role::Tiny" unless $me->is_role($role);
    }
  
    require(_MRO_MODULE);
  
    my $composite_info = $me->_composite_info_for(@roles);
    my %conflicts = %{$composite_info->{conflicts}};
    if (keys %conflicts) {
      my $fail =
        join "\n",
          map {
            "Method name conflict for '$_' between roles "
            ."'".join(' and ', sort values %{$conflicts{$_}})."'"
            .", cannot apply these simultaneously to an object."
          } keys %conflicts;
      die $fail;
    }
  
    my @composable = map $me->_composable_package_for($_), reverse @roles;
  
    # some methods may not exist in the role, but get generated by
    # _composable_package_for (Moose accessors via Moo).  filter out anything
    # provided by the composable packages, excluding the subs we generated to
    # make modifiers work.
    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;
  }
  
  # preserved for compat, and apply_roles_to_package calls it to allow an
  # updated Role::Tiny to use a non-updated Moo::Role
  
  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;
    }
  
    # conflicting methods are supposed to be treated as required by the
    # composed role. we don't have an actual composed role, but because
    # we know the target class already provides them, we can instead
    # pretend that the roles don't do for the duration of application.
    my @role_methods = map $me->_concrete_methods_of($_), @roles;
    # separate loops, since local ..., delete ... for ...; creates a scope
    local @{$_}{@have} for @role_methods;
    delete @{$_}{@have} for @role_methods;
  
    # the if guard here is essential since otherwise we accidentally create
    # a $INFO for something that isn't a Role::Tiny (or Moo::Role) because
    # autovivification hates us and wants us to die()
    if ($INFO{$to}) {
      delete $INFO{$to}{methods}; # reset since we're about to add methods
    }
  
    # backcompat: allow subclasses to use apply_single_role_to_package
    # to apply changes.  set a local var so ours does nothing.
    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';
    # force stash to exist so ->can doesn't complain
    _getstash($base_name);
    # Not using _getglob, since setting @ISA via the typeglob breaks
    # inheritance on 5.10.0 if the stash has previously been accessed an
    # then a method called on the class (in that order!), which
    # ->_install_methods (with the help of ->_install_does) ends up doing.
    { 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) {
      # role -> role, add to requires, role -> class, error out
      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};
    # grab role symbol table
    my $stash = _getstash($role);
    # reverse so our keys become the values (captured coderefs) in case
    # they got copied or re-used since
    my $not_methods = { reverse %{$info->{not_methods}||{}} };
    $info->{methods} ||= +{
      # grab all code entries that aren't in the not_methods list
      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);
  
    # grab target symbol table
    my $stash = _getstash($to);
  
    # determine already extant methods of target
    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};
  
      # overloads using method names have the method stored in the scalar slot
      # and &overload::nil in the code slot.
      next
        unless $i =~ /^\(/
          && 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) = @_;
  
    # only add does() method to classes
    return if $me->is_role($to);
  
    # add does() only if they don't have one
    *{_getglob "${to}::does"} = \&does_role 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) = @_;
      Role::Tiny::does_role($proto, $role) or $proto->$existing($role);
    };
    no warnings 'redefine';
    *{_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__
  
  =encoding utf-8
  
  =head1 NAME
  
  Role::Tiny - Roles. Like a nouvelle cuisine portion size slice of Moose.
  
  =head1 SYNOPSIS
  
   package Some::Role;
  
   use Role::Tiny;
  
   sub foo { ... }
  
   sub bar { ... }
  
   around baz => sub { ... }
  
   1;
  
  else where
  
   package Some::Class;
  
   use Role::Tiny::With;
  
   # bar gets imported, but not foo
   with 'Some::Role';
  
   sub foo { ... }
  
   # baz is wrapped in the around modifier by Class::Method::Modifiers
   sub baz { ... }
  
   1;
  
  If you wanted attributes as well, look at L<Moo::Role>.
  
  =head1 DESCRIPTION
  
  C<Role::Tiny> is a minimalist role composition tool.
  
  =head1 ROLE COMPOSITION
  
  Role composition can be thought of as much more clever and meaningful multiple
  inheritance.  The basics of this implementation of roles is:
  
  =over 2
  
  =item *
  
  If a method is already defined on a class, that method will not be composed in
  from the role.
  
  =item *
  
  If a method that the role L</requires> to be implemented is not implemented,
  role application will fail loudly.
  
  =back
  
  Unlike L<Class::C3>, where the B<last> class inherited from "wins," role
  composition is the other way around, where the class wins. If multiple roles
  are applied in a single call (single with statement), then if any of their
  provided methods clash, an exception is raised unless the class provides
  a method since this conflict indicates a potential problem.
  
  =head1 IMPORTED SUBROUTINES
  
  =head2 requires
  
   requires qw(foo bar);
  
  Declares a list of methods that must be defined to compose role.
  
  =head2 with
  
   with 'Some::Role1';
  
   with 'Some::Role1', 'Some::Role2';
  
  Composes another role into the current role (or class via L<Role::Tiny::With>).
  
  If you have conflicts and want to resolve them in favour of Some::Role1 you
  can instead write:
  
   with 'Some::Role1';
   with 'Some::Role2';
  
  If you have conflicts and want to resolve different conflicts in favour of
  different roles, please refactor your codebase.
  
  =head2 before
  
   before foo => sub { ... };
  
  See L<< Class::Method::Modifiers/before method(s) => sub { ... } >> for full
  documentation.
  
  Note that since you are not required to use method modifiers,
  L<Class::Method::Modifiers> is lazily loaded and we do not declare it as
  a dependency. If your L<Role::Tiny> role uses modifiers you must depend on
  both L<Class::Method::Modifiers> and L<Role::Tiny>.
  
  =head2 around
  
   around foo => sub { ... };
  
  See L<< Class::Method::Modifiers/around method(s) => sub { ... } >> for full
  documentation.
  
  Note that since you are not required to use method modifiers,
  L<Class::Method::Modifiers> is lazily loaded and we do not declare it as
  a dependency. If your L<Role::Tiny> role uses modifiers you must depend on
  both L<Class::Method::Modifiers> and L<Role::Tiny>.
  
  =head2 after
  
   after foo => sub { ... };
  
  See L<< Class::Method::Modifiers/after method(s) => sub { ... } >> for full
  documentation.
  
  Note that since you are not required to use method modifiers,
  L<Class::Method::Modifiers> is lazily loaded and we do not declare it as
  a dependency. If your L<Role::Tiny> role uses modifiers you must depend on
  both L<Class::Method::Modifiers> and L<Role::Tiny>.
  
  =head2 Strict and Warnings
  
  In addition to importing subroutines, using C<Role::Tiny> applies L<strict> and
  L<fatal warnings|perllexwarn/Fatal Warnings> to the caller.  It's possible to
  disable these if desired:
  
   use Role::Tiny;
   use warnings NONFATAL => 'all';
  
  =head1 SUBROUTINES
  
  =head2 does_role
  
   if (Role::Tiny::does_role($foo, 'Some::Role')) {
     ...
   }
  
  Returns true if class has been composed with role.
  
  This subroutine is also installed as ->does on any class a Role::Tiny is
  composed into unless that class already has an ->does method, so
  
    if ($foo->does('Some::Role')) {
      ...
    }
  
  will work for classes but to test a role, one must use ::does_role directly.
  
  Additionally, Role::Tiny will override the standard Perl C<DOES> method
  for your class. However, if C<any> class in your class' inheritance
  hierarchy provides C<DOES>, then Role::Tiny will not override it.
  
  =head1 METHODS
  
  =head2 apply_roles_to_package
  
   Role::Tiny->apply_roles_to_package(
     'Some::Package', 'Some::Role', 'Some::Other::Role'
   );
  
  Composes role with package.  See also L<Role::Tiny::With>.
  
  =head2 apply_roles_to_object
  
   Role::Tiny->apply_roles_to_object($foo, qw(Some::Role1 Some::Role2));
  
  Composes roles in order into object directly.  Object is reblessed into the
  resulting class.
  
  =head2 create_class_with_roles
  
   Role::Tiny->create_class_with_roles('Some::Base', qw(Some::Role1 Some::Role2));
  
  Creates a new class based on base, with the roles composed into it in order.
  New class is returned.
  
  =head2 is_role
  
   Role::Tiny->is_role('Some::Role1')
  
  Returns true if the given package is a role.
  
  =head1 CAVEATS
  
  =over 4
  
  =item * On perl 5.8.8 and earlier, applying a role to an object won't apply any
  overloads from the role to all copies of the object.
  
  =back
  
  =head1 SEE ALSO
  
  L<Role::Tiny> is the attribute-less subset of L<Moo::Role>; L<Moo::Role> is
  a meta-protocol-less subset of the king of role systems, L<Moose::Role>.
  
  Ovid's L<Role::Basic> provides roles with a similar scope, but without method
  modifiers, and having some extra usage restrictions.
  
  =head1 AUTHOR
  
  mst - Matt S. Trout (cpan:MSTROUT) <mst@shadowcat.co.uk>
  
  =head1 CONTRIBUTORS
  
  dg - David Leadbeater (cpan:DGL) <dgl@dgl.cx>
  
  frew - Arthur Axel "fREW" Schmidt (cpan:FREW) <frioux@gmail.com>
  
  hobbs - Andrew Rodland (cpan:ARODLAND) <arodland@cpan.org>
  
  jnap - John Napiorkowski (cpan:JJNAPIORK) <jjn1056@yahoo.com>
  
  ribasushi - Peter Rabbitson (cpan:RIBASUSHI) <ribasushi@cpan.org>
  
  chip - Chip Salzenberg (cpan:CHIPS) <chip@pobox.com>
  
  ajgb - Alex J. G. Burzyński (cpan:AJGB) <ajgb@cpan.org>
  
  doy - Jesse Luehrs (cpan:DOY) <doy at tozt dot net>
  
  perigrin - Chris Prather (cpan:PERIGRIN) <chris@prather.org>
  
  Mithaldu - Christian Walde (cpan:MITHALDU) <walde.christian@googlemail.com>
  
  ilmari - Dagfinn Ilmari Mannsåker (cpan:ILMARI) <ilmari@ilmari.org>
  
  tobyink - Toby Inkster (cpan:TOBYINK) <tobyink@cpan.org>
  
  haarg - Graham Knop (cpan:HAARG) <haarg@haarg.org>
  
  =head1 COPYRIGHT
  
  Copyright (c) 2010-2012 the Role::Tiny L</AUTHOR> and L</CONTRIBUTORS>
  as listed above.
  
  =head1 LICENSE
  
  This library is free software and may be distributed under the same terms
  as perl itself.
  
  =cut
ROLE_TINY

$fatpacked{"Role/Tiny/With.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'ROLE_TINY_WITH';
  package Role::Tiny::With;
  
  use strict;
  use warnings FATAL => 'all';
  
  our $VERSION = '1.003003';
  $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;
  
  =head1 NAME
  
  Role::Tiny::With - Neat interface for consumers of Role::Tiny roles
  
  =head1 SYNOPSIS
  
   package Some::Class;
  
   use Role::Tiny::With;
  
   with 'Some::Role';
  
   # The role is now mixed in
  
  =head1 DESCRIPTION
  
  C<Role::Tiny> is a minimalist role composition tool.  C<Role::Tiny::With>
  provides a C<with> function to compose such roles.
  
  =head1 AUTHORS
  
  See L<Role::Tiny> for authors.
  
  =head1 COPYRIGHT AND LICENSE
  
  See L<Role::Tiny> for the copyright and license.
  
  =cut
  
  
ROLE_TINY_WITH

$fatpacked{"Sub/Defer.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'SUB_DEFER';
  package Sub::Defer;
  
  use strictures 1;
  use base qw(Exporter);
  use Moo::_Utils;
  use Scalar::Util qw(weaken);
  
  our $VERSION = '1.004002';
  $VERSION = eval $VERSION;
  
  our @EXPORT = qw(defer_sub undefer_sub undefer_all);
  
  our %DEFERRED;
  
  sub undefer_sub {
    my ($deferred) = @_;
    my ($target, $maker, $undeferred_ref) = @{
      $DEFERRED{$deferred}||return $deferred
    };
    return ${$undeferred_ref}
      if ${$undeferred_ref};
    ${$undeferred_ref} = my $made = $maker->();
  
    # make sure the method slot has not changed since deferral time
    if (defined($target) && $deferred eq *{_getglob($target)}{CODE}||'') {
      no warnings 'redefine';
  
      # I believe $maker already evals with the right package/name, so that
      # _install_coderef calls are not necessary --ribasushi
      *{_getglob($target)} = $made;
    }
    weaken($DEFERRED{$made} = $DEFERRED{$deferred});
  
    return $made;
  }
  
  sub undefer_all {
    undefer_sub($_) for keys %DEFERRED;
    return;
  }
  
  sub defer_info {
    my ($deferred) = @_;
    $DEFERRED{$deferred||''};
  }
  
  sub defer_sub {
    my ($target, $maker) = @_;
    my $undeferred;
    my $deferred_info;
    my $deferred = sub {
      $undeferred ||= undefer_sub($deferred_info->[3]);
      goto &$undeferred;
    };
    $deferred_info = [ $target, $maker, \$undeferred, $deferred ];
    weaken($DEFERRED{$deferred} = $deferred_info);
    _install_coderef($target => $deferred) if defined $target;
    return $deferred;
  }
  
  sub CLONE {
    %DEFERRED = map { defined $_ ? ($_->[3] => $_) : () } values %DEFERRED;
    weaken($_) for values %DEFERRED;
  }
  
  1;
  __END__
  
  =head1 NAME
  
  Sub::Defer - defer generation of subroutines until they are first called
  
  =head1 SYNOPSIS
  
   use Sub::Defer;
  
   my $deferred = defer_sub 'Logger::time_since_first_log' => sub {
      my $t = time;
      sub { time - $t };
   };
  
    Logger->time_since_first_log; # returns 0 and replaces itself
    Logger->time_since_first_log; # returns time - $t
  
  =head1 DESCRIPTION
  
  These subroutines provide the user with a convenient way to defer creation of
  subroutines and methods until they are first called.
  
  =head1 SUBROUTINES
  
  =head2 defer_sub
  
   my $coderef = defer_sub $name => sub { ... };
  
  This subroutine returns a coderef that encapsulates the provided sub - when
  it is first called, the provided sub is called and is -itself- expected to
  return a subroutine which will be goto'ed to on subsequent calls.
  
  If a name is provided, this also installs the sub as that name - and when
  the subroutine is undeferred will re-install the final version for speed.
  
  =head2 undefer_sub
  
   my $coderef = undefer_sub \&Foo::name;
  
  If the passed coderef has been L<deferred|/defer_sub> this will "undefer" it.
  If the passed coderef has not been deferred, this will just return it.
  
  If this is confusing, take a look at the example in the L</SYNOPSIS>.
  
  =head2 undefer_all
  
   undefer_all();
  
  This will undefer all defered subs in one go.  This can be very useful in a
  forking environment where child processes would each have to undefer the same
  subs.  By calling this just before you start forking children you can undefer
  all currently deferred subs in the parent so that the children do not have to
  do it.
  
  =head1 SUPPORT
  
  See L<Moo> for support and contact information.
  
  =head1 AUTHORS
  
  See L<Moo> for authors.
  
  =head1 COPYRIGHT AND LICENSE
  
  See L<Moo> for the copyright and license.
  
  =cut
SUB_DEFER

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

$fatpacked{"Sub/Quote.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'SUB_QUOTE';
  package Sub::Quote;
  
  use strictures 1;
  
  sub _clean_eval { eval $_[0] }
  
  use Sub::Defer;
  use B 'perlstring';
  use Scalar::Util qw(weaken);
  use base qw(Exporter);
  
  our $VERSION = '1.004002';
  $VERSION = eval $VERSION;
  
  our @EXPORT = qw(quote_sub unquote_sub quoted_from_sub);
  
  our %QUOTED;
  
  our %WEAK_REFS;
  
  sub capture_unroll {
    my ($from, $captures, $indent) = @_;
    join(
      '',
      map {
        /^([\@\%\$])/
          or die "capture key should start with \@, \% or \$: $_";
        (' ' x $indent).qq{my ${_} = ${1}{${from}->{${\perlstring $_}}};\n};
      } keys %$captures
    );
  }
  
  sub inlinify {
    my ($code, $args, $extra, $local) = @_;
    my $do = 'do { '.($extra||'');
    if ($code =~ s/^(\s*package\s+([a-zA-Z0-9:]+);)//) {
      $do .= $1;
    }
    my $assign = '';
    if (my ($code_args) = $code =~ /^\s*my\s*\(([^)]+)\)\s*=\s*\@_;$/s) {
      if ($code_args ne $args) {
        $assign = 'my ('.$code_args.') = ('.$args.'); ';
      }
    }
    elsif ($local || $args ne '@_') {
      $assign = ($local ? 'local ' : '').'@_ = ('.$args.'); ';
    }
    $do.$assign.$code.' }';
  }
  
  sub quote_sub {
    # HOLY DWIMMERY, BATMAN!
    # $name => $code => \%captures => \%options
    # $name => $code => \%captures
    # $name => $code
    # $code => \%captures => \%options
    # $code
    my $options =
      (ref($_[-1]) eq 'HASH' and ref($_[-2]) eq 'HASH')
        ? pop
        : {};
    my $captures = ref($_[-1]) eq 'HASH' ? pop : undef;
    undef($captures) if $captures && !keys %$captures;
    my $code = pop;
    my $name = $_[0];
    my ($package, $hints, $bitmask, $hintshash) = (caller(0))[0,8,9,10];
    my $context
      ="package $package;\n"
      ."BEGIN {\n"
      ."  \$^H = ".B::perlstring($hints).";\n"
      ."  \${^WARNING_BITS} = ".B::perlstring($bitmask).";\n"
      ."  \%^H = (\n"
      . join('', map
       "    ".B::perlstring($_)." => ".B::perlstring($hintshash->{$_}).",",
        keys %$hintshash)
      ."  );\n"
      ."}\n";
    $code = "$context$code";
    my $quoted_info;
    my $deferred = defer_sub +($options->{no_install} ? undef : $name) => sub {
      unquote_sub($quoted_info->[4]);
    };
    $quoted_info = [ $name, $code, $captures, undef, $deferred ];
    weaken($QUOTED{$deferred} = $quoted_info);
    return $deferred;
  }
  
  sub quoted_from_sub {
    my ($sub) = @_;
    $QUOTED{$sub||''};
  }
  
  sub unquote_sub {
    my ($sub) = @_;
    unless ($QUOTED{$sub}[3]) {
      my ($name, $code, $captures) = @{$QUOTED{$sub}};
  
      my $make_sub = "{\n";
  
      my %captures = $captures ? %$captures : ();
      $captures{'$_QUOTED'} = \$QUOTED{$sub};
      $make_sub .= capture_unroll("\$_[1]", \%captures, 2);
  
      $make_sub .= (
        $name
            # disable the 'variable $x will not stay shared' warning since
            # we're not letting it escape from this scope anyway so there's
            # nothing trying to share it
          ? "  no warnings 'closure';\n  sub ${name} {\n"
          : "  \$_QUOTED->[3] = sub {\n"
      );
      $make_sub .= $code;
      $make_sub .= "  }".($name ? '' : ';')."\n";
      if ($name) {
        $make_sub .= "  \$_QUOTED->[3] = \\&${name}\n";
      }
      $make_sub .= "}\n1;\n";
      $ENV{SUB_QUOTE_DEBUG} && warn $make_sub;
      {
        no strict 'refs';
        local *{$name} if $name;
        my ($success, $e);
        {
          local $@;
          $success = _clean_eval($make_sub, \%captures);
          $e = $@;
        }
        unless ($success) {
          die "Eval went very, very wrong:\n\n${make_sub}\n\n$e";
        }
      }
    }
    $QUOTED{$sub}[3];
  }
  
  sub CLONE {
    %QUOTED = map { defined $_ ? ($_->[4] => $_) : () } values %QUOTED;
    weaken($_) for values %QUOTED;
  }
  
  1;
  __END__
  
  =head1 NAME
  
  Sub::Quote - efficient generation of subroutines via string eval
  
  =head1 SYNOPSIS
  
   package Silly;
  
   use Sub::Quote qw(quote_sub unquote_sub quoted_from_sub);
  
   quote_sub 'Silly::kitty', q{ print "meow" };
  
   quote_sub 'Silly::doggy', q{ print "woof" };
  
   my $sound = 0;
  
   quote_sub 'Silly::dagron',
     q{ print ++$sound % 2 ? 'burninate' : 'roar' },
     { '$sound' => \$sound };
  
  And elsewhere:
  
   Silly->kitty;  # meow
   Silly->doggy;  # woof
   Silly->dagron; # burninate
   Silly->dagron; # roar
   Silly->dagron; # burninate
  
  =head1 DESCRIPTION
  
  This package provides performant ways to generate subroutines from strings.
  
  =head1 SUBROUTINES
  
  =head2 quote_sub
  
   my $coderef = quote_sub 'Foo::bar', q{ print $x++ . "\n" }, { '$x' => \0 };
  
  Arguments: ?$name, $code, ?\%captures, ?\%options
  
  C<$name> is the subroutine where the coderef will be installed.
  
  C<$code> is a string that will be turned into code.
  
  C<\%captures> is a hashref of variables that will be made available to the
  code.  The keys should be the full name of the variable to be made available,
  including the sigil.  The values should be references to the values.  The
  variables will contain copies of the values.  See the L</SYNOPSIS>'s
  C<Silly::dagron> for an example using captures.
  
  =head3 options
  
  =over 2
  
  =item * no_install
  
  B<Boolean>.  Set this option to not install the generated coderef into the
  passed subroutine name on undefer.
  
  =back
  
  =head2 unquote_sub
  
   my $coderef = unquote_sub $sub;
  
  Forcibly replace subroutine with actual code.
  
  If $sub is not a quoted sub, this is a no-op.
  
  =head2 quoted_from_sub
  
   my $data = quoted_from_sub $sub;
  
   my ($name, $code, $captures, $compiled_sub) = @$data;
  
  Returns original arguments to quote_sub, plus the compiled version if this
  sub has already been unquoted.
  
  Note that $sub can be either the original quoted version or the compiled
  version for convenience.
  
  =head2 inlinify
  
   my $prelude = capture_unroll '$captures', {
     '$x' => 1,
     '$y' => 2,
   };
  
   my $inlined_code = inlinify q{
     my ($x, $y) = @_;
  
     print $x + $y . "\n";
   }, '$x, $y', $prelude;
  
  Takes a string of code, a string of arguments, a string of code which acts as a
  "prelude", and a B<Boolean> representing whether or not to localize the
  arguments.
  
  =head2 capture_unroll
  
   my $prelude = capture_unroll '$captures', {
     '$x' => 1,
     '$y' => 2,
   }, 4;
  
  Arguments: $from, \%captures, $indent
  
  Generates a snippet of code which is suitable to be used as a prelude for
  L</inlinify>.  C<$from> is a string will be used as a hashref in the resulting
  code.  The keys of C<%captures> are the names of the variables and the values
  are ignored.  C<$indent> is the number of spaces to indent the result by.
  
  =head1 CAVEATS
  
  Much of this is just string-based code-generation, and as a result, a few caveats
  apply.
  
  =head2 return
  
  Calling C<return> from a quote_sub'ed sub will not likely do what you intend.
  Instead of returning from the code you defined in C<quote_sub>, it will return
  from the overall function it is composited into.
  
  So when you pass in:
  
     quote_sub q{  return 1 if $condition; $morecode }
  
  It might turn up in the intended context as follows:
  
    sub foo {
  
      <important code a>
      do {
        return 1 if $condition;
        $morecode
      };
      <important code b>
  
    }
  
  Which will obviously return from foo, when all you meant to do was return from
  the code context in quote_sub and proceed with running important code b.
  
  =head2 pragmas
  
  C<Sub::Quote> preserves the environment of the code creating the
  quoted subs.  This includes the package, strict, warnings, and any
  other lexical pragmas.  This is done by prefixing the code with a
  block that sets up a matching environment.  When inlining C<Sub::Quote>
  subs, care should be taken that user pragmas won't effect the rest
  of the code.
  
  =head1 SUPPORT
  
  See L<Moo> for support and contact information.
  
  =head1 AUTHORS
  
  See L<Moo> for authors.
  
  =head1 COPYRIGHT AND LICENSE
  
  See L<Moo> for the copyright and license.
  
  =cut
SUB_QUOTE

$fatpacked{"Text/CSV.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'TEXT_CSV';
  package Text::CSV;
  
  
  use strict;
  use Carp ();
  use vars qw( $VERSION $DEBUG );
  
  BEGIN {
      $VERSION = '1.32';
      $DEBUG   = 0;
  }
  
  # if use CSV_XS, requires version
  my $Module_XS  = 'Text::CSV_XS';
  my $Module_PP  = 'Text::CSV_PP';
  my $XS_Version = '0.99';
  
  my $Is_Dynamic = 0;
  
  # used in _load_xs and _load_pp
  my $Install_Dont_Die = 1; # When _load_xs fails to load XS, don't die.
  my $Install_Only     = 2; # Don't call _set_methods()
  
  
  my @PublicMethods = qw/
      version types quote_char escape_char sep_char eol always_quote binary allow_whitespace
      keep_meta_info allow_loose_quotes allow_loose_escapes verbatim meta_info is_quoted is_binary eof
      getline print parse combine fields string error_diag error_input status blank_is_undef empty_is_undef
      getline_hr column_names bind_columns auto_diag quote_space quote_null getline_all getline_hr_all
      is_missing quote_binary record_number print_hr
      PV IV NV
  /;
  #
  my @UndocumentedXSMethods = qw/Combine Parse SetDiag/;
  
  my @UndocumentedPPMethods = qw//; # Currently empty
  
  
  # Check the environment variable to decide worker module. 
  
  unless ($Text::CSV::Worker) {
      $Text::CSV::DEBUG and  Carp::carp("Check used worker module...");
  
      if ( exists $ENV{PERL_TEXT_CSV} ) {
          if ($ENV{PERL_TEXT_CSV} eq '0' or $ENV{PERL_TEXT_CSV} eq 'Text::CSV_PP') {
              _load_pp();
          }
          elsif ($ENV{PERL_TEXT_CSV} eq '1' or $ENV{PERL_TEXT_CSV} =~ /Text::CSV_XS\s*,\s*Text::CSV_PP/) {
              _load_xs($Install_Dont_Die) or _load_pp();
          }
          elsif ($ENV{PERL_TEXT_CSV} eq '2' or $ENV{PERL_TEXT_CSV} eq 'Text::CSV_XS') {
              _load_xs();
          }
          else {
              Carp::croak "The value of environmental variable 'PERL_TEXT_CSV' is invalid.";
          }
      }
      else {
          _load_xs($Install_Dont_Die) or _load_pp();
      }
  
  }
  
  
  
  sub import {
      my ($class, $option) = @_;
  }
  
  
  
  sub new { # normal mode
      my $proto = shift;
      my $class = ref($proto) || $proto;
  
      unless ( $proto ) { # for Text::CSV_XS/PP::new(0);
          return eval qq| $Text::CSV::Worker\::new( \$proto ) |;
      }
  
      #if (ref $_[0] and $_[0]->{module}) {
      #    Carp::croak("Can't set 'module' in non dynamic mode.");
      #}
  
      if ( my $obj = $Text::CSV::Worker->new(@_) ) {
          $obj->{_MODULE} = $Text::CSV::Worker;
          bless $obj, $class;
          return $obj;
      }
      else {
          return;
      }
  
  
  }
  
  
  sub require_xs_version { $XS_Version; }
  
  
  sub module {
      my $proto = shift;
      return   !ref($proto)            ? $Text::CSV::Worker
             :  ref($proto->{_MODULE}) ? ref($proto->{_MODULE}) : $proto->{_MODULE};
  }
  
  *backend = *module;
  
  
  sub is_xs {
      return $_[0]->module eq $Module_XS;
  }
  
  
  sub is_pp {
      return $_[0]->module eq $Module_PP;
  }
  
  
  sub is_dynamic { $Is_Dynamic; }
  
  
  sub AUTOLOAD {
      my $self = $_[0];
      my $attr = $Text::CSV::AUTOLOAD;
      $attr =~ s/.*:://;
  
      return if $attr =~ /^[A-Z]+$/;
      Carp::croak( "Can't locate method $attr" ) unless $attr =~ /^_/;
  
      my $pkg = $Text::CSV::Worker;
  
      my $method = "$pkg\::$attr";
  
      $Text::CSV::DEBUG and Carp::carp("'$attr' is private method, so try to autoload...");
  
      local $^W;
      no strict qw(refs);
  
      *{"Text::CSV::$attr"} = *{"$pkg\::$attr"};
  
      goto &$attr;
  }
  
  
  
  sub _load_xs {
      my $opt = shift;
  
      $Text::CSV::DEBUG and Carp::carp "Load $Module_XS.";
  
      eval qq| use $Module_XS $XS_Version |;
  
      if ($@) {
          if (defined $opt and $opt & $Install_Dont_Die) {
              $Text::CSV::DEBUG and Carp::carp "Can't load $Module_XS...($@)";
              return 0;
          }
          Carp::croak $@;
      }
  
      push @Text::CSV::ISA, 'Text::CSV_XS';
  
      unless (defined $opt and $opt & $Install_Only) {
          _set_methods( $Text::CSV::Worker = $Module_XS );
      }
  
      return 1;
  };
  
  
  sub _load_pp {
      my $opt = shift;
  
      $Text::CSV::DEBUG and Carp::carp "Load $Module_PP.";
  
      eval qq| require $Module_PP |;
      if ($@) {
          Carp::croak $@;
      }
  
      push @Text::CSV::ISA, 'Text::CSV_PP';
  
      unless (defined $opt and $opt & $Install_Only) {
          _set_methods( $Text::CSV::Worker = $Module_PP );
      }
  };
  
  
  
  
  sub _set_methods {
      my $class = shift;
  
      #return;
  
      local $^W;
      no strict qw(refs);
  
      for my $method (@PublicMethods) {
          *{"Text::CSV::$method"} = \&{"$class\::$method"};
      }
  
      if ($Text::CSV::Worker eq $Module_XS) {
          for my $method (@UndocumentedXSMethods) {
              *{"Text::CSV::$method"} = \&{"$Module_XS\::$method"};
          }
      }
  
      if ($Text::CSV::Worker eq $Module_PP) {
          for my $method (@UndocumentedPPMethods) {
              *{"Text::CSV::$method"} = \&{"$Module_PP\::$method"};
          }
      }
  
  }
  
  
  
  1;
  __END__
  
  =pod
  
  =head1 NAME
  
  Text::CSV - comma-separated values manipulator (using XS or PurePerl)
  
  
  =head1 SYNOPSIS
  
   use Text::CSV;
  
   my @rows;
   my $csv = Text::CSV->new ( { binary => 1 } )  # should set binary attribute.
                   or die "Cannot use CSV: ".Text::CSV->error_diag ();
   
   open my $fh, "<:encoding(utf8)", "test.csv" or die "test.csv: $!";
   while ( my $row = $csv->getline( $fh ) ) {
       $row->[2] =~ m/pattern/ or next; # 3rd field should match
       push @rows, $row;
   }
   $csv->eof or $csv->error_diag();
   close $fh;
  
   $csv->eol ("\r\n");
   
   open $fh, ">:encoding(utf8)", "new.csv" or die "new.csv: $!";
   $csv->print ($fh, $_) for @rows;
   close $fh or die "new.csv: $!";
   
   #
   # parse and combine style
   #
   
   $status = $csv->combine(@columns);    # combine columns into a string
   $line   = $csv->string();             # get the combined string
   
   $status  = $csv->parse($line);        # parse a CSV string into fields
   @columns = $csv->fields();            # get the parsed fields
   
   $status       = $csv->status ();      # get the most recent status
   $bad_argument = $csv->error_input (); # get the most recent bad argument
   $diag         = $csv->error_diag ();  # if an error occured, explains WHY
   
   $status = $csv->print ($io, $colref); # Write an array of fields
                                         # immediately to a file $io
   $colref = $csv->getline ($io);        # Read a line from file $io,
                                         # parse it and return an array
                                         # ref of fields
   $csv->column_names (@names);          # Set column names for getline_hr ()
   $ref = $csv->getline_hr ($io);        # getline (), but returns a hashref
   $eof = $csv->eof ();                  # Indicate if last parse or
                                         # getline () hit End Of File
   
   $csv->types(\@t_array);               # Set column types
  
  =head1 DESCRIPTION
  
  Text::CSV provides facilities for the composition and decomposition of
  comma-separated values using L<Text::CSV_XS> or its pure Perl version.
  
  An instance of the Text::CSV class can combine fields into a CSV string
  and parse a CSV string into fields.
  
  The module accepts either strings or files as input and can utilize any
  user-specified characters as delimiters, separators, and escapes so it is
  perhaps better called ASV (anything separated values) rather than just CSV.
  
  =head1 VERSION
  
      1.32
  
  This module is compatible with Text::CSV_XS B<0.99> and later.
  (except for diag_verbose and allow_unquoted_escape)
  
  =head2 Embedded newlines
  
  B<Important Note>: The default behavior is to only accept ASCII characters.
  This means that fields can not contain newlines. If your data contains
  newlines embedded in fields, or characters above 0x7e (tilde), or binary data,
  you *must* set C<< binary => 1 >> in the call to C<new ()>.  To cover the widest
  range of parsing options, you will always want to set binary.
  
  But you still have the problem that you have to pass a correct line to the
  C<parse ()> method, which is more complicated from the usual point of
  usage:
  
   my $csv = Text::CSV->new ({ binary => 1, eol => $/ });
   while (<>) {		#  WRONG!
       $csv->parse ($_);
       my @fields = $csv->fields ();
  
  will break, as the while might read broken lines, as that does not care
  about the quoting. If you need to support embedded newlines, the way to go
  is either
  
   my $csv = Text::CSV->new ({ binary => 1, eol => $/ });
   while (my $row = $csv->getline (*ARGV)) {
       my @fields = @$row;
  
  or, more safely in perl 5.6 and up
  
   my $csv = Text::CSV->new ({ binary => 1, eol => $/ });
   open my $io, "<", $file or die "$file: $!";
   while (my $row = $csv->getline ($io)) {
       my @fields = @$row;
  
  =head2 Unicode (UTF8)
  
  On parsing (both for C<getline ()> and C<parse ()>), if the source is
  marked being UTF8, then all fields that are marked binary will also be
  be marked UTF8.
  
  For complete control over encoding, please use L<Text::CSV::Encoded>:
  
      use Text::CSV::Encoded;
      my $csv = Text::CSV::Encoded->new ({
          encoding_in  => "iso-8859-1", # the encoding comes into   Perl
          encoding_out => "cp1252",     # the encoding comes out of Perl
      });
  
      $csv = Text::CSV::Encoded->new ({ encoding  => "utf8" });
      # combine () and print () accept *literally* utf8 encoded data
      # parse () and getline () return *literally* utf8 encoded data
  
      $csv = Text::CSV::Encoded->new ({ encoding  => undef }); # default
      # combine () and print () accept UTF8 marked data
      # parse () and getline () return UTF8 marked data
  
  On combining (C<print ()> and C<combine ()>), if any of the combining
  fields was marked UTF8, the resulting string will be marked UTF8.
  
  Note however if the backend module is Text::CSV_XS,
  that all fields C<before> the first field that was marked UTF8
  and contained 8-bit characters that were not upgraded to UTF8, these
  will be bytes in the resulting string too, causing errors. If you pass
  data of different encoding, or you don't know if there is different
  encoding, force it to be upgraded before you pass them on:
  
      # backend = Text::CSV_XS
      $csv->print ($fh, [ map { utf8::upgrade (my $x = $_); $x } @data ]);
  
  =head1 SPECIFICATION
  
  See to L<Text::CSV_XS/SPECIFICATION>.
  
  =head1 FUNCTIONS
  
  These methods are common between XS and puer Perl version.
  Most of the document was shamelessly copied and replaced from Text::CSV_XS.
  
  =head2 version ()
  
  (Class method) Returns the current backend module version.
  If you want the module version, you can use the C<VERSION> method,
  
   print Text::CSV->VERSION;      # This module version
   print Text::CSV->version;      # The version of the worker module
                                  # same as Text::CSV->backend->version
  
  =head2 new (\%attr)
  
  (Class method) Returns a new instance of Text::CSV_XS. The objects
  attributes are described by the (optional) hash ref C<\%attr>.
  Currently the following attributes are available:
  
  =over 4
  
  =item eol
  
  An end-of-line string to add to rows. C<undef> is replaced with an
  empty string. The default is C<$\>. Common values for C<eol> are
  C<"\012"> (Line Feed) or C<"\015\012"> (Carriage Return, Line Feed).
  Cannot be longer than 7 (ASCII) characters.
  
  If both C<$/> and C<eol> equal C<"\015">, parsing lines that end on
  only a Carriage Return without Line Feed, will be C<parse>d correct.
  Line endings, whether in C<$/> or C<eol>, other than C<undef>,
  C<"\n">, C<"\r\n">, or C<"\r"> are not (yet) supported for parsing.
  
  =item sep_char
  
  The char used for separating fields, by default a comma. (C<,>).
  Limited to a single-byte character, usually in the range from 0x20
  (space) to 0x7e (tilde).
  
  The separation character can not be equal to the quote character.
  The separation character can not be equal to the escape character.
  
  See also L<Text::CSV_XS/CAVEATS>
  
  =item allow_whitespace
  
  When this option is set to true, whitespace (TAB's and SPACE's)
  surrounding the separation character is removed when parsing. If
  either TAB or SPACE is one of the three major characters C<sep_char>,
  C<quote_char>, or C<escape_char> it will not be considered whitespace.
  
  So lines like:
  
    1 , "foo" , bar , 3 , zapp
  
  are now correctly parsed, even though it violates the CSV specs.
  
  Note that B<all> whitespace is stripped from start and end of each
  field. That would make it more a I<feature> than a way to be able
  to parse bad CSV lines, as
  
   1,   2.0,  3,   ape  , monkey
  
  will now be parsed as
  
   ("1", "2.0", "3", "ape", "monkey")
  
  even if the original line was perfectly sane CSV.
  
  =item blank_is_undef
  
  Under normal circumstances, CSV data makes no distinction between
  quoted- and unquoted empty fields. They both end up in an empty
  string field once read, so
  
   1,"",," ",2
  
  is read as
  
   ("1", "", "", " ", "2")
  
  When I<writing> CSV files with C<always_quote> set, the unquoted empty
  field is the result of an undefined value. To make it possible to also
  make this distinction when reading CSV data, the C<blank_is_undef> option
  will cause unquoted empty fields to be set to undef, causing the above to
  be parsed as
  
   ("1", "", undef, " ", "2")
  
  =item empty_is_undef
  
  Going one step further than C<blank_is_undef>, this attribute converts
  all empty fields to undef, so
  
   1,"",," ",2
  
  is read as
  
   (1, undef, undef, " ", 2)
  
  Note that this only effects fields that are I<really> empty, not fields
  that are empty after stripping allowed whitespace. YMMV.
  
  =item quote_char
  
  The char used for quoting fields containing blanks, by default the
  double quote character (C<">). A value of undef suppresses
  quote chars. (For simple cases only).
  Limited to a single-byte character, usually in the range from 0x20
  (space) to 0x7e (tilde).
  
  The quote character can not be equal to the separation character.
  
  =item allow_loose_quotes
  
  By default, parsing fields that have C<quote_char> characters inside
  an unquoted field, like
  
   1,foo "bar" baz,42
  
  would result in a parse error. Though it is still bad practice to
  allow this format, we cannot help there are some vendors that make
  their applications spit out lines styled like this.
  
  In case there is B<really> bad CSV data, like
  
   1,"foo "bar" baz",42
  
  or
  
   1,""foo bar baz"",42
  
  there is a way to get that parsed, and leave the quotes inside the quoted
  field as-is. This can be achieved by setting C<allow_loose_quotes> B<AND>
  making sure that the C<escape_char> is I<not> equal to C<quote_char>.
  
  =item escape_char
  
  The character used for escaping certain characters inside quoted fields.
  Limited to a single-byte character, usually in the range from 0x20
  (space) to 0x7e (tilde).
  
  The C<escape_char> defaults to being the literal double-quote mark (C<">)
  in other words, the same as the default C<quote_char>. This means that
  doubling the quote mark in a field escapes it:
  
    "foo","bar","Escape ""quote mark"" with two ""quote marks""","baz"
  
  If you change the default quote_char without changing the default
  escape_char, the escape_char will still be the quote mark.  If instead
  you want to escape the quote_char by doubling it, you will need to change
  the escape_char to be the same as what you changed the quote_char to.
  
  The escape character can not be equal to the separation character.
  
  =item allow_loose_escapes
  
  By default, parsing fields that have C<escape_char> characters that
  escape characters that do not need to be escaped, like:
  
   my $csv = Text::CSV->new ({ escape_char => "\\" });
   $csv->parse (qq{1,"my bar\'s",baz,42});
  
  would result in a parse error. Though it is still bad practice to
  allow this format, this option enables you to treat all escape character
  sequences equal.
  
  =item binary
  
  If this attribute is TRUE, you may use binary characters in quoted fields,
  including line feeds, carriage returns and NULL bytes. (The latter must
  be escaped as C<"0>.) By default this feature is off.
  
  If a string is marked UTF8, binary will be turned on automatically when
  binary characters other than CR or NL are encountered. Note that a simple
  string like C<"\x{00a0}"> might still be binary, but not marked UTF8, so
  setting C<{ binary =E<gt> 1 }> is still a wise option.
  
  =item types
  
  A set of column types; this attribute is immediately passed to the
  I<types> method below. You must not set this attribute otherwise,
  except for using the I<types> method. For details see the description
  of the I<types> method below.
  
  =item always_quote
  
  By default the generated fields are quoted only, if they need to, for
  example, if they contain the separator. If you set this attribute to
  a TRUE value, then all defined fields will be quoted. This is typically
  easier to handle in external applications.
  
  =item quote_space
  
  By default, a space in a field would trigger quotation. As no rule
  exists this to be forced in CSV, nor any for the opposite, the default
  is true for safety. You can exclude the space from this trigger by
  setting this option to 0.
  
  =item quote_null
  
  By default, a NULL byte in a field would be escaped. This attribute
  enables you to treat the NULL byte as a simple binary character in
  binary mode (the C<{ binary =E<gt> 1 }> is set). The default is true.
  You can prevent NULL escapes by setting this attribute to 0.
  
  =item quote_binary
  
  By default,  all "unsafe" bytes inside a string cause the combined field to
  be quoted. By setting this attribute to 0, you can disable that trigger for
  bytes >= 0x7f.
  
  =item keep_meta_info
  
  By default, the parsing of input lines is as simple and fast as
  possible. However, some parsing information - like quotation of
  the original field - is lost in that process. Set this flag to
  true to be able to retrieve that information after parsing with
  the methods C<meta_info ()>, C<is_quoted ()>, and C<is_binary ()>
  described below.  Default is false.
  
  =item verbatim
  
  This is a quite controversial attribute to set, but it makes hard
  things possible.
  
  The basic thought behind this is to tell the parser that the normally
  special characters newline (NL) and Carriage Return (CR) will not be
  special when this flag is set, and be dealt with as being ordinary
  binary characters. This will ease working with data with embedded
  newlines.
  
  When C<verbatim> is used with C<getline ()>, C<getline ()>
  auto-chomp's every line.
  
  Imagine a file format like
  
    M^^Hans^Janssen^Klas 2\n2A^Ja^11-06-2007#\r\n
  
  where, the line ending is a very specific "#\r\n", and the sep_char
  is a ^ (caret). None of the fields is quoted, but embedded binary
  data is likely to be present. With the specific line ending, that
  shouldn not be too hard to detect.
  
  By default, Text::CSV' parse function however is instructed to only
  know about "\n" and "\r" to be legal line endings, and so has to deal
  with the embedded newline as a real end-of-line, so it can scan the next
  line if binary is true, and the newline is inside a quoted field.
  With this attribute however, we can tell parse () to parse the line
  as if \n is just nothing more than a binary character.
  
  For parse () this means that the parser has no idea about line ending
  anymore, and getline () chomps line endings on reading.
  
  =item auto_diag
  
  Set to true will cause C<error_diag ()> to be automatically be called
  in void context upon errors.
  
  If set to a value greater than 1, it will die on errors instead of
  warn.
  
  To check future plans and a difference in XS version,
  please see to L<Text::CSV_XS/auto_diag>.
  
  =back
  
  To sum it up,
  
   $csv = Text::CSV->new ();
  
  is equivalent to
  
   $csv = Text::CSV->new ({
       quote_char          => '"',
       escape_char         => '"',
       sep_char            => ',',
       eol                 => $\,
       always_quote        => 0,
       quote_space         => 1,
       quote_null          => 1,
       binary              => 0,
       keep_meta_info      => 0,
       allow_loose_quotes  => 0,
       allow_loose_escapes => 0,
       allow_whitespace    => 0,
       blank_is_undef      => 0,
       empty_is_undef      => 0,
       verbatim            => 0,
       auto_diag           => 0,
       });
  
  For all of the above mentioned flags, there is an accessor method
  available where you can inquire for the current value, or change
  the value
  
   my $quote = $csv->quote_char;
   $csv->binary (1);
  
  It is unwise to change these settings halfway through writing CSV
  data to a stream. If however, you want to create a new stream using
  the available CSV object, there is no harm in changing them.
  
  If the C<new ()> constructor call fails, it returns C<undef>, and makes
  the fail reason available through the C<error_diag ()> method.
  
   $csv = Text::CSV->new ({ ecs_char => 1 }) or
       die "" . Text::CSV->error_diag ();
  
  C<error_diag ()> will return a string like
  
   "INI - Unknown attribute 'ecs_char'"
  
  =head2 print
  
   $status = $csv->print ($io, $colref);
  
  Similar to C<combine () + string () + print>, but more efficient. It
  expects an array ref as input (not an array!) and the resulting string is
  not really created (XS version), but immediately written to the I<$io> object, typically
  an IO handle or any other object that offers a I<print> method. Note, this
  implies that the following is wrong in perl 5.005_xx and older:
  
   open FILE, ">", "whatever";
   $status = $csv->print (\*FILE, $colref);
  
  as in perl 5.005 and older, the glob C<\*FILE> is not an object, thus it
  does not have a print method. The solution is to use an IO::File object or
  to hide the glob behind an IO::Wrap object. See L<IO::File> and L<IO::Wrap>
  for details.
  
  For performance reasons the print method doesn't create a result string.
  (If its backend is PP version, result strings are created internally.)
  In particular the I<$csv-E<gt>string ()>, I<$csv-E<gt>status ()>,
  I<$csv->fields ()> and I<$csv-E<gt>error_input ()> methods are meaningless
  after executing this method.
  
  =head2 combine
  
   $status = $csv->combine (@columns);
  
  This object function constructs a CSV string from the arguments, returning
  success or failure.  Failure can result from lack of arguments or an argument
  containing an invalid character.  Upon success, C<string ()> can be called to
  retrieve the resultant CSV string.  Upon failure, the value returned by
  C<string ()> is undefined and C<error_input ()> can be called to retrieve an
  invalid argument.
  
  =head2 string
  
   $line = $csv->string ();
  
  This object function returns the input to C<parse ()> or the resultant CSV
  string of C<combine ()>, whichever was called more recently.
  
  =head2 getline
  
   $colref = $csv->getline ($io);
  
  This is the counterpart to print, like parse is the counterpart to
  combine: It reads a row from the IO object $io using $io->getline ()
  and parses this row into an array ref. This array ref is returned
  by the function or undef for failure.
  
  When fields are bound with C<bind_columns ()>, the return value is a
  reference to an empty list.
  
  The I<$csv-E<gt>string ()>, I<$csv-E<gt>fields ()> and I<$csv-E<gt>status ()>
  methods are meaningless, again.
  
  =head2 getline_all
  
   $arrayref = $csv->getline_all ($io);
   $arrayref = $csv->getline_all ($io, $offset);
   $arrayref = $csv->getline_all ($io, $offset, $length);
  
  This will return a reference to a list of C<getline ($io)> results.
  In this call, C<keep_meta_info> is disabled. If C<$offset> is negative,
  as with C<splice ()>, only the last C<abs ($offset)> records of C<$io>
  are taken into consideration.
  
  Given a CSV file with 10 lines:
  
   lines call
   ----- ---------------------------------------------------------
   0..9  $csv->getline_all ($io)         # all
   0..9  $csv->getline_all ($io,  0)     # all
   8..9  $csv->getline_all ($io,  8)     # start at 8
   -     $csv->getline_all ($io,  0,  0) # start at 0 first 0 rows
   0..4  $csv->getline_all ($io,  0,  5) # start at 0 first 5 rows
   4..5  $csv->getline_all ($io,  4,  2) # start at 4 first 2 rows
   8..9  $csv->getline_all ($io, -2)     # last 2 rows
   6..7  $csv->getline_all ($io, -4,  2) # first 2 of last  4 rows
  
  =head2 parse
  
   $status = $csv->parse ($line);
  
  This object function decomposes a CSV string into fields, returning
  success or failure.  Failure can result from a lack of argument or the
  given CSV string is improperly formatted.  Upon success, C<fields ()> can
  be called to retrieve the decomposed fields .  Upon failure, the value
  returned by C<fields ()> is undefined and C<error_input ()> can be called
  to retrieve the invalid argument.
  
  You may use the I<types ()> method for setting column types. See the
  description below.
  
  =head2 getline_hr
  
  The C<getline_hr ()> and C<column_names ()> methods work together to allow
  you to have rows returned as hashrefs. You must call C<column_names ()>
  first to declare your column names.
  
   $csv->column_names (qw( code name price description ));
   $hr = $csv->getline_hr ($io);
   print "Price for $hr->{name} is $hr->{price} EUR\n";
  
  C<getline_hr ()> will croak if called before C<column_names ()>.
  
  =head2 getline_hr_all
  
   $arrayref = $csv->getline_hr_all ($io);
   $arrayref = $csv->getline_hr_all ($io, $offset);
   $arrayref = $csv->getline_hr_all ($io, $offset, $length);
  
  This will return a reference to a list of C<getline_hr ($io)> results.
  In this call, C<keep_meta_info> is disabled.
  
  =head2 column_names
  
  Set the keys that will be used in the C<getline_hr ()> calls. If no keys
  (column names) are passed, it'll return the current setting.
  
  C<column_names ()> accepts a list of scalars (the column names) or a
  single array_ref, so you can pass C<getline ()>
  
    $csv->column_names ($csv->getline ($io));
  
  C<column_names ()> does B<no> checking on duplicates at all, which might
  lead to unwanted results. Undefined entries will be replaced with the
  string C<"\cAUNDEF\cA">, so
  
    $csv->column_names (undef, "", "name", "name");
    $hr = $csv->getline_hr ($io);
  
  Will set C<$hr->{"\cAUNDEF\cA"}> to the 1st field, C<$hr->{""}> to the
  2nd field, and C<$hr->{name}> to the 4th field, discarding the 3rd field.
  
  C<column_names ()> croaks on invalid arguments.
  
  =head2 bind_columns
  
  Takes a list of references to scalars to store the fields fetched
  C<getline ()> in. When you don't pass enough references to store the
  fetched fields in, C<getline ()> will fail. If you pass more than there are
  fields to return, the remaining references are left untouched.
  
    $csv->bind_columns (\$code, \$name, \$price, \$description);
    while ($csv->getline ($io)) {
        print "The price of a $name is \x{20ac} $price\n";
        }
  
  =head2 eof
  
   $eof = $csv->eof ();
  
  If C<parse ()> or C<getline ()> was used with an IO stream, this
  method will return true (1) if the last call hit end of file, otherwise
  it will return false (''). This is useful to see the difference between
  a failure and end of file.
  
  =head2 types
  
   $csv->types (\@tref);
  
  This method is used to force that columns are of a given type. For
  example, if you have an integer column, two double columns and a
  string column, then you might do a
  
   $csv->types ([Text::CSV::IV (),
                 Text::CSV::NV (),
                 Text::CSV::NV (),
                 Text::CSV::PV ()]);
  
  Column types are used only for decoding columns, in other words
  by the I<parse ()> and I<getline ()> methods.
  
  You can unset column types by doing a
  
   $csv->types (undef);
  
  or fetch the current type settings with
  
   $types = $csv->types ();
  
  =over 4
  
  =item IV
  
  Set field type to integer.
  
  =item NV
  
  Set field type to numeric/float.
  
  =item PV
  
  Set field type to string.
  
  =back
  
  =head2 fields
  
   @columns = $csv->fields ();
  
  This object function returns the input to C<combine ()> or the resultant
  decomposed fields of C successful <parse ()>, whichever was called more
  recently.
  
  Note that the return value is undefined after using C<getline ()>, which
  does not fill the data structures returned by C<parse ()>.
  
  =head2 meta_info
  
   @flags = $csv->meta_info ();
  
  This object function returns the flags of the input to C<combine ()> or
  the flags of the resultant decomposed fields of C<parse ()>, whichever
  was called more recently.
  
  For each field, a meta_info field will hold flags that tell something about
  the field returned by the C<fields ()> method or passed to the C<combine ()>
  method. The flags are bit-wise-or'd like:
  
  =over 4
  
  =item 0x0001
  
  The field was quoted.
  
  =item 0x0002
  
  The field was binary.
  
  =back
  
  See the C<is_*** ()> methods below.
  
  =head2 is_quoted
  
    my $quoted = $csv->is_quoted ($column_idx);
  
  Where C<$column_idx> is the (zero-based) index of the column in the
  last result of C<parse ()>.
  
  This returns a true value if the data in the indicated column was
  enclosed in C<quote_char> quotes. This might be important for data
  where C<,20070108,> is to be treated as a numeric value, and where
  C<,"20070108",> is explicitly marked as character string data.
  
  =head2 is_binary
  
    my $binary = $csv->is_binary ($column_idx);
  
  Where C<$column_idx> is the (zero-based) index of the column in the
  last result of C<parse ()>.
  
  This returns a true value if the data in the indicated column
  contained any byte in the range [\x00-\x08,\x10-\x1F,\x7F-\xFF]
  
  =head2 is_missing
  
    my $missing = $csv->is_missing ($column_idx);
  
  Where C<$column_idx> is the (zero-based) index of the column in the last
  result of L</getline_hr>.
  
   while (my $hr = $csv->getline_hr ($fh)) {
       $csv->is_missing (0) and next; # This was an empty line
   }
  
  When using L</getline_hr> for parsing, it is impossible to tell if the
  fields are C<undef> because they where not filled in the CSV stream or
  because they were not read at all, as B<all> the fields defined by
  L</column_names> are set in the hash-ref. If you still need to know if all
  fields in each row are provided, you should enable C<keep_meta_info> so you
  can check the flags.
  
  =head2 status
  
   $status = $csv->status ();
  
  This object function returns success (or failure) of C<combine ()> or
  C<parse ()>, whichever was called more recently.
  
  =head2 error_input
  
   $bad_argument = $csv->error_input ();
  
  This object function returns the erroneous argument (if it exists) of
  C<combine ()> or C<parse ()>, whichever was called more recently.
  
  =head2 error_diag
  
   Text::CSV->error_diag ();
   $csv->error_diag ();
   $error_code   = 0  + $csv->error_diag ();
   $error_str    = "" . $csv->error_diag ();
   ($cde, $str, $pos) = $csv->error_diag ();
  
  If (and only if) an error occured, this function returns the diagnostics
  of that error.
  
  If called in void context, it will print the internal error code and the
  associated error message to STDERR.
  
  If called in list context, it will return the error code and the error
  message in that order. If the last error was from parsing, the third
  value returned is the best guess at the location within the line that was
  being parsed. It's value is 1-based.
  
  Note: C<$pos> returned by the backend Text::CSV_PP does not show
  the error point in many cases (see to the below line).
  It is for conscience's sake in using Text::CSV_PP.
  
  If called in scalar context, it will return the diagnostics in a single
  scalar, a-la $!. It will contain the error code in numeric context, and
  the diagnostics message in string context.
  
  Depending on the used worker module, returned diagnostics is diffferent.
  
  Text::CSV_XS parses csv strings by dividing one character while Text::CSV_PP
  by using the regular expressions. That difference makes the different cause
  of the failure.
  
  When called as a class method or a direct function call, the error diag
  is that of the last C<new ()> call.
  
  =head2 record_number
  
    $recno = $csv->record_number ();
  
  Returns the records parsed by this csv instance. This value should be more
  accurate than C<$.> when embedded newlines come in play. Records written by
  this instance are not counted.
  
  =head2 SetDiag
  
   $csv->SetDiag (0);
  
  Use to reset the diagnostics if you are dealing with errors.
  
  =head2 Some methods are Text::CSV only.
  
  =over
  
  =item backend
  
  Returns the backend module name called by Text::CSV.
  C<module> is an alias.
  
  
  =item is_xs
  
  Returns true value if Text::CSV or the object uses XS module as worker.
  
  =item is_pp
  
  Returns true value if Text::CSV or the object uses pure-Perl module as worker.
  
  
  =back
  
  
  =head1 DIAGNOSTICS
  
  If an error occured, $csv->error_diag () can be used to get more information
  on the cause of the failure. Note that for speed reasons, the internal value
  is never cleared on success, so using the value returned by error_diag () in
  normal cases - when no error occured - may cause unexpected results.
  
  This function changes depending on the used module (XS or PurePerl).
  
  See to L<Text::CSV_XS/DIAGNOSTICS> and L<Text::CSV_PP/DIAGNOSTICS>.
  
  
  
  =head2 HISTORY AND WORKER MODULES
  
  This module, L<Text::CSV> was firstly written by Alan Citterman which could deal with
  B<only ascii characters>. Then, Jochen Wiedmann wrote L<Text::CSV_XS> which has
  the B<binary mode>. This XS version is maintained by H.Merijn Brand and L<Text::CSV_PP>
  written by Makamaka was pure-Perl version of Text::CSV_XS.
  
  Now, Text::CSV was rewritten by Makamaka and become a wrapper to Text::CSV_XS or Text::CSV_PP.
  Text::CSV_PP will be bundled in this distribution.
  
  When you use Text::CSV, it calls a backend worker module - L<Text::CSV_XS> or L<Text::CSV_PP>.
  By default, Text::CSV tries to use Text::CSV_XS which must be complied and installed properly.
  If this call is fail, Text::CSV uses L<Text::CSV_PP>.
  
  The required Text::CSV_XS version is I<0.41> in Text::CSV version 1.03.
  
  If you set an enviornment variable C<PERL_TEXT_CSV>, The calling action will be changed.
  
  =over
  
  =item PERL_TEXT_CSV = 0
  
  =item PERL_TEXT_CSV = 'Text::CSV_PP'
  
  Always use Text::CSV_PP
  
  =item PERL_TEXT_CSV = 1
  
  =item PERL_TEXT_CSV = 'Text::CSV_XS,Text::CSV_PP'
  
  (The default) Use compiled Text::CSV_XS if it is properly compiled & installed,
  otherwise use Text::CSV_PP
  
  =item PERL_TEXT_CSV = 2
  
  =item PERL_TEXT_CSV = 'Text::CSV_XS'
  
  Always use compiled Text::CSV_XS, die if it isn't properly compiled & installed.
  
  =back
  
  These ideas come from L<DBI::PurePerl> mechanism.
  
  example:
  
    BEGIN { $ENV{PERL_TEXT_CSV} = 0 }
    use Text::CSV; # always uses Text::CSV_PP
  
  
  In future, it may be able to specify another module.
  
  =head1 TODO
  
  =over
  
  =item Wrapper mechanism
  
  Currently the wrapper mechanism is to change symbolic table for speed.
  
   for my $method (@PublicMethods) {
       *{"Text::CSV::$method"} = \&{"$class\::$method"};
   }
  
  But how about it - calling worker module object?
  
   sub parse {
       my $self = shift;
       $self->{_WORKER_OBJECT}->parse(@_); # XS or PP CSV object
   }
  
  
  =back
  
  See to L<Text::CSV_XS/TODO> and L<Text::CSV_PP/TODO>.
  
  
  =head1 SEE ALSO
  
  L<Text::CSV_PP>, L<Text::CSV_XS> and L<Text::CSV::Encoded>.
  
  
  =head1 AUTHORS and MAINTAINERS
  
  Alan Citterman F<E<lt>alan[at]mfgrtl.comE<gt>> wrote the original Perl
  module. Please don't send mail concerning Text::CSV to Alan, as
  he's not a present maintainer.
  
  Jochen Wiedmann F<E<lt>joe[at]ispsoft.deE<gt>> rewrote the encoding and
  decoding in C by implementing a simple finite-state machine and added
  the variable quote, escape and separator characters, the binary mode
  and the print and getline methods. See ChangeLog releases 0.10 through
  0.23.
  
  H.Merijn Brand F<E<lt>h.m.brand[at]xs4all.nlE<gt>> cleaned up the code,
  added the field flags methods, wrote the major part of the test suite,
  completed the documentation, fixed some RT bugs. See ChangeLog releases
  0.25 and on.
  
  Makamaka Hannyaharamitu, E<lt>makamaka[at]cpan.orgE<gt> wrote Text::CSV_PP
  which is the pure-Perl version of Text::CSV_XS.
  
  New Text::CSV (since 0.99) is maintained by Makamaka.
  
  
  =head1 COPYRIGHT AND LICENSE
  
  Text::CSV
  
  Copyright (C) 1997 Alan Citterman. All rights reserved.
  Copyright (C) 2007-2009 Makamaka Hannyaharamitu.
  
  
  Text::CSV_PP:
  
  Copyright (C) 2005-2013 Makamaka Hannyaharamitu.
  
  
  Text:CSV_XS:
  
  Copyright (C) 2007-2013 H.Merijn Brand for PROCURA B.V.
  Copyright (C) 1998-2001 Jochen Wiedmann. All rights reserved.
  Portions Copyright (C) 1997 Alan Citterman. All rights reserved.
  
  
  This library is free software; you can redistribute it and/or modify
  it under the same terms as Perl itself. 
  
  =cut
TEXT_CSV

$fatpacked{"Text/CSV_PP.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'TEXT_CSV_PP';
  package Text::CSV_PP;
  
  ################################################################################
  #
  # Text::CSV_PP - Text::CSV_XS compatible pure-Perl module
  #
  ################################################################################
  require 5.005;
  
  use strict;
  use vars qw($VERSION);
  use Carp ();
  
  $VERSION = '1.31';
  
  sub PV  { 0 }
  sub IV  { 1 }
  sub NV  { 2 }
  
  sub IS_QUOTED () { 0x0001; }
  sub IS_BINARY () { 0x0002; }
  sub IS_MISSING () { 0x0010; }
  
  
  my $ERRORS = {
          # PP and XS
          1000 => "INI - constructor failed",
          1001 => "sep_char is equal to quote_char or escape_char",
          1002 => "INI - allow_whitespace with escape_char or quote_char SP or TAB",
          1003 => "INI - \r or \n in main attr not allowed",
  
          2010 => "ECR - QUO char inside quotes followed by CR not part of EOL",
          2011 => "ECR - Characters after end of quoted field",
  
          2021 => "EIQ - NL char inside quotes, binary off",
          2022 => "EIQ - CR char inside quotes, binary off",
          2025 => "EIQ - Loose unescaped escape",
          2026 => "EIQ - Binary character inside quoted field, binary off",
          2027 => "EIQ - Quoted field not terminated",
  
          2030 => "EIF - NL char inside unquoted verbatim, binary off",
          2031 => "EIF - CR char is first char of field, not part of EOL",
          2032 => "EIF - CR char inside unquoted, not part of EOL",
          2034 => "EIF - Loose unescaped quote",
          2037 => "EIF - Binary character in unquoted field, binary off",
  
          2110 => "ECB - Binary character in Combine, binary off",
  
          2200 => "EIO - print to IO failed. See errno",
  
          # PP Only Error
          4002 => "EIQ - Unescaped ESC in quoted field",
          4003 => "EIF - ESC CR",
          4004 => "EUF - ",
  
          # Hash-Ref errors
          3001 => "EHR - Unsupported syntax for column_names ()",
          3002 => "EHR - getline_hr () called before column_names ()",
          3003 => "EHR - bind_columns () and column_names () fields count mismatch",
          3004 => "EHR - bind_columns () only accepts refs to scalars",
          3006 => "EHR - bind_columns () did not pass enough refs for parsed fields",
          3007 => "EHR - bind_columns needs refs to writable scalars",
          3008 => "EHR - unexpected error in bound fields",
          3009 => "EHR - print_hr () called before column_names ()",
          3010 => "EHR - print_hr () called with invalid arguments",
  
          0    => "",
  };
  
  
  my $last_new_error = '';
  my $last_new_err_num;
  
  my %def_attr = (
      quote_char          => '"',
      escape_char         => '"',
      sep_char            => ',',
      eol                 => defined $\ ? $\ : '',
      always_quote        => 0,
      binary              => 0,
      keep_meta_info      => 0,
      allow_loose_quotes  => 0,
      allow_loose_escapes => 0,
      allow_unquoted_escape => 0,
      allow_whitespace    => 0,
      chomp_verbatim      => 0,
      types               => undef,
      verbatim            => 0,
      blank_is_undef      => 0,
      empty_is_undef      => 0,
      auto_diag           => 0,
      quote_space         => 1,
      quote_null          => 1,
      quote_binary        => 1,
      diag_verbose        => 0,
  
      _EOF                => 0,
      _RECNO              => 0,
      _STATUS             => undef,
      _FIELDS             => undef,
      _FFLAGS             => undef,
      _STRING             => undef,
      _ERROR_INPUT        => undef,
      _ERROR_DIAG         => undef,
  
      _COLUMN_NAMES       => undef,
      _BOUND_COLUMNS      => undef,
  );
  
  
  BEGIN {
      if ( $] < 5.006 ) {
          $INC{'bytes.pm'} = 1 unless $INC{'bytes.pm'}; # dummy
          no strict 'refs';
          *{"utf8::is_utf8"} = sub { 0; };
          *{"utf8::decode"}  = sub { };
      }
      elsif ( $] < 5.008 ) {
          no strict 'refs';
          *{"utf8::is_utf8"} = sub { 0; };
          *{"utf8::decode"}  = sub { };
      }
      elsif ( !defined &utf8::is_utf8 ) {
         require Encode;
         *utf8::is_utf8 = *Encode::is_utf8;
      }
  
      eval q| require Scalar::Util |;
      if ( $@ ) {
          eval q| require B |;
          if ( $@ ) {
              Carp::croak $@;
          }
          else {
              *Scalar::Util::readonly = sub (\$) {
                  my $b = B::svref_2object( $_[0] );
                  $b->FLAGS & 0x00800000; # SVf_READONLY?
              }
          }
      }
  }
  
  ################################################################################
  # version
  ################################################################################
  sub version {
      return $VERSION;
  }
  ################################################################################
  # new
  ################################################################################
  
  sub _check_sanity {
      my ( $self ) = @_;
  
      for ( qw( sep_char quote_char escape_char ) ) {
          ( exists $self->{$_} && defined $self->{$_} && $self->{$_} =~ m/[\r\n]/ ) and return 1003;
      }
  
      if ( $self->{allow_whitespace} and
             ( defined $self->{quote_char}  && $self->{quote_char}  =~ m/^[ \t]$/ ) 
             ||
             ( defined $self->{escape_char} && $self->{escape_char} =~ m/^[ \t]$/ )
      ) {
         #$last_new_error = "INI - allow_whitespace with escape_char or quote_char SP or TAB";
         #$last_new_err_num = 1002;
         return 1002;
      }
  
      return 0;
  }
  
  
  sub new {
      my $proto = shift;
      my $attr  = @_ > 0 ? shift : {};
  
      $last_new_error   = 'usage: my $csv = Text::CSV_PP->new ([{ option => value, ... }]);';
      $last_new_err_num = 1000;
  
      return unless ( defined $attr and ref($attr) eq 'HASH' );
  
      my $class = ref($proto) || $proto or return;
      my $self  = { %def_attr };
  
      for my $prop (keys %$attr) { # if invalid attr, return undef
          unless ($prop =~ /^[a-z]/ && exists $def_attr{$prop}) {
              $last_new_error = "INI - Unknown attribute '$prop'";
              error_diag() if $attr->{ auto_diag };
              return;
          }
          $self->{$prop} = $attr->{$prop};
      }
  
      my $ec = _check_sanity( $self );
  
      if ( $ec ) {
          $last_new_error   = $ERRORS->{ $ec };
          $last_new_err_num = $ec;
          return;
          #$class->SetDiag ($ec);
      }
  
      $last_new_error = '';
  
      defined $\ and $self->{eol} = $\;
  
      bless $self, $class;
  
      $self->types( $self->{types} ) if( exists( $self->{types} ) );
  
      return $self;
  }
  ################################################################################
  # status
  ################################################################################
  sub status {
      $_[0]->{_STATUS};
  }
  ################################################################################
  # error_input
  ################################################################################
  sub error_input {
      $_[0]->{_ERROR_INPUT};
  }
  ################################################################################
  # error_diag
  ################################################################################
  sub error_diag {
      my $self = shift;
      my @diag = (0, $last_new_error, 0);
  
      unless ($self and ref $self) {	# Class method or direct call
          $last_new_error and $diag[0] = defined $last_new_err_num ? $last_new_err_num : 1000;
      }
      elsif ( $self->isa (__PACKAGE__) and defined $self->{_ERROR_DIAG} ) {
          @diag = ( 0 + $self->{_ERROR_DIAG}, $ERRORS->{ $self->{_ERROR_DIAG} } );
          exists $self->{_ERROR_POS} and $diag[2] = 1 + $self->{_ERROR_POS};
      }
  
      my $context = wantarray;
  
      my $diagobj = bless \@diag, 'Text::CSV::ErrorDiag';
  
      unless (defined $context) { # Void context
          if ( $diag[0] ) {
              my $msg = "# CSV_PP ERROR: " . $diag[0] . " - $diag[1]\n";
              ref $self ? ( $self->{auto_diag} > 1 ? die $msg : warn $msg )
                        : warn $msg;
          }
          return;
      }
  
      return $context ? @diag : $diagobj;
  }
  
  sub record_number {
      return shift->{_RECNO};
  } 
  
  ################################################################################
  # string
  ################################################################################
  *string = \&_string;
  sub _string {
      defined $_[0]->{_STRING} ? ${ $_[0]->{_STRING} } : undef;
  }
  ################################################################################
  # fields
  ################################################################################
  *fields = \&_fields;
  sub _fields {
      ref($_[0]->{_FIELDS}) ?  @{$_[0]->{_FIELDS}} : undef;
  }
  ################################################################################
  # combine
  ################################################################################
  *combine = \&_combine;
  sub _combine {
      my ($self, @part) = @_;
  
      # at least one argument was given for "combining"...
      return $self->{_STATUS} = 0 unless(@part);
  
      $self->{_FIELDS}      = \@part;
      $self->{_ERROR_INPUT} = undef;
      $self->{_STRING}      = '';
      $self->{_STATUS}      = 0;
  
      my ($always_quote, $binary, $quot, $sep, $esc, $empty_is_undef, $quote_space, $quote_null, $quote_binary )
              = @{$self}{qw/always_quote binary quote_char sep_char escape_char empty_is_undef quote_space quote_null quote_binary/};
  
      if(!defined $quot){ $quot = ''; }
  
      return $self->_set_error_diag(1001) if ($sep eq $esc or $sep eq $quot);
  
      my $re_esc = $self->{_re_comb_escape}->{$quot}->{$esc} ||= qr/(\Q$quot\E|\Q$esc\E)/;
      my $re_sp  = $self->{_re_comb_sp}->{$sep}->{$quote_space} ||= ( $quote_space ? qr/[\s\Q$sep\E]/ : qr/[\Q$sep\E]/ );
  
      my $must_be_quoted;
      for my $column (@part) {
  
          unless (defined $column) {
              $column = '';
              next;
          }
          elsif ( !$binary ) {
              $binary = 1 if utf8::is_utf8 $column;
          }
  
          if (!$binary and $column =~ /[^\x09\x20-\x7E]/) {
              # an argument contained an invalid character...
              $self->{_ERROR_INPUT} = $column;
              $self->_set_error_diag(2110);
              return $self->{_STATUS};
          }
  
          $must_be_quoted = 0;
  
          if($quot ne '' and $column =~ s/$re_esc/$esc$1/g){
              $must_be_quoted++;
          }
          if($column =~ /$re_sp/){
              $must_be_quoted++;
          }
  
          if( $binary and $quote_null ){
              use bytes;
              $must_be_quoted++ if ( $column =~ s/\0/${esc}0/g || ($quote_binary && $column =~ /[\x00-\x1f\x7f-\xa0]/) );
          }
  
          if($always_quote or $must_be_quoted){
              $column = $quot . $column . $quot;
          }
  
      }
  
      $self->{_STRING} = \do { join($sep, @part) . ( defined $self->{eol} ? $self->{eol} : '' ) };
      $self->{_STATUS} = 1;
  
      return $self->{_STATUS};
  }
  ################################################################################
  # parse
  ################################################################################
  my %allow_eol = ("\r" => 1, "\r\n" => 1, "\n" => 1, "" => 1);
  
  *parse = \&_parse;
  
  sub _parse {
      my ($self, $line) = @_;
  
      @{$self}{qw/_STRING _FIELDS _STATUS _ERROR_INPUT/} = ( \do{ defined $line ? "$line" : undef }, undef, 0, $line );
  
      return 0 if(!defined $line);
  
      my ($binary, $quot, $sep, $esc, $types, $keep_meta_info, $allow_whitespace, $eol, $blank_is_undef, $empty_is_undef, $unquot_esc)
           = @{$self}{
              qw/binary quote_char sep_char escape_char types keep_meta_info allow_whitespace eol blank_is_undef empty_is_undef allow_unquoted_escape/
             };
  
      $sep  = ',' unless (defined $sep);
      $esc  = "\0" unless (defined $esc);
      $quot = "\0" unless (defined $quot);
  
      my $quot_is_null = $quot eq "\0"; # in this case, any fields are not interpreted as quoted data.
  
      return $self->_set_error_diag(1001) if (($sep eq $esc or $sep eq $quot) and $sep ne "\0");
  
      my $meta_flag      = $keep_meta_info ? [] : undef;
      my $re_split       = $self->{_re_split}->{$quot}->{$esc}->{$sep} ||= _make_regexp_split_column($esc, $quot, $sep);
      my $re_quoted       = $self->{_re_quoted}->{$quot}               ||= qr/^\Q$quot\E(.*)\Q$quot\E$/s;
      my $re_in_quot_esp1 = $self->{_re_in_quot_esp1}->{$esc}          ||= qr/\Q$esc\E(.)/;
      my $re_in_quot_esp2 = $self->{_re_in_quot_esp2}->{$quot}->{$esc} ||= qr/[\Q$quot$esc$sep\E0]/;
      my $re_quot_char    = $self->{_re_quot_char}->{$quot}            ||= qr/\Q$quot\E/;
      my $re_esc          = $self->{_re_esc}->{$quot}->{$esc}          ||= qr/\Q$esc\E(\Q$quot\E|\Q$esc\E|\Q$sep\E|0)/;
      my $re_invalid_quot = $self->{_re_invalid_quot}->{$quot}->{$esc} ||= qr/^$re_quot_char|[^\Q$re_esc\E]$re_quot_char/;
  
      if ($allow_whitespace) {
          $re_split = $self->{_re_split_allow_sp}->{$quot}->{$esc}->{$sep}
                       ||= _make_regexp_split_column_allow_sp($esc, $quot, $sep);
      }
      if ($unquot_esc) {
          $re_split = $self->{_re_split_allow_unqout_esc}->{$quot}->{$esc}->{$sep}
                       ||= _make_regexp_split_column_allow_unqout_esc($esc, $quot, $sep);
      }
  
      my $palatable = 1;
      my @part      = ();
  
      my $i = 0;
      my $flag;
  
      if (defined $eol and $eol eq "\r") {
          $line =~ s/[\r ]*\r[ ]*$//;
      }
  
      if ($self->{verbatim}) {
          $line .= $sep;
      }
      else {
          if (defined $eol and !$allow_eol{$eol}) {
              $line .= $sep;
          }
          else {
              $line =~ s/(?:\x0D\x0A|\x0A)?$|(?:\x0D\x0A|\x0A)[ ]*$/$sep/;
          }
      }
  
      my $pos = 0;
  
      my $utf8 = 1 if utf8::is_utf8( $line ); # if UTF8 marked, flag on.
  
      for my $col ( $line =~ /$re_split/g ) {
  
          if ($keep_meta_info) {
              $flag = 0x0000;
              $flag |= IS_BINARY if ($col =~ /[^\x09\x20-\x7E]/);
          }
  
          $pos += length $col;
  
          if ( ( !$binary and !$utf8 ) and $col =~ /[^\x09\x20-\x7E]/) { # Binary character, binary off
              if ( not $quot_is_null and $col =~ $re_quoted ) {
                  $self->_set_error_diag(
                        $col =~ /\n([^\n]*)/ ? (2021, $pos - 1 - length $1)
                      : $col =~ /\r([^\r]*)/ ? (2022, $pos - 1 - length $1)
                      : (2026, $pos -2) # Binary character inside quoted field, binary off
                  );
              }
              else {
                  $self->_set_error_diag(
                        $col =~ /\Q$quot\E(.*)\Q$quot\E\r$/   ? (2010, $pos - 2)
                      : $col =~ /\n/                          ? (2030, $pos - length $col)
                      : $col =~ /^\r/                         ? (2031, $pos - length $col)
                      : $col =~ /\r([^\r]*)/                  ? (2032, $pos - 1 - length $1)
                      : (2037, $pos - length $col) # Binary character in unquoted field, binary off
                  );
              }
              $palatable = 0;
              last;
          }
  
          if ( ($utf8 and !$binary) and  $col =~ /\n|\0/ ) { # \n still needs binary (Text::CSV_XS 0.51 compat)
              $self->_set_error_diag(2021, $pos);
              $palatable = 0;
              last;
          }
  
          if ( not $quot_is_null and $col =~ $re_quoted ) {
              $flag |= IS_QUOTED if ($keep_meta_info);
              $col = $1;
  
              my $flag_in_quot_esp;
              while ( $col =~ /$re_in_quot_esp1/g ) {
                  my $str = $1;
                  $flag_in_quot_esp = 1;
  
                  if ($str !~ $re_in_quot_esp2) {
  
                      unless ($self->{allow_loose_escapes}) {
                          $self->_set_error_diag( 2025, $pos - 2 ); # Needless ESC in quoted field
                          $palatable = 0;
                          last;
                      }
  
                      unless ($self->{allow_loose_quotes}) {
                          $col =~ s/\Q$esc\E(.)/$1/g;
                      }
                  }
  
              }
  
              last unless ( $palatable );
  
              unless ( $flag_in_quot_esp ) {
                  if ($col =~ /(?<!\Q$esc\E)\Q$esc\E/) {
                      $self->_set_error_diag( 4002, $pos - 1 ); # No escaped ESC in quoted field
                      $palatable = 0;
                      last;
                  }
              }
  
              $col =~ s{$re_esc}{$1 eq '0' ? "\0" : $1}eg;
  
              if ( $empty_is_undef and length($col) == 0 ) {
                  $col = undef;
              }
  
              if ($types and $types->[$i]) { # IV or NV
                  _check_type(\$col, $types->[$i]);
              }
  
          }
  
          # quoted but invalid
  
          elsif ( not $quot_is_null and $col =~ $re_invalid_quot ) {
  
              unless ($self->{allow_loose_quotes} and $col =~ /$re_quot_char/) {
                  $self->_set_error_diag(
                        $col =~ /^\Q$quot\E(.*)\Q$quot\E.$/s  ? (2011, $pos - 2)
                      : $col =~ /^$re_quot_char/              ? (2027, $pos - 1)
                      : (2034, $pos - length $col) # Loose unescaped quote
                  );
                  $palatable = 0;
                  last;
              }
  
          }
  
          elsif ($types and $types->[$i]) { # IV or NV
              _check_type(\$col, $types->[$i]);
          }
  
          # unquoted
  
          else {
  
              if (!$self->{verbatim} and $col =~ /\r\n|\n/) {
                  $col =~ s/(?:\r\n|\n).*$//sm;
              }
  
              if ($col =~ /\Q$esc\E\r$/) { # for t/15_flags : test 165 'ESC CR' at line 203
                  $self->_set_error_diag( 4003, $pos );
                  $palatable = 0;
                  last;
              }
  
              if ($col =~ /.\Q$esc\E$/) { # for t/65_allow : test 53-54 parse('foo\') at line 62, 65
                  $self->_set_error_diag( 4004, $pos );
                  $palatable = 0;
                  last;
              }
  
              if ( $col eq '' and $blank_is_undef ) {
                  $col = undef;
              }
  
              if ( $empty_is_undef and length($col) == 0 ) {
                  $col = undef;
              }
  
              if ( $unquot_esc ) {
                  $col =~ s/\Q$esc\E(.)/$1/g;
              }
  
          }
  
          utf8::encode($col) if $utf8;
          if ( defined $col && _is_valid_utf8($col) ) {
              utf8::decode($col);
          }
  
          push @part,$col;
          push @{$meta_flag}, $flag if ($keep_meta_info);
          $self->{ _RECNO }++;
  
          $i++;
      }
  
      if ($palatable and ! @part) {
          $palatable = 0;
      }
  
      if ($palatable) {
          $self->{_ERROR_INPUT} = undef;
          $self->{_FIELDS}      = \@part;
      }
  
      $self->{_FFLAGS} = $keep_meta_info ? $meta_flag : [];
  
      return $self->{_STATUS} = $palatable;
  }
  
  
  sub _make_regexp_split_column {
      my ($esc, $quot, $sep) = @_;
  
      if ( $quot eq '' ) {
          return qr/([^\Q$sep\E]*)\Q$sep\E/s;
      }
  
     return qr/(
          \Q$quot\E
              [^\Q$quot$esc\E]*(?:\Q$esc\E[\Q$quot$esc\E0][^\Q$quot$esc\E]*)*
          \Q$quot\E
          | # or
          \Q$quot\E
              (?:\Q$esc\E[\Q$quot$esc$sep\E0]|[^\Q$quot$esc$sep\E])*
          \Q$quot\E
          | # or
          [^\Q$sep\E]*
         )
         \Q$sep\E
      /xs;
  }
  
  
  sub _make_regexp_split_column_allow_unqout_esc {
      my ($esc, $quot, $sep) = @_;
  
     return qr/(
          \Q$quot\E
              [^\Q$quot$esc\E]*(?:\Q$esc\E[\Q$quot$esc\E0][^\Q$quot$esc\E]*)*
          \Q$quot\E
          | # or
          \Q$quot\E
              (?:\Q$esc\E[\Q$quot$esc$sep\E0]|[^\Q$quot$esc$sep\E])*
          \Q$quot\E
          | # or
              (?:\Q$esc\E[\Q$quot$esc$sep\E0]|[^\Q$quot$esc$sep\E])*
          | # or
          [^\Q$sep\E]*
         )
         \Q$sep\E
      /xs;
  }
  
  
  sub _make_regexp_split_column_allow_sp {
      my ($esc, $quot, $sep) = @_;
  
      # if separator is space or tab, don't count that separator
      # as whitespace  --- patched by Mike O'Sullivan
      my $ws = $sep eq ' '  ? '[\x09]'
             : $sep eq "\t" ? '[\x20]'
             : '[\x20\x09]'
             ;
  
      if ( $quot eq '' ) {
          return qr/$ws*([^\Q$sep\E]?)$ws*\Q$sep\E$ws*/s;
      }
  
      qr/$ws*
         (
          \Q$quot\E
              [^\Q$quot$esc\E]*(?:\Q$esc\E[\Q$quot$esc$sep\E0][^\Q$quot$esc\E]*)*
          \Q$quot\E
          | # or
          [^\Q$sep\E]*?
         )
         $ws*\Q$sep\E$ws*
      /xs;
  }
  ################################################################################
  # print
  ################################################################################
  sub print {
      my ($self, $io, $cols) = @_;
  
      require IO::Handle;
  
      if(ref($cols) ne 'ARRAY'){
          Carp::croak("Expected fields to be an array ref");
      }
  
      $self->_combine(@$cols) or return '';
  
      local $\ = '';
  
      $io->print( $self->_string ) or $self->_set_error_diag(2200);
  }
  
  sub print_hr {
      my ($self, $io, $hr) = @_;
      $self->{_COLUMN_NAMES} or $self->_set_error_diag(3009);
      ref $hr eq "HASH"      or $self->_set_error_diag(3010);
      $self->print ($io, [ map { $hr->{$_} } $self->column_names ]);
  }
  ################################################################################
  # getline
  ################################################################################
  sub getline {
      my ($self, $io) = @_;
  
      require IO::Handle;
  
      $self->{_EOF} = eof($io) ? 1 : '';
  
      my $quot = $self->{quote_char};
      my $sep  = $self->{sep_char};
      my $re   =  defined $quot ? qr/(?:\Q$quot\E)/ : undef;
  
      my $eol  = $self->{eol};
  
      local $/ = $eol if ( defined $eol and $eol ne '' );
  
      my $line = $io->getline();
  
      # AUTO DETECTION EOL CR
      if ( defined $line and defined $eol and $eol eq '' and $line =~ /[^\r]\r[^\r\n]/ and eof ) {
          $self->{_AUTO_DETECT_CR} = 1;
          $self->{eol} = "\r";
          seek( $io, 0, 0 ); # restart
          return $self->getline( $io );
      }
  
      if ( $re and defined $line ) {
          LOOP: {
              my $is_continued   = scalar(my @list = $line =~ /$re/g) % 2; # if line is valid, quot is even
  
              if ( $self->{allow_loose_quotes } ) {
                  $is_continued = 0;
              }
              elsif ( $line =~ /${re}0/ ) { # null suspicion case
                  $is_continued = $line =~ qr/
                      ^
                      (
                          (?:
                              $re             # $quote
                              (?:
                                    $re$re    #    escaped $quote
                                  | ${re}0    # or escaped zero
                                  | [^$quot]  # or exceptions of $quote
                              )*
                              $re             # $quote
                              [^0$quot]       # non zero or $quote
                          )
                          |                   
                          (?:[^$quot]*)       # exceptions of $quote
                      )+
                      $
                  /x ? 0 : 1;
              }
  
              if ( $is_continued and !eof($io) ) {
                  $line .= $io->getline();
                  goto LOOP;
              }
          }
      }
  
      $line =~ s/\Q$eol\E$// if ( defined $line and defined $eol and $eol ne '' );
  
      $self->_parse($line);
  
      return $self->_return_getline_result();
  }
  
  
  sub _return_getline_result {
  
      if ( eof ) {
          $_[0]->{_AUTO_DETECT_CR} = 0;
      }
  
      return unless $_[0]->{_STATUS};
  
      return [ $_[0]->_fields() ] unless $_[0]->{_BOUND_COLUMNS};
  
      my @vals  = $_[0]->_fields();
      my ( $max, $count ) = ( scalar @vals, 0 );
  
      if ( @{ $_[0]->{_BOUND_COLUMNS} } < $max ) {
              $_[0]->_set_error_diag(3006);
              return;
      }
  
      for ( my $i = 0; $i < $max; $i++ ) {
          my $bind = $_[0]->{_BOUND_COLUMNS}->[ $i ];
          if ( Scalar::Util::readonly( $$bind ) ) {
              $_[0]->_set_error_diag(3008);
              return;
          }
          $$bind = $vals[ $i ];
      }
  
      return [];
  }
  ################################################################################
  # getline_all
  ################################################################################
  sub getline_all {
      my ( $self, $io, $offset, $len ) = @_;
      my @list;
      my $tail;
      my $n = 0;
  
      $offset ||= 0;
  
      if ( $offset < 0 ) {
          $tail = -$offset;
          $offset = 0;
      }
  
      while ( my $row = $self->getline($io) ) {
          next if $offset && $offset-- > 0;               # skip
          last if defined $len && !$tail && $n >= $len;   # exceedes limit size
          push @list, $row;
          ++$n;
          if ( $tail && $n > $tail ) {
              shift @list;
          }
      }
  
      if ( $tail && defined $len && $n > $len ) {
          @list = splice( @list, 0, $len);
      }
  
      return \@list;
  }
  ################################################################################
  # getline_hr
  ################################################################################
  sub getline_hr {
      my ( $self, $io) = @_;
      my %hr;
  
      unless ( $self->{_COLUMN_NAMES} ) {
          $self->SetDiag( 3002 );
      }
  
      my $fr = $self->getline( $io ) or return undef;
  
      if ( ref $self->{_FFLAGS} ) {
          $self->{_FFLAGS}[$_] = IS_MISSING for ($#{$fr} + 1) .. $#{$self->{_COLUMN_NAMES}};
      }
  
      @hr{ @{ $self->{_COLUMN_NAMES} } } = @$fr;
  
      \%hr;
  }
  ################################################################################
  # getline_hr_all
  ################################################################################
  sub getline_hr_all {
      my ( $self, $io, @args ) = @_;
      my %hr;
  
      unless ( $self->{_COLUMN_NAMES} ) {
          $self->SetDiag( 3002 );
      }
  
      my @cn = @{$self->{_COLUMN_NAMES}};
  
      return [ map { my %h; @h{ @cn } = @$_; \%h } @{ $self->getline_all( $io, @args ) } ];
  }
  ################################################################################
  # column_names
  ################################################################################
  sub column_names {
      my ( $self, @columns ) = @_;
  
      @columns or return defined $self->{_COLUMN_NAMES} ? @{$self->{_COLUMN_NAMES}} : undef;
      @columns == 1 && ! defined $columns[0] and return $self->{_COLUMN_NAMES} = undef;
  
      if ( @columns == 1 && ref $columns[0] eq "ARRAY" ) {
          @columns = @{ $columns[0] };
      }
      elsif ( join "", map { defined $_ ? ref $_ : "" } @columns ) {
          $self->SetDiag( 3001 );
      }
  
      if ( $self->{_BOUND_COLUMNS} && @columns != @{$self->{_BOUND_COLUMNS}} ) {
          $self->SetDiag( 3003 );
      }
  
      $self->{_COLUMN_NAMES} = [ map { defined $_ ? $_ : "\cAUNDEF\cA" } @columns ];
      @{ $self->{_COLUMN_NAMES} };
  }
  ################################################################################
  # bind_columns
  ################################################################################
  sub bind_columns {
      my ( $self, @refs ) = @_;
  
      @refs or return defined $self->{_BOUND_COLUMNS} ? @{$self->{_BOUND_COLUMNS}} : undef;
      @refs == 1 && ! defined $refs[0] and return $self->{_BOUND_COLUMNS} = undef;
  
      if ( $self->{_COLUMN_NAMES} && @refs != @{$self->{_COLUMN_NAMES}} ) {
          $self->SetDiag( 3003 );
      }
  
      if ( grep { ref $_ ne "SCALAR" } @refs ) { # why don't use grep?
          $self->SetDiag( 3004 );
      }
  
      $self->{_is_bound} = scalar @refs; #pack("C", scalar @refs);
      $self->{_BOUND_COLUMNS} = [ @refs ];
      @refs;
  }
  ################################################################################
  # eof
  ################################################################################
  sub eof {
      $_[0]->{_EOF};
  }
  ################################################################################
  # type
  ################################################################################
  sub types {
      my $self = shift;
  
      if (@_) {
          if (my $types = shift) {
              $self->{'_types'} = join("", map{ chr($_) } @$types);
              $self->{'types'} = $types;
          }
          else {
              delete $self->{'types'};
              delete $self->{'_types'};
              undef;
          }
      }
      else {
          $self->{'types'};
      }
  }
  ################################################################################
  sub meta_info {
      $_[0]->{_FFLAGS} ? @{ $_[0]->{_FFLAGS} } : undef;
  }
  
  sub is_quoted {
      return unless (defined $_[0]->{_FFLAGS});
      return if( $_[1] =~ /\D/ or $_[1] < 0 or  $_[1] > $#{ $_[0]->{_FFLAGS} } );
  
      $_[0]->{_FFLAGS}->[$_[1]] & IS_QUOTED ? 1 : 0;
  }
  
  sub is_binary {
      return unless (defined $_[0]->{_FFLAGS});
      return if( $_[1] =~ /\D/ or $_[1] < 0 or  $_[1] > $#{ $_[0]->{_FFLAGS} } );
      $_[0]->{_FFLAGS}->[$_[1]] & IS_BINARY ? 1 : 0;
  }
  
  sub is_missing {
      my ($self, $idx, $val) = @_;
      ref $self->{_FFLAGS} &&
              $idx >= 0 && $idx < @{$self->{_FFLAGS}} or return;
      $self->{_FFLAGS}[$idx] & IS_MISSING ? 1 : 0;
  }
  ################################################################################
  # _check_type
  #  take an arg as scalar referrence.
  #  if not numeric, make the value 0. otherwise INTEGERized.
  ################################################################################
  sub _check_type {
      my ($col_ref, $type) = @_;
      unless ($$col_ref =~ /^[+-]?(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?$/) {
          Carp::carp sprintf("Argument \"%s\" isn't numeric in subroutine entry",$$col_ref);
          $$col_ref = 0;
      }
      elsif ($type == NV) {
          $$col_ref = sprintf("%G",$$col_ref);
      }
      else {
          $$col_ref = sprintf("%d",$$col_ref);
      }
  }
  ################################################################################
  # _set_error_diag
  ################################################################################
  sub _set_error_diag {
      my ( $self, $error, $pos ) = @_;
  
      $self->{_ERROR_DIAG} = $error;
  
      if (defined $pos) {
          $_[0]->{_ERROR_POS} = $pos;
      }
  
      $self->error_diag() if ( $error and $self->{auto_diag} );
  
      return;
  }
  ################################################################################
  
  BEGIN {
      for my $method ( qw/always_quote binary keep_meta_info allow_loose_quotes allow_loose_escapes
                              verbatim blank_is_undef empty_is_undef quote_space quote_null
                              quote_binary allow_unquoted_escape/ ) {
          eval qq|
              sub $method {
                  \$_[0]->{$method} = defined \$_[1] ? \$_[1] : 0 if (\@_ > 1);
                  \$_[0]->{$method};
              }
          |;
      }
  }
  
  
  
  sub sep_char {
      my $self = shift;
      if ( @_ ) {
          $self->{sep_char} = $_[0];
          my $ec = _check_sanity( $self );
          $ec and Carp::croak( $self->SetDiag( $ec ) );
      }
      $self->{sep_char};
  }
  
  
  sub quote_char {
      my $self = shift;
      if ( @_ ) {
          $self->{quote_char} = $_[0];
          my $ec = _check_sanity( $self );
          $ec and Carp::croak( $self->SetDiag( $ec ) );
      }
      $self->{quote_char};
  }
  
  
  sub escape_char {
      my $self = shift;
      if ( @_ ) {
          $self->{escape_char} = $_[0];
          my $ec = _check_sanity( $self );
          $ec and Carp::croak( $self->SetDiag( $ec ) );
      }
      $self->{escape_char};
  }
  
  
  sub allow_whitespace {
      my $self = shift;
      if ( @_ ) {
          my $aw = shift;
          $aw and
              (defined $self->{quote_char}  && $self->{quote_char}  =~ m/^[ \t]$/) ||
              (defined $self->{escape_char} && $self->{escape_char} =~ m/^[ \t]$/)
                  and Carp::croak ($self->SetDiag (1002));
          $self->{allow_whitespace} = $aw;
      }
      $self->{allow_whitespace};
  }
  
  
  sub eol {
      $_[0]->{eol} = defined $_[1] ? $_[1] : '' if ( @_ > 1 );
      $_[0]->{eol};
  }
  
  
  sub SetDiag {
      if ( defined $_[1] and $_[1] == 0 ) {
          $_[0]->{_ERROR_DIAG} = undef;
          $last_new_error = '';
          return;
      }
  
      $_[0]->_set_error_diag( $_[1] );
      Carp::croak( $_[0]->error_diag . '' );
  }
  
  sub auto_diag {
      my $self = shift;
      if (@_) {
          my $v = shift;
          !defined $v || $v eq "" and $v = 0;
          $v =~ m/^[0-9]/ or $v = $v ? 1 : 0; # default for true/false
          $self->{auto_diag} = $v;
      }
      $self->{auto_diag};
  }
  
  sub diag_verbose {
      my $self = shift;
      if (@_) {
          my $v = shift;
          !defined $v || $v eq "" and $v = 0;
          $v =~ m/^[0-9]/ or $v = $v ? 1 : 0; # default for true/false
          $self->{diag_verbose} = $v;
      }
      $self->{diag_verbose};
  }
  
  sub _is_valid_utf8 {
      return ( $_[0] =~ /^(?:
           [\x00-\x7F]
          |[\xC2-\xDF][\x80-\xBF]
          |[\xE0][\xA0-\xBF][\x80-\xBF]
          |[\xE1-\xEC][\x80-\xBF][\x80-\xBF]
          |[\xED][\x80-\x9F][\x80-\xBF]
          |[\xEE-\xEF][\x80-\xBF][\x80-\xBF]
          |[\xF0][\x90-\xBF][\x80-\xBF][\x80-\xBF]
          |[\xF1-\xF3][\x80-\xBF][\x80-\xBF][\x80-\xBF]
          |[\xF4][\x80-\x8F][\x80-\xBF][\x80-\xBF]
      )+$/x )  ? 1 : 0;
  }
  ################################################################################
  package Text::CSV::ErrorDiag;
  
  use strict;
  use overload (
      '""' => \&stringify,
      '+'  => \&numeric,
      '-'  => \&numeric,
      '*'  => \&numeric,
      '/'  => \&numeric,
  );
  
  
  sub numeric {
      my ($left, $right) = @_;
      return ref $left ? $left->[0] : $right->[0];
  }
  
  
  sub stringify {
      $_[0]->[1];
  }
  ################################################################################
  1;
  __END__
  
  =head1 NAME
  
  Text::CSV_PP - Text::CSV_XS compatible pure-Perl module
  
  
  =head1 SYNOPSIS
  
   use Text::CSV_PP;
   
   $csv = Text::CSV_PP->new();     # create a new object
   # If you want to handle non-ascii char.
   $csv = Text::CSV_PP->new({binary => 1});
   
   $status = $csv->combine(@columns);    # combine columns into a string
   $line   = $csv->string();             # get the combined string
   
   $status  = $csv->parse($line);        # parse a CSV string into fields
   @columns = $csv->fields();            # get the parsed fields
   
   $status       = $csv->status ();      # get the most recent status
   $bad_argument = $csv->error_input (); # get the most recent bad argument
   $diag         = $csv->error_diag ();  # if an error occured, explains WHY
   
   $status = $csv->print ($io, $colref); # Write an array of fields
                                         # immediately to a file $io
   $colref = $csv->getline ($io);        # Read a line from file $io,
                                         # parse it and return an array
                                         # ref of fields
   $csv->column_names (@names);          # Set column names for getline_hr ()
   $ref = $csv->getline_hr ($io);        # getline (), but returns a hashref
   $eof = $csv->eof ();                  # Indicate if last parse or
                                         # getline () hit End Of File
   
   $csv->types(\@t_array);               # Set column types
  
  
  =head1 DESCRIPTION
  
  Text::CSV_PP has almost same functions of L<Text::CSV_XS> which 
  provides facilities for the composition and decomposition of
  comma-separated values. As its name suggests, L<Text::CSV_XS>
  is a XS module and Text::CSV_PP is a Puer Perl one.
  
  =head1 VERSION
  
      1.31
  
  This module is compatible with Text::CSV_XS B<0.99>.
  (except for diag_verbose and allow_unquoted_escape)
  
  =head2 Unicode (UTF8)
  
  On parsing (both for C<getline ()> and C<parse ()>), if the source is
  marked being UTF8, then parsing that source will mark all fields that
  are marked binary will also be marked UTF8.
  
  On combining (C<print ()> and C<combine ()>), if any of the combining
  fields was marked UTF8, the resulting string will be marked UTF8.
  
  =head1 FUNCTIONS
  
  These methods are almost same as Text::CSV_XS.
  Most of the documentation was shamelessly copied and replaced from Text::CSV_XS.
  
  See to L<Text::CSV_XS>.
  
  =head2 version ()
  
  (Class method) Returns the current backend module version.
  If you want the module version, you can use the C<VERSION> method,
  
   print Text::CSV->VERSION;      # This module version
   print Text::CSV->version;      # The version of the worker module
                                  # same as Text::CSV->backend->version
  
  =head2 new (\%attr)
  
  (Class method) Returns a new instance of Text::CSV_XS. The objects
  attributes are described by the (optional) hash ref C<\%attr>.
  Currently the following attributes are available:
  
  =over 4
  
  =item eol
  
  An end-of-line string to add to rows. C<undef> is replaced with an
  empty string. The default is C<$\>. Common values for C<eol> are
  C<"\012"> (Line Feed) or C<"\015\012"> (Carriage Return, Line Feed).
  Cannot be longer than 7 (ASCII) characters.
  
  If both C<$/> and C<eol> equal C<"\015">, parsing lines that end on
  only a Carriage Return without Line Feed, will be C<parse>d correct.
  Line endings, whether in C<$/> or C<eol>, other than C<undef>,
  C<"\n">, C<"\r\n">, or C<"\r"> are not (yet) supported for parsing.
  
  =item sep_char
  
  The char used for separating fields, by default a comma. (C<,>).
  Limited to a single-byte character, usually in the range from 0x20
  (space) to 0x7e (tilde).
  
  The separation character can not be equal to the quote character.
  The separation character can not be equal to the escape character.
  
  See also L<Text::CSV_XS/CAVEATS>
  
  =item allow_whitespace
  
  When this option is set to true, whitespace (TAB's and SPACE's)
  surrounding the separation character is removed when parsing. If
  either TAB or SPACE is one of the three major characters C<sep_char>,
  C<quote_char>, or C<escape_char> it will not be considered whitespace.
  
  So lines like:
  
    1 , "foo" , bar , 3 , zapp
  
  are now correctly parsed, even though it violates the CSV specs.
  
  Note that B<all> whitespace is stripped from start and end of each
  field. That would make it more a I<feature> than a way to be able
  to parse bad CSV lines, as
  
   1,   2.0,  3,   ape  , monkey
  
  will now be parsed as
  
   ("1", "2.0", "3", "ape", "monkey")
  
  even if the original line was perfectly sane CSV.
  
  =item blank_is_undef
  
  Under normal circumstances, CSV data makes no distinction between
  quoted- and unquoted empty fields. They both end up in an empty
  string field once read, so
  
   1,"",," ",2
  
  is read as
  
   ("1", "", "", " ", "2")
  
  When I<writing> CSV files with C<always_quote> set, the unquoted empty
  field is the result of an undefined value. To make it possible to also
  make this distinction when reading CSV data, the C<blank_is_undef> option
  will cause unquoted empty fields to be set to undef, causing the above to
  be parsed as
  
   ("1", "", undef, " ", "2")
  
  =item empty_is_undef
  
  Going one step further than C<blank_is_undef>, this attribute converts
  all empty fields to undef, so
  
   1,"",," ",2
  
  is read as
  
   (1, undef, undef, " ", 2)
  
  Note that this only effects fields that are I<realy> empty, not fields
  that are empty after stripping allowed whitespace. YMMV.
  
  =item quote_char
  
  The char used for quoting fields containing blanks, by default the
  double quote character (C<">). A value of undef suppresses
  quote chars. (For simple cases only).
  Limited to a single-byte character, usually in the range from 0x20
  (space) to 0x7e (tilde).
  
  The quote character can not be equal to the separation character.
  
  =item allow_loose_quotes
  
  By default, parsing fields that have C<quote_char> characters inside
  an unquoted field, like
  
   1,foo "bar" baz,42
  
  would result in a parse error. Though it is still bad practice to
  allow this format, we cannot help there are some vendors that make
  their applications spit out lines styled like this.
  
  In case there is B<really> bad CSV data, like
  
   1,"foo "bar" baz",42
  
  or
  
   1,""foo bar baz"",42
  
  there is a way to get that parsed, and leave the quotes inside the quoted
  field as-is. This can be achieved by setting C<allow_loose_quotes> B<AND>
  making sure that the C<escape_char> is I<not> equal to C<quote_char>.
  
  =item escape_char
  
  The character used for escaping certain characters inside quoted fields.
  Limited to a single-byte character, usually in the range from 0x20
  (space) to 0x7e (tilde).
  
  The C<escape_char> defaults to being the literal double-quote mark (C<">)
  in other words, the same as the default C<quote_char>. This means that
  doubling the quote mark in a field escapes it:
  
    "foo","bar","Escape ""quote mark"" with two ""quote marks""","baz"
  
  If you change the default quote_char without changing the default
  escape_char, the escape_char will still be the quote mark.  If instead
  you want to escape the quote_char by doubling it, you will need to change
  the escape_char to be the same as what you changed the quote_char to.
  
  The escape character can not be equal to the separation character.
  
  =item allow_loose_escapes
  
  By default, parsing fields that have C<escape_char> characters that
  escape characters that do not need to be escaped, like:
  
   my $csv = Text::CSV->new ({ escape_char => "\\" });
   $csv->parse (qq{1,"my bar\'s",baz,42});
  
  would result in a parse error. Though it is still bad practice to
  allow this format, this option enables you to treat all escape character
  sequences equal.
  
  =item binary
  
  If this attribute is TRUE, you may use binary characters in quoted fields,
  including line feeds, carriage returns and NULL bytes. (The latter must
  be escaped as C<"0>.) By default this feature is off.
  
  If a string is marked UTF8, binary will be turned on automatically when
  binary characters other than CR or NL are encountered. Note that a simple
  string like C<"\x{00a0}"> might still be binary, but not marked UTF8, so
  setting C<{ binary =E<gt> 1 }> is still a wise option.
  
  =item types
  
  A set of column types; this attribute is immediately passed to the
  I<types> method below. You must not set this attribute otherwise,
  except for using the I<types> method. For details see the description
  of the I<types> method below.
  
  =item always_quote
  
  By default the generated fields are quoted only, if they need to, for
  example, if they contain the separator. If you set this attribute to
  a TRUE value, then all defined fields will be quoted. This is typically
  easier to handle in external applications.
  
  =item quote_space
  
  By default, a space in a field would trigger quotation. As no rule
  exists this to be forced in CSV, nor any for the opposite, the default
  is true for safety. You can exclude the space from this trigger by
  setting this option to 0.
  
  =item quote_null
  
  By default, a NULL byte in a field would be escaped. This attribute
  enables you to treat the NULL byte as a simple binary character in
  binary mode (the C<{ binary =E<gt> 1 }> is set). The default is true.
  You can prevent NULL escapes by setting this attribute to 0.
  
  =item keep_meta_info
  
  By default, the parsing of input lines is as simple and fast as
  possible. However, some parsing information - like quotation of
  the original field - is lost in that process. Set this flag to
  true to be able to retrieve that information after parsing with
  the methods C<meta_info ()>, C<is_quoted ()>, and C<is_binary ()>
  described below.  Default is false.
  
  =item verbatim
  
  This is a quite controversial attribute to set, but it makes hard
  things possible.
  
  The basic thought behind this is to tell the parser that the normally
  special characters newline (NL) and Carriage Return (CR) will not be
  special when this flag is set, and be dealt with as being ordinary
  binary characters. This will ease working with data with embedded
  newlines.
  
  When C<verbatim> is used with C<getline ()>, C<getline ()>
  auto-chomp's every line.
  
  Imagine a file format like
  
    M^^Hans^Janssen^Klas 2\n2A^Ja^11-06-2007#\r\n
  
  where, the line ending is a very specific "#\r\n", and the sep_char
  is a ^ (caret). None of the fields is quoted, but embedded binary
  data is likely to be present. With the specific line ending, that
  shouldn't be too hard to detect.
  
  By default, Text::CSV' parse function however is instructed to only
  know about "\n" and "\r" to be legal line endings, and so has to deal
  with the embedded newline as a real end-of-line, so it can scan the next
  line if binary is true, and the newline is inside a quoted field.
  With this attribute however, we can tell parse () to parse the line
  as if \n is just nothing more than a binary character.
  
  For parse () this means that the parser has no idea about line ending
  anymore, and getline () chomps line endings on reading.
  
  =item auto_diag
  
  Set to true will cause C<error_diag ()> to be automatically be called
  in void context upon errors.
  
  If set to a value greater than 1, it will die on errors instead of
  warn.
  
  To check future plans and a difference in XS version,
  please see to L<Text::CSV_XS/auto_diag>.
  
  =back
  
  To sum it up,
  
   $csv = Text::CSV_PP->new ();
  
  is equivalent to
  
   $csv = Text::CSV_PP->new ({
       quote_char          => '"',
       escape_char         => '"',
       sep_char            => ',',
       eol                 => $\,
       always_quote        => 0,
       quote_space         => 1,
       quote_null          => 1,
       binary              => 0,
       keep_meta_info      => 0,
       allow_loose_quotes  => 0,
       allow_loose_escapes => 0,
       allow_whitespace    => 0,
       blank_is_undef      => 0,
       empty_is_undef      => 0,
       verbatim            => 0,
       auto_diag           => 0,
       });
  
  
  For all of the above mentioned flags, there is an accessor method
  available where you can inquire for the current value, or change
  the value
  
   my $quote = $csv->quote_char;
   $csv->binary (1);
  
  It is unwise to change these settings halfway through writing CSV
  data to a stream. If however, you want to create a new stream using
  the available CSV object, there is no harm in changing them.
  
  If the C<new ()> constructor call fails, it returns C<undef>, and makes
  the fail reason available through the C<error_diag ()> method.
  
   $csv = Text::CSV->new ({ ecs_char => 1 }) or
       die "" . Text::CSV->error_diag ();
  
  C<error_diag ()> will return a string like
  
   "INI - Unknown attribute 'ecs_char'"
  
  =head2 print
  
   $status = $csv->print ($io, $colref);
  
  Similar to C<combine () + string () + print>, but more efficient. It
  expects an array ref as input (not an array!) and the resulting string is
  not really created (XS version), but immediately written to the I<$io> object, typically
  an IO handle or any other object that offers a I<print> method. Note, this
  implies that the following is wrong in perl 5.005_xx and older:
  
   open FILE, ">", "whatever";
   $status = $csv->print (\*FILE, $colref);
  
  as in perl 5.005 and older, the glob C<\*FILE> is not an object, thus it
  doesn't have a print method. The solution is to use an IO::File object or
  to hide the glob behind an IO::Wrap object. See L<IO::File> and L<IO::Wrap>
  for details.
  
  For performance reasons the print method doesn't create a result string.
  (If its backend is PP version, result strings are created internally.)
  In particular the I<$csv-E<gt>string ()>, I<$csv-E<gt>status ()>,
  I<$csv->fields ()> and I<$csv-E<gt>error_input ()> methods are meaningless
  after executing this method.
  
  =head2 combine
  
   $status = $csv->combine (@columns);
  
  This object function constructs a CSV string from the arguments, returning
  success or failure.  Failure can result from lack of arguments or an argument
  containing an invalid character.  Upon success, C<string ()> can be called to
  retrieve the resultant CSV string.  Upon failure, the value returned by
  C<string ()> is undefined and C<error_input ()> can be called to retrieve an
  invalid argument.
  
  =head2 string
  
   $line = $csv->string ();
  
  This object function returns the input to C<parse ()> or the resultant CSV
  string of C<combine ()>, whichever was called more recently.
  
  =head2 getline
  
   $colref = $csv->getline ($io);
  
  This is the counterpart to print, like parse is the counterpart to
  combine: It reads a row from the IO object $io using $io->getline ()
  and parses this row into an array ref. This array ref is returned
  by the function or undef for failure.
  
  When fields are bound with C<bind_columns ()>, the return value is a
  reference to an empty list.
  
  The I<$csv-E<gt>string ()>, I<$csv-E<gt>fields ()> and I<$csv-E<gt>status ()>
  methods are meaningless, again.
  
  =head2 getline_all
  
   $arrayref = $csv->getline_all ($io);
   $arrayref = $csv->getline_all ($io, $offset);
   $arrayref = $csv->getline_all ($io, $offset, $length);
  
  This will return a reference to a list of C<getline ($io)> results.
  In this call, C<keep_meta_info> is disabled. If C<$offset> is negative,
  as with C<splice ()>, only the last C<abs ($offset)> records of C<$io>
  are taken into consideration.
  
  Given a CSV file with 10 lines:
  
   lines call
   ----- ---------------------------------------------------------
   0..9  $csv->getline_all ($io)         # all
   0..9  $csv->getline_all ($io,  0)     # all
   8..9  $csv->getline_all ($io,  8)     # start at 8
   -     $csv->getline_all ($io,  0,  0) # start at 0 first 0 rows
   0..4  $csv->getline_all ($io,  0,  5) # start at 0 first 5 rows
   4..5  $csv->getline_all ($io,  4,  2) # start at 4 first 2 rows
   8..9  $csv->getline_all ($io, -2)     # last 2 rows
   6..7  $csv->getline_all ($io, -4,  2) # first 2 of last  4 rows
  
  =head2 parse
  
   $status = $csv->parse ($line);
  
  This object function decomposes a CSV string into fields, returning
  success or failure.  Failure can result from a lack of argument or the
  given CSV string is improperly formatted.  Upon success, C<fields ()> can
  be called to retrieve the decomposed fields .  Upon failure, the value
  returned by C<fields ()> is undefined and C<error_input ()> can be called
  to retrieve the invalid argument.
  
  You may use the I<types ()> method for setting column types. See the
  description below.
  
  =head2 getline_hr
  
  The C<getline_hr ()> and C<column_names ()> methods work together to allow
  you to have rows returned as hashrefs. You must call C<column_names ()>
  first to declare your column names.
  
   $csv->column_names (qw( code name price description ));
   $hr = $csv->getline_hr ($io);
   print "Price for $hr->{name} is $hr->{price} EUR\n";
  
  C<getline_hr ()> will croak if called before C<column_names ()>.
  
  =head2 getline_hr_all
  
   $arrayref = $csv->getline_hr_all ($io);
  
  This will return a reference to a list of C<getline_hr ($io)> results.
  In this call, C<keep_meta_info> is disabled.
  
  =head2 column_names
  
  Set the keys that will be used in the C<getline_hr ()> calls. If no keys
  (column names) are passed, it'll return the current setting.
  
  C<column_names ()> accepts a list of scalars (the column names) or a
  single array_ref, so you can pass C<getline ()>
  
    $csv->column_names ($csv->getline ($io));
  
  C<column_names ()> does B<no> checking on duplicates at all, which might
  lead to unwanted results. Undefined entries will be replaced with the
  string C<"\cAUNDEF\cA">, so
  
    $csv->column_names (undef, "", "name", "name");
    $hr = $csv->getline_hr ($io);
  
  Will set C<$hr->{"\cAUNDEF\cA"}> to the 1st field, C<$hr->{""}> to the
  2nd field, and C<$hr->{name}> to the 4th field, discarding the 3rd field.
  
  C<column_names ()> croaks on invalid arguments.
  
  =head2 bind_columns
  
  Takes a list of references to scalars to store the fields fetched
  C<getline ()> in. When you don't pass enough references to store the
  fetched fields in, C<getline ()> will fail. If you pass more than there are
  fields to return, the remaining references are left untouched.
  
    $csv->bind_columns (\$code, \$name, \$price, \$description);
    while ($csv->getline ($io)) {
        print "The price of a $name is \x{20ac} $price\n";
        }
  
  =head2 eof
  
   $eof = $csv->eof ();
  
  If C<parse ()> or C<getline ()> was used with an IO stream, this
  method will return true (1) if the last call hit end of file, otherwise
  it will return false (''). This is useful to see the difference between
  a failure and end of file.
  
  =head2 types
  
   $csv->types (\@tref);
  
  This method is used to force that columns are of a given type. For
  example, if you have an integer column, two double columns and a
  string column, then you might do a
  
   $csv->types ([Text::CSV_PP::IV (),
                 Text::CSV_PP::NV (),
                 Text::CSV_PP::NV (),
                 Text::CSV_PP::PV ()]);
  
  Column types are used only for decoding columns, in other words
  by the I<parse ()> and I<getline ()> methods.
  
  You can unset column types by doing a
  
   $csv->types (undef);
  
  or fetch the current type settings with
  
   $types = $csv->types ();
  
  =over 4
  
  =item IV
  
  Set field type to integer.
  
  =item NV
  
  Set field type to numeric/float.
  
  =item PV
  
  Set field type to string.
  
  =back
  
  =head2 fields
  
   @columns = $csv->fields ();
  
  This object function returns the input to C<combine ()> or the resultant
  decomposed fields of C successful <parse ()>, whichever was called more
  recently.
  
  Note that the return value is undefined after using C<getline ()>, which
  does not fill the data structures returned by C<parse ()>.
  
  =head2 meta_info
  
   @flags = $csv->meta_info ();
  
  This object function returns the flags of the input to C<combine ()> or
  the flags of the resultant decomposed fields of C<parse ()>, whichever
  was called more recently.
  
  For each field, a meta_info field will hold flags that tell something about
  the field returned by the C<fields ()> method or passed to the C<combine ()>
  method. The flags are bitwise-or'd like:
  
  =over 4
  
  =item 0x0001
  
  The field was quoted.
  
  =item 0x0002
  
  The field was binary.
  
  =back
  
  See the C<is_*** ()> methods below.
  
  =head2 is_quoted
  
    my $quoted = $csv->is_quoted ($column_idx);
  
  Where C<$column_idx> is the (zero-based) index of the column in the
  last result of C<parse ()>.
  
  This returns a true value if the data in the indicated column was
  enclosed in C<quote_char> quotes. This might be important for data
  where C<,20070108,> is to be treated as a numeric value, and where
  C<,"20070108",> is explicitly marked as character string data.
  
  =head2 is_binary
  
    my $binary = $csv->is_binary ($column_idx);
  
  Where C<$column_idx> is the (zero-based) index of the column in the
  last result of C<parse ()>.
  
  This returns a true value if the data in the indicated column
  contained any byte in the range [\x00-\x08,\x10-\x1F,\x7F-\xFF]
  
  =head2 status
  
   $status = $csv->status ();
  
  This object function returns success (or failure) of C<combine ()> or
  C<parse ()>, whichever was called more recently.
  
  =head2 error_input
  
   $bad_argument = $csv->error_input ();
  
  This object function returns the erroneous argument (if it exists) of
  C<combine ()> or C<parse ()>, whichever was called more recently.
  
  =head2 error_diag
  
   Text::CSV_PP->error_diag ();
   $csv->error_diag ();
   $error_code   = 0  + $csv->error_diag ();
   $error_str    = "" . $csv->error_diag ();
   ($cde, $str, $pos) = $csv->error_diag ();
  
  If (and only if) an error occured, this function returns the diagnostics
  of that error.
  
  If called in void context, it will print the internal error code and the
  associated error message to STDERR.
  
  If called in list context, it will return the error code and the error
  message in that order. If the last error was from parsing, the third
  value returned is the best guess at the location within the line that was
  being parsed. It's value is 1-based.
  
  Note: C<$pos> does not show the error point in many cases.
  It is for conscience's sake.
  
  If called in scalar context, it will return the diagnostics in a single
  scalar, a-la $!. It will contain the error code in numeric context, and
  the diagnostics message in string context.
  
  To achieve this behavior with CSV_PP, the returned diagnostics is blessed object.
  
  =head2 SetDiag
  
   $csv->SetDiag (0);
  
  Use to reset the diagnostics if you are dealing with errors.
  
  =head1 DIAGNOSTICS
  
  If an error occured, $csv->error_diag () can be used to get more information
  on the cause of the failure. Note that for speed reasons, the internal value
  is never cleared on success, so using the value returned by error_diag () in
  normal cases - when no error occured - may cause unexpected results.
  
  Note: CSV_PP's diagnostics is different from CSV_XS's:
  
  Text::CSV_XS parses csv strings by dividing one character
  while Text::CSV_PP by using the regular expressions.
  That difference makes the different cause of the failure.
  
  Currently these errors are available:
  
  =over 2
  
  =item 1001 "sep_char is equal to quote_char or escape_char"
  
  The separation character cannot be equal to either the quotation character
  or the escape character, as that will invalidate all parsing rules.
  
  =item 1002 "INI - allow_whitespace with escape_char or quote_char SP or TAB"
  
  Using C<allow_whitespace> when either C<escape_char> or C<quote_char> is
  equal to SPACE or TAB is too ambiguous to allow.
  
  =item 1003 "INI - \r or \n in main attr not allowed"
  
  Using default C<eol> characters in either C<sep_char>, C<quote_char>, or
  C<escape_char> is not allowed.
  
  =item 2010 "ECR - QUO char inside quotes followed by CR not part of EOL"
  
  =item 2011 "ECR - Characters after end of quoted field"
  
  =item 2021 "EIQ - NL char inside quotes, binary off"
  
  =item 2022 "EIQ - CR char inside quotes, binary off"
  
  =item 2025 "EIQ - Loose unescaped escape"
  
  =item 2026 "EIQ - Binary character inside quoted field, binary off"
  
  =item 2027 "EIQ - Quoted field not terminated"
  
  =item 2030 "EIF - NL char inside unquoted verbatim, binary off"
  
  =item 2031 "EIF - CR char is first char of field, not part of EOL",
  
  =item 2032 "EIF - CR char inside unquoted, not part of EOL",
  
  =item 2034 "EIF - Loose unescaped quote",
  
  =item 2037 "EIF - Binary character in unquoted field, binary off",
  
  =item 2110 "ECB - Binary character in Combine, binary off"
  
  =item 2200 "EIO - print to IO failed. See errno"
  
  =item 4002 "EIQ - Unescaped ESC in quoted field"
  
  =item 4003 "EIF - ESC CR"
  
  =item 4004 "EUF - "
  
  =item 3001 "EHR - Unsupported syntax for column_names ()"
  
  =item 3002 "EHR - getline_hr () called before column_names ()"
  
  =item 3003 "EHR - bind_columns () and column_names () fields count mismatch"
  
  =item 3004 "EHR - bind_columns () only accepts refs to scalars"
  
  =item 3006 "EHR - bind_columns () did not pass enough refs for parsed fields"
  
  =item 3007 "EHR - bind_columns needs refs to writable scalars"
  
  =item 3008 "EHR - unexpected error in bound fields"
  
  =back
  
  =head1 AUTHOR
  
  Makamaka Hannyaharamitu, E<lt>makamaka[at]cpan.orgE<gt>
  
  Text::CSV_XS was written by E<lt>joe[at]ispsoft.deE<gt>
  and maintained by E<lt>h.m.brand[at]xs4all.nlE<gt>.
  
  Text::CSV was written by E<lt>alan[at]mfgrtl.comE<gt>.
  
  
  =head1 COPYRIGHT AND LICENSE
  
  Copyright 2005-2013 by Makamaka Hannyaharamitu, E<lt>makamaka[at]cpan.orgE<gt>
  
  This library is free software; you can redistribute it and/or modify
  it under the same terms as Perl itself. 
  
  =head1 SEE ALSO
  
  L<Text::CSV_XS>, L<Text::CSV>
  
  I got many regexp bases from L<http://www.din.or.jp/~ohzaki/perl.htm>
  
  =cut
TEXT_CSV_PP

$fatpacked{"oo.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'OO';
  package oo;
  
  use strictures 1;
  use Moo::_Utils;
  
  sub moo {
    print <<'EOMOO';
   ______
  < Moo! >
   ------
          \   ^__^
           \  (oo)\_______
              (__)\       )\/\
                  ||----w |
                  ||     ||
  EOMOO
    exit 0;
  }
  
  BEGIN {
      my $package;
      sub import {
          moo() if $0 eq '-';
          $package = $_[1] || 'Class';
          if ($package =~ /^\+/) {
              $package =~ s/^\+//;
              _load_module($package);
          }
      }
      use Filter::Simple sub { s/^/package $package;\nuse Moo;\n/; }
  }
  
  1;
OO

$fatpacked{"strictures.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'STRICTURES';
  package strictures;
  
  use strict;
  use warnings FATAL => 'all';
  
  BEGIN {
    *_PERL_LT_5_8_4 = ($] < 5.008004) ? sub(){1} : sub(){0};
  }
  
  our $VERSION = '1.005004'; # 1.5.4
  
  sub VERSION {
    my ($class, $version) = @_;
    for ($version) {
      last unless defined && !ref && int != 1;
      die "Major version specified as $_ - this is strictures version 1";
    }
    # passing undef here may either warn or die depending on the version of perl.
    # we can't match the caller's warning state in this case, so just disable the
    # warning.
    no warnings 'uninitialized';
    shift->SUPER::VERSION(@_);
  }
  
  our $extra_load_states;
  
  our $Smells_Like_VCS = (-e '.git' || -e '.svn' || -e '.hg'
    || (-e '../../dist.ini'
        && (-e '../../.git' || -e '../../.svn' || -e '../../.hg' )));
  
  sub import {
    strict->import;
    warnings->import(FATAL => 'all');
  
    my $extra_tests = do {
      if (exists $ENV{PERL_STRICTURES_EXTRA}) {
        if (_PERL_LT_5_8_4 and $ENV{PERL_STRICTURES_EXTRA}) {
          die 'PERL_STRICTURES_EXTRA checks are not available on perls older than 5.8.4: '
            . "please unset \$ENV{PERL_STRICTURES_EXTRA}\n";
        }
        $ENV{PERL_STRICTURES_EXTRA};
      } elsif (! _PERL_LT_5_8_4) {
        !!((caller)[1] =~ /^(?:t|xt|lib|blib)/
           and $Smells_Like_VCS)
      }
    };
    if ($extra_tests) {
      $extra_load_states ||= do {
  
        my (%rv, @failed);
        foreach my $mod (qw(indirect multidimensional bareword::filehandles)) {
          eval "require $mod; \$rv{'$mod'} = 1;" or do {
            push @failed, $mod;
  
            # courtesy of the 5.8 require bug
            # (we do a copy because 5.16.2 at least uses the same read-only
            # scalars for the qw() list and it doesn't seem worth a $^V check)
  
            (my $file = $mod) =~ s|::|/|g;
            delete $INC{"${file}.pm"};
          };
        }
  
        if (@failed) {
          my $failed = join ' ', @failed;
          print STDERR <<EOE;
  strictures.pm extra testing active but couldn't load all modules. Missing were:
  
    $failed
  
  Extra testing is auto-enabled in checkouts only, so if you're the author
  of a strictures-using module you need to run:
  
    cpan indirect multidimensional bareword::filehandles
  
  but these modules are not required by your users.
  EOE
        }
  
        \%rv;
      };
  
      indirect->unimport(':fatal') if $extra_load_states->{indirect};
      multidimensional->unimport if $extra_load_states->{multidimensional};
      bareword::filehandles->unimport if $extra_load_states->{'bareword::filehandles'};
    }
  }
  
  1;
  
  __END__
  =head1 NAME
  
  strictures - turn on strict and make all warnings fatal
  
  =head1 SYNOPSIS
  
    use strictures 1;
  
  is equivalent to
  
    use strict;
    use warnings FATAL => 'all';
  
  except when called from a file which matches:
  
    (caller)[1] =~ /^(?:t|xt|lib|blib)/
  
  and when either C<.git>, C<.svn>, or C<.hg> is present in the current directory (with
  the intention of only forcing extra tests on the author side) -- or when C<.git>,
  C<.svn>, or C<.hg> is present two directories up along with C<dist.ini> (which would
  indicate we are in a C<dzil test> operation, via L<Dist::Zilla>) --
  or when the C<PERL_STRICTURES_EXTRA> environment variable is set, in which case
  
    use strictures 1;
  
  is equivalent to
  
    use strict;
    use warnings FATAL => 'all';
    no indirect 'fatal';
    no multidimensional;
    no bareword::filehandles;
  
  Note that C<PERL_STRICTURES_EXTRA> may at some point add even more tests, with only a minor
  version increase, but any changes to the effect of C<use strictures> in
  normal mode will involve a major version bump.
  
  If any of the extra testing modules are not present, L<strictures> will
  complain loudly, once, via C<warn()>, and then shut up. But you really
  should consider installing them, they're all great anti-footgun tools.
  
  =head1 DESCRIPTION
  
  I've been writing the equivalent of this module at the top of my code for
  about a year now. I figured it was time to make it shorter.
  
  Things like the importer in C<use Moose> don't help me because they turn
  warnings on but don't make them fatal -- which from my point of view is
  useless because I want an exception to tell me my code isn't warnings-clean.
  
  Any time I see a warning from my code, that indicates a mistake.
  
  Any time my code encounters a mistake, I want a crash -- not spew to STDERR
  and then unknown (and probably undesired) subsequent behaviour.
  
  I also want to ensure that obvious coding mistakes, like indirect object
  syntax (and not so obvious mistakes that cause things to accidentally compile
  as such) get caught, but not at the cost of an XS dependency and not at the
  cost of blowing things up on another machine.
  
  Therefore, L<strictures> turns on additional checking, but only when it thinks
  it's running in a test file in a VCS checkout -- although if this causes
  undesired behaviour this can be overridden by setting the
  C<PERL_STRICTURES_EXTRA> environment variable.
  
  If additional useful author side checks come to mind, I'll add them to the
  C<PERL_STRICTURES_EXTRA> code path only -- this will result in a minor version increase (e.g.
  1.000000 to 1.001000 (1.1.0) or similar). Any fixes only to the mechanism of
  this code will result in a sub-version increase (e.g. 1.000000 to 1.000001
  (1.0.1)).
  
  If the behaviour of C<use strictures> in normal mode changes in any way, that
  will constitute a major version increase -- and the code already checks
  when its version is tested to ensure that
  
    use strictures 1;
  
  will continue to only introduce the current set of strictures even if 2.0 is
  installed.
  
  =head1 METHODS
  
  =head2 import
  
  This method does the setup work described above in L</DESCRIPTION>
  
  =head2 VERSION
  
  This method traps the C<< strictures->VERSION(1) >> call produced by a use line
  with a version number on it and does the version check.
  
  =head1 EXTRA TESTING RATIONALE
  
  Every so often, somebody complains that they're deploying via C<git pull>
  and that they don't want L<strictures> to enable itself in this case -- and that
  setting C<PERL_STRICTURES_EXTRA> to 0 isn't acceptable (additional ways to
  disable extra testing would be welcome but the discussion never seems to get
  that far).
  
  In order to allow us to skip a couple of stages and get straight to a
  productive conversation, here's my current rationale for turning the
  extra testing on via a heuristic:
  
  The extra testing is all stuff that only ever blows up at compile time;
  this is intentional. So the oft-raised concern that it's different code being
  tested is only sort of the case -- none of the modules involved affect the
  final optree to my knowledge, so the author gets some additional compile
  time crashes which he/she then fixes, and the rest of the testing is
  completely valid for all environments.
  
  The point of the extra testing -- especially C<no indirect> -- is to catch
  mistakes that newbie users won't even realise are mistakes without
  help. For example,
  
    foo { ... };
  
  where foo is an & prototyped sub that you forgot to import -- this is
  pernicious to track down since all I<seems> fine until it gets called
  and you get a crash. Worse still, you can fail to have imported it due
  to a circular require, at which point you have a load order dependent
  bug which I've seen before now I<only> show up in production due to tiny
  differences between the production and the development environment. I wrote
  L<http://shadow.cat/blog/matt-s-trout/indirect-but-still-fatal/> to explain
  this particular problem before L<strictures> itself existed.
  
  As such, in my experience so far L<strictures>' extra testing has
  I<avoided> production versus development differences, not caused them.
  
  Additionally, L<strictures>' policy is very much "try and provide as much
  protection as possible for newbies -- who won't think about whether there's
  an option to turn on or not" -- so having only the environment variable
  is not sufficient to achieve that (I get to explain that you need to add
  C<use strict> at least once a week on freenode #perl -- newbies sometimes
  completely skip steps because they don't understand that that step
  is important).
  
  I make no claims that the heuristic is perfect -- it's already been evolved
  significantly over time, especially for 1.004 where we changed things to
  ensure it only fires on files in your checkout (rather than L<strictures>-using
  modules you happened to have installed, which was just silly). However, I
  hope the above clarifies why a heuristic approach is not only necessary but
  desirable from a point of view of providing new users with as much safety as possible,
  and will allow any future discussion on the subject to focus on "how do we
  minimise annoyance to people deploying from checkouts intentionally".
  
  =head1 SEE ALSO
  
  =over 4
  
  =item *
  
  L<indirect>
  
  =item *
  
  L<multidimensional>
  
  =item *
  
  L<bareword::filehandles>
  
  =back
  
  =head1 COMMUNITY AND SUPPORT
  
  =head2 IRC channel
  
  irc.perl.org #toolchain
  
  (or bug 'mst' in query on there or freenode)
  
  =head2 Git repository
  
  Gitweb is on http://git.shadowcat.co.uk/ and the clone URL is:
  
    git clone git://git.shadowcat.co.uk/p5sagit/strictures.git
  
  The web interface to the repository is at:
  
    http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=p5sagit/strictures.git
  
  =head1 AUTHOR
  
  mst - Matt S. Trout (cpan:MSTROUT) <mst@shadowcat.co.uk>
  
  =head1 CONTRIBUTORS
  
  Karen Etheridge (cpan:ETHER) <ether@cpan.org>
  
  Mithaldu - Christian Walde (cpan:MITHALDU) <walde.christian@gmail.com>
  
  haarg - Graham Knop (cpan:HAARG) <haarg@haarg.org>
  
  =head1 COPYRIGHT
  
  Copyright (c) 2010 the strictures L</AUTHOR> and L</CONTRIBUTORS>
  as listed above.
  
  =head1 LICENSE
  
  This library is free software and may be distributed under the same terms
  as perl itself.
  
  =cut
STRICTURES

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


use strict;
use warnings;
use FileMerger;
use FileMerger::Params;
use FileMerger::Reporter;

our $VERSION = "0.1";

### Command Line Interface ###

my %args;
{    # Let the Params object go out of scope
    my $cmdl = FileMerger::Params->new();

    # $cmdl will handle errors and will exit gracefully if needed.
    # The class does only validation and is a no-op outsitde
    %args = $cmdl->read_params();
}
### Merging ###

# supply the required info
my $fm = FileMerger->new(
    src_dirs   => $args{source},
    target_dir => $args{target},
);

# supply additional info if present
if ( defined $args{'exclude-literal'} ) {
    $fm->excl_lit( $args{'exclude-literal'} );
}
if ( defined $args{'exclude-rx'} ) {
    $fm->excl_rx( $args{'exclude-rx'} );
}
if ( defined $args{'rename-rx'} ) { $fm->ren_rx( $args{'rename-rx'} ); }
evaluate( $fm->merge_dirs() );

# ## Debug code ##
# use Data::Printer;
# p $fm;
# ## end ##


### Status Report ###

FileMerger::Reporter->run( $fm->conflicts, $fm->skipped );

### Exit with the corresponding error code ###
(@{ $fm->conflicts } ) ? exit(1) : exit(0);

### Functions ###
sub evaluate {
    my $crit_error = shift;

    # We prefer to die inmediately in case of file system operation errors
    # We also choose to exit from the main program
    if ( defined $crit_error ) {
        print "Critical error encountered:\n";
        print $crit_error . "\n";
        print "Bailing out...\n";
		exit(1);
    }
}
