SF.net SVN: gar:[23696] csw/mgar/gar/v2/bin/filemerger

claudio_sf at users.sourceforge.net claudio_sf at users.sourceforge.net
Fri May 23 15:17:30 CEST 2014


Revision: 23696
          http://sourceforge.net/p/gar/code/23696
Author:   claudio_sf
Date:     2014-05-23 13:17:28 +0000 (Fri, 23 May 2014)
Log Message:
-----------
First filemerger implementation

Added Paths:
-----------
    csw/mgar/gar/v2/bin/filemerger

Added: csw/mgar/gar/v2/bin/filemerger
===================================================================
--- csw/mgar/gar/v2/bin/filemerger	                        (rev 0)
+++ csw/mgar/gar/v2/bin/filemerger	2014-05-23 13:17:28 UTC (rev 23696)
@@ -0,0 +1,9724 @@
+#!/opt/csw/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 at woobling.orgE<gt>
+  
+  Florian Ragwitz E<lt>rafl at debian.orgE<gt>
+  
+  Jesse Luehrs E<lt>doy at tozt.netE<gt>
+  
+  Peter Rabbitson E<lt>ribasushi at cpan.orgE<gt>
+  
+  Arthur Axel 'fREW' Schmidt E<lt>frioux at gmail.comE<gt>
+  
+  Elizabeth Mattijsen E<lt>liz at dijkmat.nlE<gt>
+  
+  Greham Knop E<lt>haarg at 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 at 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 at 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 at shadowcat.co.uk>
+  
+  =head1 CONTRIBUTORS
+  
+  haarg - Graham Knop (cpan:HAARG) <haarg at 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(' ', at 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 at fysh.org>
+  
+  =head1 COPYRIGHT
+  
+  Copyright (C) 2004, 2006, 2007, 2009, 2010, 2011, 2012, 2014
+  Andrew Main (Zefram) <zefram at 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

@@ Diff output truncated at 100000 characters. @@
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.



More information about the devel mailing list